Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Примерно так:
Код: Выделить весь код
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
'=============================================================================
Это сообщение посчитали полезным следующие участники:

Отправлено: 16:49, 08-05-2011 | #8