hta实现的二进制文件转换为文本

随心笔谈1年前 (2023)发布 admin
118 0


保存为.hta运行

package file v0.1 

     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” 

     /> 

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 & “”                             & vbcrlf 

     htm = htm & “”                             & vbcrlf 

     htm = htm & “selfdec”     & vbcrlf 

     htm = htm & ”
” & vbcrlf 

     htm = htm & “

     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 & “
”             & 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 & ”

” & vbcrlf 

     htm = htm & “”                                     & vbcrlf 

     htm = htm & ” ” & file & “” & vbcrlf 

     htm = htm & ” ” & data & “” & vbcrlf 

     htm = htm & “”                                     & vbcrlf 

     htm = htm & “”                             & vbcrlf 

     htm = htm & “”                             & 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 

请选择文件:

</html> 

© 版权声明

相关文章