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
| Option Explicit
Dim URL,fso,ws,LogFile,sSrcUrl,oHTTP,bGetAsAsync,HTA,Data
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("Wscript.Shell")
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "hta"
if fso.FileExists(LogFile) Then
fso.DeleteFile LogFile
end If
If IsInternetConnected = True Then
If Lang = True Then
sSrcUrl = "https://fr.giveawayoftheday.com/"
Else
sSrcUrl = "https://www.giveawayoftheday.com/"
End if
End If
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
bGetAsAsync = False
oHTTP.open "GET", sSrcUrl, bGetAsAsync
oHTTP.send
If oHTTP.status <> 200 Then
WScript.Echo "unexpected status = " & oHTTP.status & vbCrLf & oHTTP.statusText
WScript.Quit
End If
Data = oHTTP.responseText
HTA = "<html>" & vbCrLf &_
"<title>Giveaway of the day by Hackoo</title>" & vbCrLf &_
"<head>" & vbCrLf &_
"<HTA:APPLICATION" & vbCrLf &_
"APPLICATIONNAME=""GiveAway of the Day""" & vbCrLf &_
"Icon=DxDiag.exe" & vbCrLf &_
"BORDER=""thin""" & vbCrLf &_
"MAXIMIZEBUTTON=""no""" & vbCrLf &_
"MINIMIZEBUTTON=""no""" & vbCrLf &_
"SCROLL=""no""" & vbCrLf &_
"SINGLEINSTANCE=""yes""" & vbCrLf &_
"CONTEXTMENU=""no""" & vbCrLf &_
"SELECTION=""no""/>" & vbCrLf &_
"<SCRIPT language=""VBScript"">" & vbCrLf &_
"Sub Window_OnLoad" & vbCrLf &_
"window.resizeTo 450,380" & vbCrLf &_
"WindowLeft = (window.screen.availWidth - 450)" & vbCrLf &_
"WindowTop = (window.screen.availHeight - 380)" & vbCrLf &_
"window.moveTo WindowLeft, WindowTop" & vbCrLf &_
"end sub" & vbCrLf &_
"</script>" & vbCrLf &_
"</head>" & vbCrLf &_
"<center>" & vbCrLf &_
"<meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"" />" & vbCrLf &_
"<meta http-equiv=""X-UA-Compatible"" content=""IE=edge"">" & vbCrLf &_
"<link rel=""stylesheet"" href=""https://www.giveawayoftheday.com/css/main.css"" />"
WriteLog HTA,LogFile
WriteLog Extract(Data),LogFile
WriteLog "</html>",LogFile
ws.run LogFile
'****************************************************************
Function Extract(Data)
Dim oRE,oMatches,Match,Line
set oRE = New RegExp
oRE.IgnoreCase = True
oRE.Global = True
oRE.MultiLine = True
oRE.Pattern = "<div class=""giveaway_wrap cf"">(?:(?!""giveaway_counter first"">)[\s\S])*</div>"
set oMatches = oRE.Execute(Data)
If not isEmpty(oMatches) then
For Each Match in oMatches
Line = Match.Value
Extract = Line
Next
End if
End Function
'*****************************************************************
Sub WriteLog(strText,LogFile)
Dim fs,ts
Const ForAppending = 8
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(LogFile,ForAppending,True,-1)
ts.WriteLine strText
ts.Close
End Sub
'*****************************************************************
Function Lang()
Dim sComputer,oWMI,colOperatingSystems,oOS,iOSLang
sComputer = "."
Set oWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& sComputer _
& "\root\cimv2")
Set colOperatingSystems = oWMI.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each oOS in colOperatingSystems
iOSLang = oOS.OSLanguage
Next
If (iOSLang = 1036) Then
Lang = True
Else
Lang = False
End If
End Function
'*****************************************************************
Function IsInternetConnected()
Dim MyLoop,strComputer,objPing,objStatus
IsInternetConnected = False
MyLoop = True
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
IsInternetConnected = True
Exit Function
End If
Next
MsgBox "Check your internet connection !",vbExclamation,"Check your internet connection !"
Pause(10) 'To sleep for 10 secondes
Wend
End Function
'******************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'****************************************************************** |
