Batch Index du Forum
S’enregistrerRechercherFAQMembresGroupesConnexion
Répondre au sujet Page 1 sur 1
[VBS] Téléchargements par Lots des Jeux Flash
Auteur Message
Répondre en citant
Message [VBS] Téléchargements par Lots des Jeux Flash 

Télécharger des jeux Flash à partir des URL(s) préalablement contenues dans un fichier texte "GameList.txt" qui doit-être présent avec le VBscript dans le même dossier et pour chaque jeu ou fichier à télécharger est accompagné par un splashscreen de téléchargement comme celui-là :



Bon Divertissement



Code:
[lang=vb]On ERROR RESUME NEXT
Const ForReading = 1
Dim strFileURL,strHDLocation,Titre,objFSO
Titre = "Téléchargement par Lots des Jeux Flash © Hackoo © 2012"
Set objFSO = Createobject("Scripting.FileSystemObject")
Set Ws = CreateObject("WScript.Shell")
PathScript = objFSO.GetParentFolderName(wscript.ScriptFullName)
PathGames = PathScript & "\FlashGames"
Call Test_Connexion_Internet()
CreerRep(PathGames)
'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
If objfso.FileExists("Gamelist.txt") Then
   Set f = objfso.OpenTextFile("Gamelist.txt", ForReading)
   st=f.ReadAll
   Tab = split(st,vbcr)
   For i=0 to Ubound(Tab)
       elem=split(Tab(i),"/")
       FileURL = Tab(i)
           HDLocation = elem(2)
    strFileURL = "http://" & FileURL
    strHDLocation = PathGames &"\"& HDLocation &".swf"
' Récupérer le fichier
   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
'MsgBox "Le Jeu Flash :"& vbCr & qq(strHDLocation) & vbCr &" Existe déja dans le Dossier "& qq(PathGames),48,Titre
Else
Call SplashScreen
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
End If
End If
Set objXMLHTTP = Nothing
Next
Set objFSO = Nothing
MsgBox "Félécitations ! Tous Les Téléchargements ont été Terminé avec Succés !",64,Titre
Question = MsgBox ("Vouliez-vous ouvrir le dernier Jeu Téléchargé "& qq(strHDLocation) &" ?" & Vbcr &_
 "SI oui , alors cliquez sur [OUI]  ?"& Vbcr &_
 "Sinon , alors cliquez sur [NON] pour ouvrir un Jeu Au Hasard !",VBYesNO+VbQuestion,Titre)
 If Question = VbYes then
    Call Explorer
        else
        Call JeuAuHasard()
 End if
'Ws.Run "explorer " & PathGames,1,True
Set WS = Nothing
 else
MsgBox "Le Fichier ""Gamelist.txt"" est absent et le script doit-être arrêté !",48,Titre
wscript.Quit
 End If
 
Sub CreerRep(Chemin)
        If Not objFSO.FolderExists(chemin) Then
                CreerRep(objFSO.GetParentFolderName(chemin))
                objFSO.CreateFolder(chemin)
        End If
End Sub
 
Sub Test_Connexion_Internet()
strComputer = "smtp.gmail.com"
MsgTitre = "TEST DE CONNEXION INTERNET *-* Téléchargement par Lots des Jeux Flash © Hackoo © 2012"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
msgbox "VOUS ETES DESORMAIS CONNECTE A INTERNET ET LE TELECHARGEMENT DES JEUX FLASH EST DISPONIBLE ! ",64,MsgTitre
else
msgbox "OUPPS !!! VOUS N'ETES PAS CONNECTE A INTERNET ET LE TELECHARGEMENT N'EST PLUS DISPONIBLE EN CE MOMENT !",16,MsgTitre
Exit Sub
End If
Next
End Sub
 
Function qq(str)
qq = chr(34)& str &chr(34)
End Function
 
Sub Explorer()
Ws.Run "%comspec% /c Start iexplore " & strHDLocation,0,True
wscript.sleep 5000
Question = MsgBox ("Vouliez-vous ouvrir ce Jeu en plein écran ?" & Vbcr &_
 "SI oui , alors cliquez sur [OUI]  ?"& Vbcr &_
 "Sinon , alors cliquez sur [NON]",VBYesNO+VbQuestion,Titre)
 If Question = VbYes then
    WS.AppActivate strHDLocation
    WS.SendKeys "{F11}" 'pour mettre internet explorer en plein écran
else
        WScript.Quit
 End if
Set WS = Nothing
end Sub
 
Function JeuAuHasard()
Set objFSO = Createobject("Scripting.FileSystemObject")
PathScript = objFSO.GetParentFolderName(wscript.ScriptFullName)
PathGames = PathScript & "\FlashGames"
Set objFolder = objFSO.GetFolder(PathGames)
Set colFiles = objFolder.Files
Set dico = CreateObject("Scripting.Dictionary")
i = 0
For each File in colFiles
If Not dico.Exists(File) Then
dico.Add i,File
i = i+1
end if
Next
cles=dico.keys
valeurs=dico.items
For i=0 To ubound(cles)
Randomize
NB = Int((ubound(cles) - Lbound(cles)+ 1) - cles(i)*Rnd)
Next
'wscript.echo NB
jeu = dico.item(NB)
'wscript.echo jeu
Ws.Run "%comspec% /c Start iexplore " & jeu,0,True
wscript.sleep 5000
Question = MsgBox ("Vouliez-vous ouvrir ce Jeu en plein écran ?" & Vbcr &_
 "SI oui , alors cliquez sur [OUI]  ?"& Vbcr &_
 "Sinon , alors cliquez sur [NON]",VBYesNO+VbQuestion,Titre)
 If Question = VbYes then
    WS.AppActivate jeu
    WS.SendKeys "{F11}" 'pour mettre internet explorer en plein écran
else
        WScript.Quit
 End if
Set WS = Nothing
Set objFSO = Nothing
End Function
 
 Sub SplashScreen()
 Dim shell : Set shell = CreateObject("WScript.Shell")
 Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
 Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
 Dim tempName : tempName = "Splash.hta"
 Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName)
tempFile.Writeline "<html>"
tempFile.Writeline "<head>"
tempFile.Writeline "<bgsound src="" loop="">"
tempFile.Writeline "<title>Splash Screen</title>"   
tempFile.Writeline "<HTA ID="" APPLICATIONNAME="" BORDER="" CAPTION="" SHOWINTASKBAR="" SINGLEINSTANCE="" SYSMENU="" SCROLL="" WINDOWSTATE="">"
tempFile.Writeline "<link rel="" media="" type="" title="" href="">"
tempFile.Writeline "</head>"
tempFile.Writeline"<SCRIPT LANGUAGE="">"
tempFile.Writeline "Sub CenterWindow(x,y)"       
tempFile.Writeline         "window.resizeTo x, y"     
tempFile.Writeline         "iLeft = window.screen.availWidth/2 - x/2"     
tempFile.Writeline         "itop = window.screen.availHeight/2 - y/2"   
tempFile.Writeline       "window.moveTo ileft, itop"     
tempFile.Writeline "End Sub"   
tempFile.Writeline "Sub Window_OnLoad"
tempFile.Writeline      "CenterWindow 400,300"
tempFile.Writeline      "iTimerID = window.setInterval(""ShowSplash"", 35000)"
tempFile.Writeline "End Sub"
tempFile.Writeline "Sub ShowSplash"
tempFile.Writeline     "Window.Close()"
tempFile.Writeline "End Sub"
tempFile.Writeline "</SCRIPT>"
tempFile.Writeline "<body bgcolor="">"
tempFile.Writeline "<DIV id="">"
tempFile.Writeline "<CENTER>"
tempFile.Writeline "<p>"
tempFile.Writeline "<center><font face=""><b><i>Veuillez Patienter SVP pendant le Téléchargement</i></b></font><br><br><img src=""></center><br>"
tempFile.Writeline "<center onselectstart="" ondragstart="" oncontextmenu="">"
tempFile.Writeline "<marquee DIRECTION="" HEIGHT="" WIDTH="" SCROLLAMOUNT="" onselectstart="">"
tempFile.Writeline "<center><img src=""></center><br>"
tempFile.Writeline "<center><font face="">Téléchargement en cours <img src=""><br>"&_
"Téléchargement en cours <img src=""><br>"&_
"Téléchargement en cours <img src=""><br>"&_
"Téléchargement en cours <img src=""></b></font></center>"
tempFile.Writeline "<br><center><font face="">by © Hackoo 2012<br><br></font></center><center><img src=""></center></marquee>"
tempFile.Writeline "</center>"
tempFile.Writeline "</p>"
tempFile.Writeline "</CENTER>"
tempFile.Writeline "</DIV>"
tempFile.Writeline "</body>"
tempFile.Writeline "</html>"
shell.Run tempFolder & "\" & tempName ,1,True
End Sub




Dernière édition par Hackoo le Mar 31 Juil 2012 - 12:13; édité 1 fois

______________________________________________________
Mes Contributions en Téléchargement
Message Publicité 
PublicitéSupprimer les publicités ?


Répondre en citant
Message [VBS] Téléchargements par Lots des Jeux Flash 
Merci de poster les codes sur le forum ça evite qu'il disparaisse sur les hebergeurs tiers au bout d'un certain temps

le coloration syntaxique est disponible sur le forum en utilisant ses balises


Arrow http://batch.xoo.it/t2820-tuto-Bien-se-servir-de-la-balise-CODE.htm




______________________________________________________
Faites paraitre votre batch sur BatchClipboard
Visiter le site web du posteur
Message [VBS] Téléchargements par Lots des Jeux Flash 


Montrer les messages depuis:
Répondre au sujet Page 1 sur 1
  



Index | créer un forum | Forum gratuit d’entraide | Annuaire des forums gratuits | Signaler une violation | Conditions générales d'utilisation
Copyright 2008 - 2016 // Batch