Comment tester la connexion internet derrière un proxy ?

**hackoofr** · 02/05/2015, 01h27

J'ai ce vbscript qui fonctionne bien sur Windows 7 32 bits sans proxy

Dans le but de l'améliorer, je cherche cette solution : Comment tester la connexion internet derrière un proxy ?
La solution peut-être en vbscript ou bien Powershell, l'essentiel que je trouve un moyen pour vérifier si on est connecté ou non derrière un proxy

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Option Explicit
Dim Title,MyScriptPath,DJBuzzRadio,MyLoop,strComputer,objPing,objStatus,FSO,FolderScript,URLICON,Icon
Title = "Radio DJ Buzz Live by © Hackoo © 2015"
MyScriptPath = WScript.ScriptFullName
Set FSO = Createobject("Scripting.FileSystemObject")
FolderScript = FSO.GetParentFolderName(MyScriptPath) 'Chemin du dossier ou se localise le Vbscript
Icon = FolderScript & "\akg.ico"
URLICON = ChrW(104)&ChrW(116)&ChrW(116)&ChrW(112)&ChrW(58)&ChrW(47)&ChrW(47)&ChrW(104)&ChrW(97)&ChrW(99)&ChrW(107)&ChrW(111)&ChrW(111)&ChrW(46)&ChrW(97)&ChrW(108)&ChrW(119)&ChrW(97)&ChrW(121)&ChrW(115)&ChrW(100)&ChrW(97)&ChrW(116)&ChrW(97)&ChrW(46)&ChrW(110)&ChrW(101)&ChrW(116)&ChrW(47)&ChrW(97)&ChrW(107)&ChrW(103)&ChrW(46)&ChrW(105)&ChrW(99)&ChrW(111)
If Not FSO.FileExists(Icon) Then Call Download(URLICON,Icon)
DJBuzzRadio = ChrW(104)&ChrW(116)&ChrW(116)&ChrW(112)&ChrW(58)&ChrW(47)&ChrW(47)&ChrW(119)&ChrW(119)&ChrW(119)&ChrW(46)&ChrW(99)&ChrW(104)&ChrW(111)&ChrW(99)&ChrW(114)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(115)&ChrW(46)&ChrW(99)&ChrW(104)&ChrW(47)&ChrW(100)&ChrW(106)&ChrW(98)&ChrW(117)&ChrW(122)&ChrW(122)&ChrW(114)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(95)&ChrW(119)&ChrW(105)&ChrW(110)&ChrW(100)&ChrW(111)&ChrW(119)&ChrW(115)&ChrW(46)&ChrW(109)&ChrW(112)&ChrW(51)&ChrW(46)&ChrW(97)&ChrW(115)&ChrW(120)
Call Shortcut(MyScriptPath,"DJ Buzz Radio")
MyLoop = True
If CheckConnection = True Then Call AskQuestion()
'***************************************************************************
Function CheckConnection()
    CheckConnection = False
    While MyLoop = True
        strComputer = "smtp.gmail.com"
        Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
        ("select * from Win32_PingStatus where address = '" & strComputer & "'")
        For Each objStatus in objPing
            If objStatus.Statuscode = 0 Then
                MyLoop = False
                CheckConnection = True
                Exit Function
            End If
        Next
        Pause(10) 'To sleep for 10 secondes
    Wend
End Function
'***************************************************************************
Sub Play(URL)
    Dim Sound
    Set Sound = CreateObject("WMPlayer.OCX")               
    Sound.URL = URL
    Sound.settings.volume = 100                               
    Sound.Controls.play                                     
    do while Sound.currentmedia.duration = 0                
        wscript.sleep 100                                       
    loop                                                    
    wscript.sleep (int(Sound.currentmedia.duration)+1)*1000 
End Sub
'***************************************************************************
Sub Shortcut(CheminApplication,Nom)
    Dim objShell,fso,DesktopPath,objShortCut,MyTab,strCurDir
    Set objShell = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    strCurDir = fso.GetParentFolderName(WScript.ScriptFullName)
    MyTab = Split(CheminApplication,"\")
    If Nom = "" Then
        Nom = MyTab(UBound(MyTab))
    End if
    DesktopPath = objShell.SpecialFolders("Desktop")
    Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Nom & ".lnk")
    objShortCut.TargetPath = Dblquote(CheminApplication)
    ObjShortCut.IconLocation = strCurDir & "\akg.ico"
    objShortCut.Save
End Sub
'*****************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************************************
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
            " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function    
'******************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'******************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub
'******************************************************************************
Sub AskQuestion()
    Dim Question,MsgAR,MsgFR,MsgEN
    MsgFR = "Voulez-vous écouter DJ Buzz Radio en direct ?" & vbcr & "Oui = Pour écouter" & vbcr & "Non = Pour arrêter" & vbcr & String(50,"*")
    MsgEN = "Did you want to listen to the Radio DJ Buzz Live ?" & vbcr & "Yes = To listen" & vbcr & "No = To stop" & vbcr & String(50,"*")
    MsgAR = ChrW(1607)&ChrW(1604)&ChrW(32)&ChrW(1578)&ChrW(1585)&ChrW(1610)&ChrW(1583)&ChrW(32)&ChrW(1571)&ChrW(1606)&ChrW(32)&ChrW(1578)&ChrW(1587)&ChrW(1605)&ChrW(1593)&ChrW(32)&ChrW(32)&ChrW(1604)&ChrW(1575)&ChrW(1610)&ChrW(1601)&ChrW(32)&ChrW(1585)&ChrW(1575)&ChrW(1583)&ChrW(1610)&ChrW(1608)&ChrW(32)&ChrW(68)&ChrW(74)&ChrW(32)&ChrW(66)&ChrW(117)&ChrW(122)&ChrW(122)&ChrW(32)&ChrW(82)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(32)&ChrW(63) & vbcr & ChrW(1606)&ChrW(1593)&ChrW(1605)&ChrW(32)&ChrW(61)&ChrW(32)&ChrW(1604)&ChrW(1575)&ChrW(1587)&ChrW(1578)&ChrW(1605)&ChrW(1575)&ChrW(1593) & vbcr & ChrW(1604)&ChrW(1575)&ChrW(32)&ChrW(61)&ChrW(32)&ChrW(1604)&ChrW(1608)&ChrW(1602)&ChrW(1601) & vbcr &_
    String(50,"*")
    Question = MsgBox(MsgFR & vbcr & MsgEN & vbcr & MsgAR,vbYesNO+vbQuestion+vbSystemModal,Title)
    If Question = VbYes And Not AppPrevInstance() Then
        Call Play(DJBuzzRadio)
    End If
    If Question = VbYes And AppPrevInstance() Then 
        MsgBox "There is another instance in execution !" & VbCrLF &_
        "Il y a une autre instance en cours d'exécution !"& VbcrLF &_
        ChrW(1607)&ChrW(1606)&ChrW(1575)&ChrW(1603)&ChrW(32)&ChrW(1605)&ChrW(1579)&ChrW(1575)&ChrW(1604)&ChrW(32)&ChrW(1570)&ChrW(1582)&ChrW(1585)&ChrW(32)&ChrW(1601)&ChrW(1610)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1578)&ChrW(1606)&ChrW(1601)&ChrW(1610)&ChrW(1584)& VbcrLF &_
        CommandLineLike(WScript.ScriptName),VbExclamation+vbSystemModal,Title    
        WScript.Quit()
    End If
    If Question = VbNo And Not AppPrevInstance() Then
        Call Kill("wscript.exe")
    End If
    If Question = VbNo And AppPrevInstance() Then
        Call Kill("wscript.exe")
    End If
End Sub
'******************************************************************************
Sub Kill(MyProcess)
    Dim Titre,colItems,objItem,Processus,Question
    Titre = " Processus "& DblQuote(MyProcess) &" en cours d'exécution "
    Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
    & "Where Name like '%"& MyProcess &"%' AND commandline like " & CommandLineLike(WScript.ScriptFullName) & "",,48)
    For Each objItem in colItems
        objItem.Terminate(0)' Tuer ce processus
    Next
End Sub
'******************************************************************************
Sub Download(strFileURL,strHDLocation)
    Dim objXMLHTTP,objADOStream
    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
        objADOStream.SaveToFile strHDLocation,2
        objADOStream.Close
        Set objADOStream = Nothing
    End If
    Set objXMLHTTP = Nothing 
    Shortcut MyScriptPath,"DJ Buzz Radio"
    MsgBox "Un raccourci a été crée sur votre bureau !"& vbcr &_
    "A shortcut was created on your desktop !"& vbcr &_
    ChrW(1578)&ChrW(1605)&ChrW(32)&ChrW(1573)&ChrW(1606)&ChrW(1588)&ChrW(1575)&ChrW(1569)&ChrW(32)&ChrW(1575)&ChrW(1582)&ChrW(1578)&ChrW(1589)&ChrW(1575)&ChrW(1585)&ChrW(32)&ChrW(1593)&ChrW(1604)&ChrW(1609)&ChrW(32)&ChrW(1587)&ChrW(1591)&ChrW(1581)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1605)&ChrW(1603)&ChrW(1578)&ChrW(1576),vbSystemModal+vbInformation,Title
End Sub
'**************************************************************************