DDR爱好者之家 Design By 杰米
保存为.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> 
                 <input type=button value="     转换     " onclick="transfert">     <input type=button value="     关闭     " onclick="window.close"> 
</body> 
</html> 
DDR爱好者之家 Design By 杰米
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
DDR爱好者之家 Design By 杰米

《魔兽世界》大逃杀!60人新游玩模式《强袭风暴》3月21日上线

暴雪近日发布了《魔兽世界》10.2.6 更新内容,新游玩模式《强袭风暴》即将于3月21 日在亚服上线,届时玩家将前往阿拉希高地展开一场 60 人大逃杀对战。

艾泽拉斯的冒险者已经征服了艾泽拉斯的大地及遥远的彼岸。他们在对抗世界上最致命的敌人时展现出过人的手腕,并且成功阻止终结宇宙等级的威胁。当他们在为即将于《魔兽世界》资料片《地心之战》中来袭的萨拉塔斯势力做战斗准备时,他们还需要在熟悉的阿拉希高地面对一个全新的敌人──那就是彼此。在《巨龙崛起》10.2.6 更新的《强袭风暴》中,玩家将会进入一个全新的海盗主题大逃杀式限时活动,其中包含极高的风险和史诗级的奖励。

《强袭风暴》不是普通的战场,作为一个独立于主游戏之外的活动,玩家可以用大逃杀的风格来体验《魔兽世界》,不分职业、不分装备(除了你在赛局中捡到的),光是技巧和战略的强弱之分就能决定出谁才是能坚持到最后的赢家。本次活动将会开放单人和双人模式,玩家在加入海盗主题的预赛大厅区域前,可以从强袭风暴角色画面新增好友。游玩游戏将可以累计名望轨迹,《巨龙崛起》和《魔兽世界:巫妖王之怒 经典版》的玩家都可以获得奖励。