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
'************************************************************************** |
Comment tester la connexion internet derrière un proxy ?
Répondre avec citation
Partager