دانلود فایل از اینترنت به وسیله ی VbScript
این کد اول
چه تو نودپد و چه تو خود ویژال بیسیک بزارید بدون هیچ غمی برات اجرا می کنه
set xHttp=createObject("Microsoft.XMLHTTP")
xHttp.Open "GET","http://xxxx.com/index.sjs?SomeParams,false
xHttp.Send
strFilename="C:\testfile.zip"
if xHttp.status=200 then
set bStrm=CreateObject("ADODB.Stream")
with bStrm
.type=1
.open
.write xHttp.responseBody
.saveToFile strFilename,2
.close
end with
set bStrm=nothing
else
msgbox "Could not access server"
end if
set xHttp=nothing
set fso=CreateObject("Scripting.FileSystemObject")
if fso.fileexists(strFilename) then
msgbox "Saved '" & strFilename & "' - successful"
else msgbox "Something went wrong"
end if
set fso=nothing
کد دوم
فقط خط دوم این کلمه ها را به هم بچسبانید
Question =====>> Q uestion=================================
Option Explicit
Dim strFileURL,strHDLocation,Title,objFSO,PathScript,Q uestion
Title = "Télécharger un Jeu Flash avec exécution par Vbscript © Hackoo Crackoo © 2011"
Set objFSO = Createobject("Scripting.FileSystemObject")
PathScript = objFSO.GetParentFolderName(wscript.ScriptFullName) 'Chemin ou se localise le Vbscript
' ---------------------------------Les paramètres à modifier pour télécharger le jeu---------------------------------
strFileURL = "http://www.jeuxclic.com/jeux/game-1270029047.swf"
strHDLocation = PathScript & "\Coast Bike.swf"
' ---------------------------------Les paramètres à modifier pour télécharger le jeu---------------------------------
'************************************************* ************************************************** ******************
Call HTTPDownload(strFileURL,strHDLocation)
Question = MsgBox ("The File "& qq(strHDLocation) &" is Downloaded Successfully ! " & Vbcr & "Do you want open its location now ?",VBYesNO+VbQuestion,Title)
If Question = VbYes then
Call Explorer()
End if
'************************************************* **************************
Sub HTTPDownload(strFileURL,strHDLocation)
Dim ws,objXMLHTTP,objADOStream
Set Ws = CreateObject("WScript.Shell")
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
End If
Set objXMLHTTP = Nothing
End Sub
'************************************************* ***************************
Function Explorer()
Dim LockDown,Keysec1,itemtype,WS
Set Ws = CreateObject("WScript.Shell")
'Autoriser le contenu actif à s'exécuter dans les fichiers de la zone Ordinateur local
LockDown="HKLM\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_LOCALMACHINE_ LOCKDOWN\"
Keysec1=LockDown & "iexplore.exe"
itemtype = "REG_DWORD"
WS.RegWrite Keysec1,0,itemtype
Ws.Run "%comspec% /c Start iexplore " & strHDLocation,0,1
wscript.sleep 5000
WS.SendKeys "{F11}" 'pour mettre internet explorer en plein écran
Set WS = Nothing
end Function
'***************************************
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
'***************************************
خدایش جای تشکر نداره
پاسخ با نقل قول