复制代码 代码如下:
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 & "
htm = htm & "
htm = htm & "
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 & "
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 & "
htm = htm & "" & vbcrlf
htm = htm & "
htm = htm & "