Примерно так:
Код:
Option Explicit
Dim objFSO
Dim objShell
Dim objWshShell
Dim strPath2AVZ
Dim strPath2Exe
Dim strPath2AVZScript
Dim strHttpSource
Dim strDownloadDest
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objShell = WScript.CreateObject("Shell.Application")
Set objWshShell = WScript.CreateObject("WScript.Shell")
strPath2AVZ = "C:\AVZ"
strPath2Exe = objFSO.BuildPath(strPath2AVZ, "avz4\avz.exe")
strPath2AVZScript = objFSO.BuildPath(strPath2AVZ, "DrongoScript.avz")
strHttpSource = "http://z-oleg.com/avz4.zip"
strDownloadDest = objFSO.BuildPath(strPath2AVZ, objFSO.GetFileName(strHttpSource))
If Not objFSO.FolderExists(strPath2AVZ) Then
objFSO.CreateFolder strPath2AVZ
End If
If GetFileFromURL(strHttpSource, strDownloadDest) Then
ExtractFromZip objFSO.BuildPath(strPath2AVZ, objFSO.GetFileName(strHttpSource)), strPath2AVZ
CreateAVZScript strPath2AVZScript
RenameAndExecuteProgram strPath2Exe, strPath2AVZScript
Else
WScript.Echo "Can't download [" & strHttpSource & "] to [" & strDownloadDest & "]"
End If
Set objWshShell = Nothing
Set objShell = Nothing
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub CreateAVZScript(strPath2Script)
With objFSO.CreateTextFile(strPath2Script, True)
.Write _
"var" & vbCrLf & _
" sProcessName : string;" & vbCrLf & _
" sPath2Process : string;" & vbCrLf & _
"" & vbCrLf & _
"begin" & vbCrLf & _
" sProcessName := 'explorer.exe';" & vbCrLf & _
" sPath2Process := NormalFileName('%SystemRoot%\' + sProcessName);" & vbCrLf & _
" " & vbCrLf & _
" TerminateProcessByName(sProcessName);" & vbCrLf & _
" ExecuteStdScr(7);" & vbCrLf & _
" " & vbCrLf & _
" if ExecuteFile(sPath2Process, '', 1, 0, false) = true then" & vbCrLf & _
" ShowMessage('[' + sPath2Process + '] успешно запущен')" & vbCrLf & _
" else" & vbCrLf & _
" ShowMessage('Не удалось запустить [' + sPath2Process + ']');" & vbCrLf & _
"end." & vbCrLf
.Close
End With
End Sub
'=============================================================================
'=============================================================================
Sub RenameAndExecuteProgram(strPath2Exe, strPath2AVZScript)
' Enum WshExecStatus
Const WshRunning = 0
Const WshFinished = 1
Const WshFailed = 2
Dim strPath2NewExe
strPath2NewExe = objFSO.BuildPath(objFSO.GetParentFolderName(strPath2Exe), objFSO.GetTempName())
objFSO.CopyFile strPath2Exe, strPath2NewExe
With objWshShell.Exec("""" & strPath2NewExe & """ AM=Y Run=Y Script=""" & strPath2AVZScript & """")
WScript.Sleep 500
If .Status = WshRunning And .Status <> WshFailed Then
objWshShell.AppActivate .ProcessID
Do
WScript.Sleep 100
Loop Until .Status = WshFinished
Else
WScript.Echo "Can't execute [" & strPath2NewExe & "]"
End If
End With
objFSO.DeleteFile strPath2NewExe, True
'objFSO.DeleteFile strPath2AVZScript, True
End Sub
'=============================================================================
'=============================================================================
Function ExtractFromZip(strPath2Zip, strPath2Extract)
Dim objFolderZIP
Dim objFolderDest
Set objFolderZIP = objShell.NameSpace(strPath2Zip)
If Not objFolderZIP Is Nothing Then
Set objFolderDest = objShell.NameSpace(strPath2Extract)
If Not objFolderDest Is Nothing Then
objFolderDest.CopyHere objFolderZIP.Items
Set objFolderDest = Nothing
Else
WScript.Echo "Can't get folder [" & strPath2Extract & "]"
End If
Set objFolderZIP = Nothing
Else
WScript.Echo "Can't get zip folder [" & strPath2Zip & "]"
End If
End Function
'=============================================================================
'=============================================================================
Function GetFileFromURL(strURL, strPath)
' Enum ConnectModeEnum
Const adModeUnknown = 0
Const adModeRead = 1
Const adModeWrite = 2
Const adModeReadWrite = 3
Const adModeShareDenyRead = 4
Const adModeShareDenyWrite = 8
Const adModeShareExclusive = 12
Const adModeShareDenyNone = 16
Const adModeRecursive = 4194304
' Enum StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2
' Enum SaveOptionsEnum
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Dim arrContent
GetFileFromURL = False
With WScript.CreateObject("MSXML2.XMLHTTP")
.open "GET", strURL, False
.send
arrContent = .responseBody
End With
With WScript.CreateObject("ADODB.Stream")
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write arrContent
.SaveToFile strPath, adSaveCreateOverWrite
End With
If objFSO.FileExists(strPath) Then
If objFSO.GetFile(strPath).Size <> 0 Then
' Что-то загружено ;)
GetFileFromURL = True
End If
End If
End Function
'=============================================================================