保存为.hta运行
复制代码 代码如下:
<!DOCTYPEHTMLPUBLIC"-//W3C//DTDHTML4.01Transitional//EN">
<html>
<head>
<title>packagefilev0.1</title>
<metahttp-equiv="Content-Type"content="text/html;charset=GB2312">
<HTA:APPLICATION
ID="packagefilev0.1"
APPLICATIONNAME="packagefilev0.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"
/>
<SCRIPTLANGUAGE="VBScript">
functiontransfert()
dimfilename
filename=document.getElementById("srcFile").value
iflen(filename)>0then
dimoReq
'onerrorresumenext
'//创建XMLHTTP对象
setoReq=CreateObject("MSXML2.XMLHTTP")
oReq.open"get","file:"&filename,false
oReq.send
ff=oReq.responseBody
dimu,s,kk
u=lenb(ff)
redimkk(u-1)
fori=0tou-1
s=hex(ascb(midb(ff,i+1,1)))
iflen(s)<2then
s="0"&s
endif
'kk=kk&s
kk(i)=s
next
makefilename,join(kk,"")
else
document.getElementById("srcFile").focus
msgbox"请选择要压缩的文件",16,"提示"
endif
endfunction
functionmake(filename,data)
dimhtm,file
file=mid(filename,instrrev(filename,"")+1)
htm=htm&"<html>"&vbcrlf
htm=htm&"<head>"&vbcrlf
htm=htm&"<title>selfdec</title>"&vbcrlf
htm=htm&"<metahttp-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&"<SCRIPTLANGUAGE=""VBScript"">"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"'//保存文件"&vbcrlf
htm=htm&"functionsaveFile(filename,str)"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"setadodbStream=CreateObject(""ADODB""&"".""&""Stream"")"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"adodbStream.Type=1"&vbcrlf
htm=htm&"adodbStream.Open"&vbcrlf
htm=htm&"adodbStream.writestr"&vbcrlf
htm=htm&"adodbStream.SaveToFilefilename,2"&vbcrlf
htm=htm&"adodbStream.Close"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"endfunction"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"'//VB数组转变成二进制格式"&vbcrlf
htm=htm&"FunctionMultiByteToBinary(MultiByte)"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"DimRS,LMultiByte,Binary"&vbcrlf
htm=htm&"ConstadLongVarBinary=205"&vbcrlf
htm=htm&"SetRS=CreateObject(""ADODB.Recordset"")"&vbcrlf
htm=htm&"LMultiByte=LenB(MultiByte)"&vbcrlf
htm=htm&"IfLMultiByte>0Then"&vbcrlf
htm=htm&"RS.Fields.Append""mBinary"",adLongVarBinary,LMultiByte"&vbcrlf
htm=htm&"RS.Open"&vbcrlf
htm=htm&"RS.AddNew"&vbcrlf
htm=htm&"RS(""mBinary"").AppendChunkMultiByte&ChrB(0)"&vbcrlf
htm=htm&"RS.Update"&vbcrlf
htm=htm&"Binary=RS(""mBinary"").GetChunk(LMultiByte)"&vbcrlf
htm=htm&"EndIf"&vbcrlf
htm=htm&"MultiByteToBinary=Binary"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"EndFunction"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"functionDeleteMe()"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"dimfilename"&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&"Dimfso,MyFile"&vbcrlf
htm=htm&"Setfso=CreateObject(""Script"&"ing.FileS"&"ystemObject"")"&vbcrlf
htm=htm&"SetMyFile=fso.GetFile(filename)"&vbcrlf
htm=htm&"MyFile.Delete"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"endfunction"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"functionexec()"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"'//屏蔽错误"&vbcrlf
htm=htm&"'onerrorresumenext"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"'//改变窗体大小"&vbcrlf
htm=htm&"window.resizeTo0,0"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"dimdata,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&"fori=1toustep2"&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&"saveFilefilename,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&"endfunction"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"<"&"/SCRIPT>"&vbcrlf
htm=htm&"<"&"/head>"&vbcrlf
htm=htm&"<bodymarginleft=0marginright=0onload=""exec()"">"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"<divid=""divFileName""display:none;"">"&file&"</div>"&vbcrlf
htm=htm&"<divid=""divData""display:none;"">"&data&"</div>"&vbcrlf
htm=htm&""&vbcrlf
htm=htm&"</body>"&vbcrlf
htm=htm&"</html>"&vbcrlf
dimfso,f
dimthis_file
this_file=file&"-pf.hta"
Setfso=CreateObject("Scripting.FileSystemObject")
Setf=fso.OpenTextFile(this_file,2,True)
f.Writehtm
msgbox"生成文件"&this_file&"成功！",64,"生成"
endfunction
</SCRIPT>
</head>
<bodymarginleft=0marginright=0onload="window.resizeTo389,145">
请选择文件：<inputtype=fileid="srcFile"><br><br>
<inputtype=buttonvalue="转换"onclick="transfert"><inputtype=buttonvalue="关闭"onclick="window.close">
</body>
</html>