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
| '**************************************************************************
'* https downloader - omen999 - may 2019 - https://omen999.developpez.com
'**************************************************************************
Const SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = 13056
Dim fileName
Dim rep
Dim child
Dim method,fileSize,PID
Dim wmi
Dim memInit,memCur
Class pgBar
Private sScript,sAbout,bUserShft,lpShift,spTitle,oHta
Public lRfRate,lSampling,lHeight,lWidth,lLeft,lTop
Private Sub Class_Initialize()
' update default values
lpShift=1
lRfRate=5
lHeight=98
lWidth=670
lLeft=0
lTop=0
spTitle=""
End Sub
Public Property Get lShift(lParam)
lpShift=lParam
bUserShft=True
End Property
Public Default Function Display(sTitle,sMsg,bIsPgBar,bCan)
If sTitle<>"" Then spTitle=sTitle
If bIsPgBar And Not(bUserShft) Then lpShift=1
sScript="var f=0,cOut,p;var aT=new Array();"&_
"var aP=new Array();document.title='"&spTitle&"';resizeTo("&lWidth&","&lHeight&");moveTo("&lLeft&"+("&lLeft&"==0)*(screen.width-"&lWidth&")/2,"&lTop&"+("&lTop&"==0)* (screen.height-"&lHeight&")/2);"&_
"function window.onload(){bdy.style.filter=""progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#CFCFCF',EndColorStr='#E8E8E8')"";bdy.style.fontFamily='MS Sans Serif';"&_
"bdy.style.fontSize='9pt';pgb.style.position='absolute';pgb.style.width='100%';pgb.style.bottom='10px';pgb.style.lineHeight='8px';pgb.style.borderWidth=1;pgb.style.borderStyle='inset';"&_
"pgb.style.backgroundColor='#F5F5F5';lab.innerText='"&sMsg&"';bar.style.posWidth=0;if("&bCan&"){lab.style.width='80%';btn.style.position='absolute';btn.style.bottom='28px';btn.style.right='10px';"&_
"btn.style.height='22px';btn.style.width='70px';btn.accessKey='a';btn.style.fontSize='8pt';btn.attachEvent('onclick',btn_onclick);cOut=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1);}else{btn.style.visibility='hidden';}"&_
"if("&bIsPgBar&"){bar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#FFFFFF',EndColorStr='#00CC00')"";readIn();}"&_
"else {bar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(GradientType=1,StartColorStr='#FFCCFFCC',EndColorStr='#FF00CC00')"";rgbar.style.position='absolute';rgbar.style.width=pgb.clientWidth;"&_
"rgbar.style.posRight=0;rgbar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(GradientType=1,StartColorStr='#FF00CC00',EndColorStr='#FFCCFFCC')"";setInterval(updBar,"&lRfRate&");}}"&_
"function updBar(){if(bar.style.posWidth<pgb.clientWidth-2){bar.style.posWidth+="&lpShift&";rgbar.style.posWidth-="&lpShift&";}else{bar.style.posWidth=0;rgbar.style.posWidth=pgb.clientWidth}}"&_
"function updBarT(iPc,n){if(aP[n]<iPc*pgb.clientWidth/(100*"&lpShift&")){bar.style.posWidth+="&lpShift&";aP[n]++;}else{clearInterval(aT[n]);readIn();}}"&_
"function updData(iPc,sM){var j;if(sM!=''){lab.innerText=sM;};j=aT.length;aP[j]=0;aT[j]=setInterval(function(){updBarT(iPc,j);},"&lRfRate&");}"&_
"function readIn(){var b,h,c;if(f==0){b=parseInt(cIn.Read(3),10);if(!isNaN(b)){h=parseInt(cIn.Read(3),10);if(!isNaN(h)){c=cIn.Read(h);if(c=='#cls#'){close();}else{updData(b,c);}}}else f=1;} }"&_
"function btn_onclick(){clearInterval(aT[aT.length-1]);cOut.Write(Math.round(bar.style.posWidth/pgb.clientWidth*100));close()}"
'maxsize sAbout string : 508 octets current : 350 octets
sAbout= "about:<SCRIPT>var cIn=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0);eval(cIn.Read("&Len(sScript)&"));</SCRIPT><HTA:APPLICATION SHOWINTASKBAR=""no"" SCROLL=""no"" BORDER=""dialog"" INNERBORDER=""no""><BODY ID=""bdy""><DIV ID=""lab""></DIV><DIV ID=""pgb""><SPAN ID=""bar""></SPAN><SPAN ID=""rgbar""></SPAN></DIV><BUTTON ID=""btn""><U>A</U>nnuler</BUTTON></BODY>"
Set oShell=CreateObject("WScript.Shell")
Set oHta=oShell.Exec("mshta.exe """ & sAbout & """")
oHta.StdIn.Write sScript
Set Display=oHta.StdOut
End Function
Public Function Change(lPerc,sMsg)
' improper value of lPerc will be ignored
If (Not IsNumeric(lPerc)) Or (lPerc<0) Then lPerc=0
If lPerc>100 Then lPerc=100
On Error Resume Next
oHta.StdIn.Write Right("00"&CStr(lPerc),3) & Right("00"&CStr(Len(sMsg)),3) & sMsg
Change=Err.Number
On Error GoTo 0
End Function
Public Sub Close()
Change 0,"#cls#"
End Sub
Public Sub Kill()
oHta.Terminate
End Sub
End Class
' init http object
Set oHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
' oHttp.onreadystatechange = GetRef("OnStateChange") ' useless now
oHttp.setOption(2) = SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
' init variables
Set child=GetObject("winmgmts:Win32_process.Handle='" & CreateObject("WScript.Shell").Exec("rundll32 kernel32,Sleep").ProcessId & "'")
PID = child.ParentProcessId
child.Terminate
FileName="PDFCreator-3_4_1-Setup.exe"
URL = "https://silver.download.pdfforge.org/pdfcreator/3.4.1/PDFCreator-3_4_1-Setup.exe"
' get file size before downloading
method = "HEAD"
oHttp.open method,URL,False 'sync
oHttp.send()
fileSize = CDbl(oHttp.getResponseHeader("Content-Length"))
Set wmi = GetObject("winmgmts:\\.\root\cimv2")
memInit = wmi.ExecQuery("SELECT * FROM Win32_Process WHERE ProcessId=" & PID).ItemIndex(0).WorkingSetSize
' start downnloading
method = "GET"
oHttp.open method,URL,true 'async
oHttp.setRequestHeader "Content-Type","text/xml"
oHttp.send()
' display progressbar
Set oPgb=New pgBar
Set oStatut=oPgb.Display("Downloader by omen999 - https://omen999.developpez.com","Download " & fileName & " (" & fileSize & " octets) in progress, please wait",1,1)
oPgb.Change 0,"" ' update display pgbar
' main loop
Do Until oHttp.readyState = 4
WScript.Sleep 100
'downCount = wmi.ExecQuery("SELECT * FROM Win32_Process WHERE ProcessId=" & PID).ItemIndex(0).WriteTransferCount
' updated at the end of the download only, so useless
memCur = CDbl(wmi.ExecQuery("SELECT * FROM Win32_Process WHERE ProcessId=" & PID).ItemIndex(0).WorkingSetSize)
downCur = Int((memCur - memInit) * 102 / fileSize) ' 102 : coef delta correlation
If downCur < 101 Then
If oPgb.Change( 1,"Download " & fileName & " (" & fileSize & " octets) in progress, please wait - " & Cstr(downCur) & " %") < 0 Then
oHttp.abort
MsgBox "Download canceled",0,"Downloader by omen999 - https://omen999.developpez.com"
WScript.Quit
End if
End if
Loop
oPgb.Close
' save file downloaded
If oHttp.status = 200 Then 'OK
With CreateObject("ADODB.Stream")
.Open
.Type = 1 'adTypeBinary
.Write oHttp.responseBody
.Position = 0
.SaveToFile FileName ,2
.Close
End With
MsgBox FileName & " downloaded",0,"Downloader by omen999 - https://omen999.developpez.com"
End If |
