Jump to content
Fórum Script Brasil
  • 0

VBScript - Loop carregar arquivos


Field Services
 Share

Question

Boa Tarde pessoal,

Achei um script na internet e ele faz exatamente o que estou precisando, o problema é que ele está pedindo para carregar o arquivo 2x. Poderiam me ajudar? Já tentei varias coisas para conseguir localizar e não estou conseguindo.

'------------------------------------------------------------------------------

Const appName = "FTP Upload Utility"
'------------------------------------------------------------------------------
Const defaultHostname = "servidor ftp"
Const defaultPort = 21
Const defaultUsername = "usuario"
Const defaultPassword = "senha"
Const defaultRemoteDir = "pasta"
' set this var to the fully qualified path of a local file to prevent file
' selection dialog from being displayed
defaultFile = ""
' if useDefaultsExclusively = True, the default values above will be leveraged
' as-is, meaning no override options will be prompted for.
Const useDefaultsExclusively = True
' if skipConfirmation = True, the upload will be attempted without requesting
' confirmation to commence.
Const skipConfirmation = False
'------------------------------------------------------------------------------
Set shell = CreateObject( "WScript.Shell" )
defaultLocalDir = shell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop"
Set shell = Nothing
hostname = GetNonEmptyValue(useDefaultsExclusively, defaultHostname, _
"Enter FTP server remote hostname:", "Hostname")
port = GetNonEmptyValue(useDefaultsExclusively, defaultPort, _
"Enter FTP server remote port:", "Port")
username = GetNonEmptyValue(useDefaultsExclusively, defaultUsername, _
"Enter username:", "Username")
password = GetNonEmptyValue(useDefaultsExclusively, defaultPassword, _
"Enter password:", "Password")
If Len(defaultFile) > 0 Then
file = defaultFile
Else
file = ChooseFile(defaultLocalDir)
TestNotEmpty file, "Upload File"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
localFile = fso.getFileName(file)
localDir = fso.getParentFolderName(file)
Set fso = Nothing
remoteDir = GetNonEmptyValue(useDefaultsExclusively, defaultRemoteDir, _
"Remote upload directory:", "Remote Directory")
Msg = "Você está carregando o arquivo " & localFile & " em ftp://" & _
username & "@" & hostname & ":" & port & remoteDir & _
vbCRLF & _
vbCRLF & "Nota - Isso pode levar algum tempo!" & _
vbCRLF & _
vbCRLF & "Clique OK para iniciar o carregamento."
' VB appears to evaluate all the "OR" conditions when using if t1 OR t2 then ...
' hence, it does not stop testing the conditions after the first condition
' it detects is true. Thus the silly logic below...
If skipConfirmation Then
Upload hostname, port, username, password, localFile, localDir, remoteDir
ElseIf vbOK = MsgBox(Msg, vbOKCancel, appName) Then
Upload hostname, port, username, password, localFile, localDir, remoteDir
End If
'------------------------------------------------------------------------------
Function GetNonEmptyValue(useDefaultExclusively, defaultValue, prompt, dialogTitle)
If useDefaultExclusively Then
value = defaultValue
Else
value = InputBox(prompt, dialogTitle, defaultValue)
End If
TestNotEmpty value, dialogTitle
GetNonEmptyValue = value
End Function
'------------------------------------------------------------------------------
Sub TestNotEmpty(value, description)
If Len(value) = 0 Then
MsgBox "ERROR: No value provided for " & description, vbExclamation, appName
wscript.quit
End If
End Sub
'------------------------------------------------------------------------------
Set shell = CreateObject( "WScript.Shell" )
defaultLocalDir = shell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop"
Set shell = Nothing
file = ChooseFile(defaultLocalDir)
MsgBox file
Function ChooseFile (ByVal initialDir)
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
Dim winVersion
' This collection should contain just the one item
For Each objItem in colItems
'Caption e.g. Microsoft Windows 7 Professional
'Name e.g. Microsoft Windows 7 Professional |C:\windows|...
'OSType e.g. 18 / OSArchitecture e.g 64-bit
'Version e.g 6.1.7601 / BuildNumber e.g 7601
winVersion = CInt(Left(objItem.version, 1))
Next
Set objWMIService = Nothing
Set colItems = Nothing
If (winVersion <= 5) Then
' Then we are running XP and can use the original mechanism
Set cd = CreateObject("UserAccounts.CommonDialog")
cd.InitialDir = initialDir
cd.Filter = "ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*"
' filter index 4 would show all files by default
' filter index 1 would show zip files by default
cd.FilterIndex = 1
If cd.ShowOpen = True Then
ChooseFile = cd.FileName
Else
ChooseFile = ""
End If
Set cd = Nothing
Else
' We are running Windows 7 or later
Set shell = CreateObject( "WScript.Shell" )
Set ex = shell.Exec( "mshta.exe ""about: <input type=file id=X><script>X.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(X.value);close();resizeTo(0,0);</script>""" )
ChooseFile = Replace( ex.StdOut.ReadAll, vbCRLF, "" )
Set ex = Nothing
Set shell = Nothing
End If
End Function
'------------------------------------------------------------------------------
Sub Upload(hostname, port, username, password, localFile, localDir, remoteDir)
Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
tempDir = shell.ExpandEnvironmentStrings("%TEMP%")
' temporary script file supplied to Windows FTP client
scriptFile = tempDir & "\" & fso.GetTempName
' temporary file to store standard output from Windows FTP client
outputFile = tempDir & "\" & fso.GetTempName
'input script
script = script & "lcd " & """" & localDir & """" & vbCRLF
script = script & "open " & hostname & " " & port & vbCRLF
script = script & "user " & username & vbCRLF
script = script & password & vbCRLF
script = script & "cd " & """" & remoteDir & """" & vbCRLF
script = script & "binary" & vbCRLF
script = script & "prompt n" & vbCRLF
script = script & "put " & """" & localFile & """" & vbCRLF
script = script & "quit" & vbCRLF
Set textFile = fso.CreateTextFile(scriptFile, True)
textFile.WriteLine(script)
textFile.Close
Set textFile = Nothing
' bWaitOnReturn set to TRUE - indicating script should wait for the program
' to finish executing before continuing to the next statement
shell.Run "%comspec% /c FTP -n -s:" & scriptFile & " > " & outputFile, 0, True
Wscript.Sleep 500
' open standard output temp file read only, failing if not present
Set textFile = fso.OpenTextFile(outputFile, 1, 0, -2)
results = textFile.ReadAll
textFile.Close
Set textFile = Nothing
If InStr(results, "550") > 0 And InStr(results, "226") Then
fso.DeleteFile(scriptFile)
fso.DeleteFile(outputFile)
Msg ="ATENÇÃO: O Diretório de destino não foi alterado!!" & _
vbCRLF & "No entanto o arquivo foi carregado no diretório informado." & _
"O Diretório FTP foi associado com o usuário informado."
MsgBox Msg, vbExclamation, appName
ElseIf InStr(results, "226") > 0 Then
MsgBox "Arquivo carregado com sucesso!!.", vbInformation, appName
fso.DeleteFile(scriptFile)
fso.DeleteFile(outputFile)
Else
If InStr(results, "530") > 0 Then
Msg ="ERROR: Invalid Username/Password"
ElseIf InStr(results, "550") > 0 Then
Msg ="ERROR: Could not change to destination directory on host"
ElseIf InStr(results, "553") > 0 Then
Msg ="ERROR: Could not create file on host"
ElseIf InStr(results, "Unknown host") > 0 Then
Msg ="ERROR: Unknown host"
ElseIf InStr(results, "File not found") > 0 Then
Msg ="ERROR: Local File Not Found"
Else
Msg ="An ERROR may have occurred."
End If
Msg = Msg & _
vbCRLF & "Script file leveraged: " & scriptFile & _
vbCRLF & "FTP Output file: " & outputFile & _
vbCRLF & _
vbCRLF & "Ensure the above files are manually deleted, as they may " & _
"contain sensitive information!"
Wscript.Echo Msg
MsgBox Msg, vbCritical, appName
End If
Set shell = Nothing
Set fso = Nothing
End Sub

Desculpem pelo tamanho do script, não sei deixar menor.

Link to comment
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

  • Forum Statistics

    • Total Topics
      149.8k
    • Total Posts
      646.7k
×
×
  • Create New...