Discussion :

[Austral]

Bonjour,

Etant novice en VBS j ai un besoin de créer un script qui à partir d'un fichier à plat contenant une liste d'url(input) check le code retour suite à un get http sur chaque url.

Le resultat du check (output) sera dans un fichier à plat avec ok par ok, ok si code http 200,301,302,401 sinon ko.

Merci par avance pour vos réponse et votre aide

[hackoofr]

vbscript to check whether a website is working

[hackoofr]

Voilà, j'ai testé ce code chez moi avec quelques URL(s) et il marche 5/5
à omen999 pour la fonction GetFileDlg()

Le fichier à lire s’appelle URL2check.txt

URL2check.txt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
http://fileforum.betanews.com/sendfile/1043809773/1/1372086246.e011047efb728b12cee10259636ee4eed2e15f80/spybotsd-2.1.20-SR1.exe
http://www.exterminate-it.com/downloads/ExterminateItSetup.exe
http://general-changelog-team.fr/fr/downloads/finish/20-outils-de-xplode/2-adwcleaner.exe
http://www.malwarebytes.org/mbam-download-exe.php
http://data.mbamupdates.com/tools/mbam-rules.exe
http://files.snapfiles.com/localdl936/ccsetup402_slim.exe
http://tigzy.geekstogo.com/Tools/RogueKiller.exe
http://dl.360safe.com/md_setup_en.exe
http://dl.surfright.nl/HitmanPro.exe
http://dl.surfright.nl/HitmanPro_x64.exe
frk.gamib.net/x/tomJER/tomJER.swf
frk.gamib.net/x/madarrow/madarrow.swf
frk.gamib.net/x/papaspizzeria/papaspizzeria.swf
frk.gamib.net/x/shatterbot/shatterbot.swf
frk.gamib.net/x/orcsattack/orcsattack.swf
frk.gamib.net/x/rockyrider/rockyrider.swf
frk.gamib.net/x/rodriguezrevenge/rodriguezrevenge.swf
frk.gamib.net/x/toxic/toxic.swf
frk.gamib.net/x/cobYHF/cobYHF.swf
www.gametop.com/online-free-games/anti-terror-force-online/game.swf
www.gametop.com/online-free-games/hardcore-bike-online/game.swf
www.gametop.com/online-free-games/free-pool/game.swf
www.gametop.com/online-free-games/desert-rider-online/game.swf
www.gametop.com/online-free-games/burning-skies-online/game.swf
www.gametop.com/online-free-games/mech-combats-online/game.swf
www.gametop.com/online-free-games/mad-doctors-online/game.swf
www.gametop.com/online-free-games/star-wings-nd-online/game.swf
www.gametop.com/online-free-games/gangsta-war-online/game.swf
www.gametop.com/online-free-games/mario-gun-online/game.swf
www.gametop.com/online-free-games/crusader-tank-online/game.swf
www.gametop.com/online-free-games/helicopter-strike-force-online/game.swf
www.gametop.com/online-free-games/bike-adventure-online/game.swf
www.gametop.com/online-free-games/bmx-master-online/game.swf
www.gametop.com/online-free-games/dabomb-pong-online/game.swf
www.gametop.com/online-free-games/real-pool-online/game.swf
www.gametop.com/online-free-games/galaxy-invaders-online/game.swf
www.gametop.com/online-free-games/atv-extreme-online/game.swf
www.gametop.com/online-free-games/hell-cops-online/game.swf
www.jeuxclic.com/jeux/game-1270029047.swf
www.jeuxclic.com/jeux/game-1330427666.swf
www.jeuxclic.com/jeux/game-1272902153.swf
www.jeuxclic.com/jeux/game-1247346995.swf
www.jeuxclic.com/jeux/game-1267695602.swf
www.jeuxclic.com/jeux/game-1280874797.swf
www.jeuxclic.com/jeux/game-1274396670.swf
www.gametop.com/online-free-games/free-pool/game.swf

Le Vbscript en question s'appelle CheckURLInFile.vbs
CheckURLInFile.vbs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Option Explicit
'************************************************************************************** 
' GetFileDlg() And GetFileDlgBar() by omen999 - may 2014 - http://omen999.developpez.com
' Universal Browse for files function  
' compatibility : all versions windows and IE - supports start folder, filters and title
' note : the global size of the parameters cannot exceed 191 chars for GetFileDlg 
'**************************************************************************************
Dim Title,sIniDir,sFilter,sTitle,InFile,WshShell,fso,URL,ProtocoleHTTP,LogFile,Data,i
Title = "Check URL © Hackoo 2014"
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
sIniDir = WshShell.CurrentDirectory & "\url2check.txt"
sFilter = "Fichiers Textes (*.txt)|*.txt|Tous les fichiers (*.*)|*.*|"
sTitle = Title & "   Parcourir le fichier texte"
'sIniDir must be conformed to the javascript syntax
InFile = GetFileDlg(Replace(sIniDir,"\","\\"),sFilter,sTitle)
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "log"
If fso.FileExists(LogFile) Then fso.DeleteFile LogFile
Data = ReadFileText(InFile)
MsgBox Data
URL = Split(Data,VbCrLF)
ProtocoleHTTP = "http://"
For i = LBound(URL) To UBound(URL)
	If Left(URL(i),7) <> ProtocoleHTTP Then
		URL(i) = ProtocoleHTTP & URL(i)
		Call Check(URL(i))
	Else
		Call Check(URL(i))
	End if
Next
Call Explorer(LogFile)
'****************************************************************************************************************
Sub Check(URL)
    On Error Resume Next
    Dim xmlhttp
    Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
    xmlhttp.open "HEAD",URL,False
    xmlhttp.send
    If Err = 0 Then
        Select Case Cint(xmlhttp.status)
        Case 200,202,301,302,401
            Set xmlhttp = Nothing
            Call WriteLog(DblQuote(URL) & VbTab &" ====> "& VbTab &" OK !")
        Case Else
            Set xmlhttp = Nothing
            Call WriteLog(DblQuote(URL) & VbTab &" ====> "& VbTab & "**/!\** KO **/!\**")
        End Select
    Else
        Call WriteLog(Err.Description)
    End If
End Sub
'******************************************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'******************************************************************************************************************
Sub WriteLog(strText)
Dim fs,ts 
Const ForAppending = 8
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "log", ForAppending, True)
	ts.WriteLine strText
	ts.Close
End Sub
'******************************************************************************************************************
Function GetFileDlg(sIniDir,sFilter,sTitle)
 GetFileDlg=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script><hta:application showintaskbar=no />""").StdOut.ReadAll
End Function
'******************************************************************************************************************
Function ReadFileText(sFile)
    Dim objFSO,oTS,sText
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oTS = objFSO.OpenTextFile(sFile)
    sText = oTS.ReadAll
    oTS.close
    set oTS = nothing
    Set objFSO = nothing
    ReadFileText = sText
End Function 
'******************************************************************************************************************
Function Explorer(File)
	Dim ws
	Set ws=CreateObject("wscript.shell")
	ws.run "Explorer "& File & "\",1,True
end Function
'******************************************************************************************************************