2015-05-02 2 views
0

У меня есть это VBScript, который хорошо работает на Windows 7 32-бит без доверенностиКак проверить подключение к Интернету за прокси?

Для того, чтобы улучшить его, я ищу для этого решения: Как проверить подключение к Интернету через прокси-сервер? Решение может быть в VBScript или Powershell или Batch, так как я нахожу способ проверить, подключен я или нет за прокси!

Кусок кода, чтобы улучшить его, когда я нахожусь за прокси

Если есть трюк, чтобы проверить, если я подключен к Интернету, когда я нахожусь за прокси-сервером, это мой вопрос?

If CheckConnection = true then 
    Msgbox "i'm connected to internet",vbinformation+vbSystemModal,"Check connection to internet" 
Else 
    Msgbox "i'm not connected to internet",vbCritical+vbSystemModal,"Check connection to internet" 
End if 
'*************************************************************************** 
Function CheckConnection() 
    CheckConnection = False 
     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 
End Function 
'****************************************************************************** 

Код отверстия:

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 
'************************************************************************** 
+1

Я не знаю, почему вы downvote этот вопрос? по крайней мере, вы должны оставить комментарий, чтобы объяснить ваш downvote ?? – Hackoo

+1

Я не спускал вниз, но я получаю «напишу свой код для меня» из этого вопроса (хотя я знаю, что вы не тот человек, который спрашивает «напишите мой код для меня»). – SomethingDark

+0

@SomethingDark ok :) моя цель - просто улучшить мой код, потому что я пишу и тестирую только на windows 7; и я разделяю весь свой код; поэтому я отредактирую его, чтобы сосредоточиться на части, где я хочу ее улучшить :) – Hackoo

ответ

1

Если вы имеете в виду настройки локального компьютера вы можете запросить реестр:

REG QUERY "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings" /v ProxyEnable 

Если значение 0x1, то есть установлен прокси. Вы также можете проверить значение прокси-сервера через значение ProxyServer в том же месте. Больше информации here.

Вы можете проверить, совпадает ли ваш внешний IP-адрес с вашим внутренним IP-адресом. Это использует winhttpjs.bat

for /f "skip=1 tokens=* delims=" %%a in ('winhhttpjs.bat "http://www.telize.com/ip" -saveTo con') do (
    set "ip=%%a" 
) 
ipconfig| find "%ip%" || (
    echo not real IP/proxy 
) 
+0

Спасибо за ваше предложение; но вы можете проверить мое редактирование, чтобы понять, какова моя настоящая цель;) – Hackoo

+0

@Hackoo проверить мои изменения. – npocmaka

+0

Очень хороший гибрид (JS/Batch) действительно;) – Hackoo

Смежные вопросы