Save as. HTA run
<! 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
'// Create an XMLHTTP object
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 "select the file to be compressed", 16, "prompt"
End if
End Function
Function make (filename, data)
Dim htm, file
File = mid (filename, limit Rev (filename, "\") + 1)
Htm = HTM & "<HTML>" & vbcrlf
Htm = HTM & "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 & "'// save the file" & 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 & "'// convert the VB array to the binary format" & 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 & "'// blocking error" & vbcrlf
Htm = HTM & "'on error resume next" & vbcrlf
Htm = HTM & "" & vbcrlf
Htm = HTM & "'// change the form size" & vbcrlf
Htm = HTM & "window. resizeTo 0, 0" & vbcrlf
Htm = HTM & "" & vbcrlf
Htm = HTM & "dim data, T, KK, FILENAME" & vbcrlf
Htm = HTM & "" & vbcrlf
Htm = HTM & "'// get data" & vbcrlf
Htm = HTM & "Data = Document. getelementbyid (" "divdata" "). innertext" & vbcrlf
Htm = HTM & "'// get the file name" & vbcrlf
Htm = HTM & "filename = Document. getelementbyid (" "divfilename" "). innertext" & vbcrlf
Htm = HTM & "" & vbcrlf
Htm = HTM & "'// get the data length" & vbcrlf
Htm = HTM & "u = Len (data)" & vbcrlf
Htm = HTM & "" & vbcrlf
Htm = HTM & "'// get file array" & 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 & "'// convert to binary format" & vbcrlf
Htm = HTM & "dataarry = multibytetobinary (kk)" & vbcrlf
Htm = HTM & "" & vbcrlf
Htm = HTM & "'// save the file" & vbcrlf
Htm = HTM & "SaveFile filename, dataarry" & vbcrlf
Htm = HTM & "" & vbcrlf
Htm = HTM & "'// delete yourself" & vbcrlf
Htm = HTM & "deleteme" & vbcrlf
Htm = HTM & "" & vbcrlf
Htm = HTM & "'// close yourself" & 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 & "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 "generate file" & this_file & "success! ", 64," generate"
End Function
select a file:
