二进制文件转换为文本工具

脚本专栏 hta 分类:[default] 更新日期: 2015-07-19

保存为.hta运行
代码如下:

<!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 
     
    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 & "<html>"                    & vbcrlf
    htm = htm & "<head>"                    & vbcrlf
    htm = htm & "<title>selfdec</title>"    & vbcrlf
    htm = htm & "<meta http-equiv=""Content-Type"" content=""text/html; charset=GB2312"">" & vbcrlf
    htm = htm & "<HTA:APPLICATION "            & vbcrlf
    htm = htm & "    ID=""selfdec"" "        & vbcrlf
    htm = htm & "    APPLICATIONNAME=""self"" " & vbcrlf
    htm = htm & "    VERSION=""0.1"" "        & vbcrlf
    htm = htm & "    SCROLL=""no"" "            & vbcrlf
    htm = htm & "    INNERBORDER=""no"" "    & vbcrlf
    htm = htm & "    CONTEXTMENU=""no"" "    & vbcrlf
    htm = htm & "    CAPTION=""no"" "        & vbcrlf
    htm = htm & "    ICON=""no"" "            & vbcrlf
    htm = htm & "    SHOWINTASKBAR=""no"" "    & vbcrlf
    htm = htm & "    SINGLEINSTANCE=""yes"" "& vbcrlf
    htm = htm & "    SYSMENU=""no"" "        & vbcrlf
    htm = htm & "    MAXIMIZEBUTTON =""no""" & vbcrlf
    htm = htm & "    WINDOWSTATE=""normal""" & vbcrlf
    htm = htm & "    NAVIGABLE=""yes"""        & vbcrlf
    htm = htm & "    />"                        & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "<SCRIPT LANGUAGE=""VBScript"">"        & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "'//保存文件"                & vbcrlf
    htm = htm & "function saveFile(filename,str)"        & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    set adodbStream = CreateObject(""ADODB"" & ""."" & ""Stream"")" & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    adodbStream.Type= 1"    & vbcrlf
    htm = htm & "    adodbStream.Open"        & vbcrlf
    htm = htm & "    adodbStream.write str"    & vbcrlf
    htm = htm & "    adodbStream.SaveToFile filename,2" & vbcrlf
    htm = htm & "    adodbStream.Close"        & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "end function"                & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "'//VB数组转变成二进制格式" & vbcrlf
    htm = htm & "Function MultiByteToBinary(MultiByte)" & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    Dim RS, LMultiByte, Binary"            & vbcrlf
    htm = htm & "    Const adLongVarBinary = 205"        & vbcrlf
    htm = htm & "    Set RS = CreateObject(""ADODB.Recordset"")" & vbcrlf
    htm = htm & "    LMultiByte = LenB(MultiByte)"        & vbcrlf
    htm = htm & "    If LMultiByte>0 Then"    & vbcrlf
    htm = htm & "        RS.Fields.Append ""mBinary"", adLongVarBinary, LMultiByte"    & vbcrlf
    htm = htm & "        RS.Open"            & vbcrlf
    htm = htm & "        RS.AddNew"            & vbcrlf
    htm = htm & "        RS(""mBinary"").AppendChunk MultiByte & ChrB(0)"            & vbcrlf
    htm = htm & "        RS.Update"            & vbcrlf
    htm = htm & "        Binary = RS(""mBinary"").GetChunk(LMultiByte)"                & vbcrlf
    htm = htm & "    End If"                    & vbcrlf
    htm = htm & "    MultiByteToBinary = Binary"            & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "End Function"                & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "function DeleteMe()"        & vbcrlf
    htm = htm & "    "                        & vbcrlf
    htm = htm & "    dim filename"            & vbcrlf
    htm = htm & "    filename    = document.location.href" & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    filename    = mid(filename,instrrev(filename,""/"")+1)" & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    Dim fso, MyFile"        & vbcrlf
    htm = htm & "    Set fso        = CreateObject(""Script" & "ing.FileS" & "ystemObject"")    " & vbcrlf
    htm = htm & "    Set MyFile    = fso.GetFile(filename)" & vbcrlf
    htm = htm & "        MyFile.Delete"        & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "end function"                & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "function exec()"            & vbcrlf
    htm = htm & "    "                        & vbcrlf
    htm = htm & "    '//屏蔽错误"            & vbcrlf
    htm = htm & "    'on error resume next"    & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    '//改变窗体大小"        & vbcrlf
    htm = htm & "    window.resizeTo 0,0"    & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    dim data,t,kk,filename" & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    '//得到数据"            & vbcrlf
    htm = htm & "    data        = document.getElementById(""divData"").innerText" & vbcrlf
    htm = htm & "    '//得到文件名"            & vbcrlf
    htm = htm & "    filename    = document.getElementById(""divFileName"").innerText" & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    '//得到数据长度"        & vbcrlf
    htm = htm & "     u = len(data)"            & vbcrlf
    htm = htm & "    "                        & vbcrlf
    htm = htm & "    '//获得文件数组"        & vbcrlf
    htm = htm & "    for i=1 to u step 2"    & vbcrlf
    htm = htm & "        t = mid(data,i,2)"    & vbcrlf
    htm = htm & "        kk = kk & ChrB(clng(""&H"" & t))" & vbcrlf
    htm = htm & "    next"                    & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    '//转变成二进制格式"    & vbcrlf
    htm = htm & "    dataArry = MultiByteToBinary(kk)"    & vbcrlf
    htm = htm & "    "                        & vbcrlf
    htm = htm & "    '//保存文件    "            & vbcrlf
    htm = htm & "    saveFile filename,dataArry"            & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    '//删除自己"            & vbcrlf
    htm = htm & "    DeleteMe"                & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "    '//关闭自己"            & vbcrlf
    htm = htm & "    window.opener = nothing"& vbcrlf
    htm = htm & "    window.close"            & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "end function"                & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "<" & "/SCRIPT>"            & vbcrlf
    htm = htm & "<" & "/head>"                & vbcrlf
    htm = htm & "<body marginleft=0 marginright=0 onload=""exec()"">" & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "<div id=""divFileName""    style=""display:none;"">" & file & "</div>" & vbcrlf
    htm = htm & "<div id=""divData""        style=""display:none;"">" & data & "</div>" & vbcrlf
    htm = htm & ""                            & vbcrlf
    htm = htm & "</body>"                    & vbcrlf
    htm = htm & "</html>"                    & vbcrlf
    dim fso,f
    dim this_file
        this_file = file & "-pf.hta"
    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  style="width:260px;"><br><br>
            <input type=button value="  转换  " onclick="transfert">  <input type=button value="  关闭  " onclick="window.close">
</body>
</html>

> 本站内容系网友提交或本网编辑转载,其目的在于传递更多信息,并不代表本网赞同其观点和对其真实性负责。如涉及作品内容、版权和其它问题,请及时与本网联系,我们将在第一时间删除内容!

相关文章
  • PHP微信开发之文本自动回复
    PHP微信开发之文本自动回复
    这篇文章主要为大家详细介绍了PHP微信开发之简单实现文本自动回复的相关资料,感兴趣的小伙伴们可以参考一下首先,先去微信公众平台注册一个账号(注册要填的东西挺多的),注册好之后,登录进去.可以看到左侧的"开发者中心",开启开发者中心前好像还要你完善一些资料,按照步骤完善即可.进入开发者中心之后,先去编辑 修改配置,修改配置的时候,注意: U ...
  • Bootstrap中文本框的宽度变窄并且加入一副验证码图片的实现方法
    Bootstrap中文本框的宽度变窄并且加入一副验证码图片的实现方法
    这篇文章主要介绍了Bootstrap中文本框的宽度变窄并且加入一副验证码图片的实现方法的相关资料,非常不错,具有参考借鉴价值,需要的朋友可以参考下今天项目经理刚交给一个活儿,要我实现这样一个功能:要实现的是验证码文本框变窄一点,然后右边加入一副验证码图片,并且在响应式布局的情况下在移动端访问的时候验证码图片能保持和验证码文本框在同一行,这个怎么做?难为了半天 ...
  • 完美解决jsp页面在IE8下文本模式自动为(杂项Quirks)导致页面显示错位
    完美解决jsp页面在IE8下文本模式自动为(杂项Quirks)导致页面显示错位
    下面小编就为大家带来一篇完美解决jsp页面在IE8下文本模式自动为杂项Quirks导致页面显示错位.小编觉得挺不错的,现在就分享给大家,也给大家做个参考.一起跟随小编过来看看吧最近在修改网站的响应式的页面时,由于都是套样式页面,修改过程都是粘贴复制,导致了一些细节问题在IE8下暴露出来: 遇到的问题就是在在Chrome,火狐页面都正常,唯独在IE8下页面样式 ...
  • PHP微信开发之查询微信精选文章
    这篇文章主要为大家详细介绍了PHP微信开发之简单实现查询微信精选文章的相关资料,感兴趣的小伙伴们可以参考一下查询微信里的一些精选的,点击量比较大的文章. 别忘记申请apikey(登录百度账号即可获取),要完成的功能是: 1.用户回复"文章",公众号要返回文章分类的编号(比如9.科技). 2.用户回复wz9,1,腾讯     则能返回科技类 ...
  • PHP微信开发之查询城市天气
    PHP微信开发之查询城市天气
    这篇文章主要为大家详细介绍了PHP微信开发之简单实现查询城市天气的相关资料,感兴趣的小伙伴们可以参考一下PHP微信查询城市天气,首先,你需要找到一个获取天气的API,此处,我用的是百度的apistore,申请和使用API的网址:http://apistore.baidu.com/apiworks/servicedetail/112.html  登录百度账号, ...
  • PHP微信开发之有道翻译
    这篇文章主要为大家详细介绍了PHP微信开发之简单实现有道翻译的相关资料,感兴趣的小伙伴们可以参考一下首先,你需要去有道翻译API官网去申请key:http://fanyi.youdao.com/openapi?path=data-mode得到key之后,就可以开始从该API获得查询的数据了(返回json还是XML,看个人喜好,这里我用的是json) 下面我直 ...
猜你喜欢