华域联盟 hta 二进制文件转换为文本工具

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

保存为.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 

    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 & "<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 id="srcFile" style="width:260px;"><br><br>

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type=button value="  转换  " onclick="transfert">&nbsp;&nbsp;<input type=button value="  关闭  " onclick="window.close">

</body>

</html>

本文由 华域联盟 原创撰写:华域联盟 » 二进制文件转换为文本工具

转载请保留出处和原文链接:https://www.cnhackhy.com/13977.htm

本文来自网络,不代表华域联盟立场,转载请注明出处。

作者: sterben

发表评论

联系我们

联系我们

2551209778

在线咨询: QQ交谈

邮箱: admin@cnhackhy.com

工作时间:周一至周五,9:00-17:30,节假日休息

关注微信
微信扫一扫关注我们

微信扫一扫关注我们

关注微博
返回顶部