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 |
Partager