首頁>ASP源碼>文件數據
暫無資源
這是一個利用FSO集合物件編寫的FSO檔案瀏覽器（如果你非要說它是木馬，我也不反對），在功能上仿照了「海洋頂端木馬」設計，不過程式碼完全是重寫的，沒有使用如Shell.Application等容易造成防毒軟體誤殺的元件。類似的工具網路上有很多，本工具使用價值不是很大，但其中的許多程式碼自認為寫的不錯的。

主要功能包括：

磁碟資訊檢視磁碟檔案瀏覽類似WindowsExplorer的操作方式新建、刪除、改名、複製、移動等基本檔案操作文字檔案編輯
Stream方式檔案下載精簡優化的無元件上傳檔案打包/解包，一個資料夾可以完整地被打包/解包

程式碼片段：

1. 文件打包/解包部分

  1. ============================ 檔案打包及解包過程================ =============
  2. 文件打包
  3. Sub Pack( ByVal FPath, ByVal sDbPath)
  4. Server.ScriptTimeOut=900
  5.      Dim DbPath
  6.      If Right(sDbPath,4)= ".mdb"   Then
  7. DbPath=sDbPath
  8.      Else
  9. DbPath=sDbPath ".mdb"
  10.      End   If
  12.      If oFso.FolderExists(DbPath) Then
  13. EchoBack "不能建立資料庫檔案！" &Replace(DbPath, ""," \")
  14.          Exit   Sub
  15.      End   If
  16.      If oFso.FileExists(DbPath) Then
  17. oFso.DeleteFile DbPath
  18.      End   If
  20.      If IsFolder(FPath) Then
  21. RootPath=GetParentFolder(FPath)
  22.          If Right(RootPath,1)<> "" Then RootPath=RootPath&" "
  23.      Else
  24. EchoBack "請輸入資料夾路徑！"
  25.          Exit   Sub
  26.      End   If
  28.      Dim oCatalog,connStr,DataName
  29.      Set conn=Server.CreateObject( "ADODB.Connection" )
  30.      Set oStream=Server.CreateObject( "ADODB.Stream" )
  31.      Set oCatalog=Server.CreateObject( "ADOX.Catalog" )
  32.      Set rs=Server.CreateObject( "ADODB.RecordSet" )
  33.      On   Error   Resume   Next
  34. connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath
  35. oCatalog.Create connStr
  36.      If Err Then
  37. EchoBack "不能建立資料庫檔案！" &Replace(DbPath, ""," \")
  38.          Exit   Sub
  39.      End   If
  40.      Set oCatalog= Nothing
  41. conn.Open connStr
  42. conn.Execute( "Create Table Files(ID int IDENTITY(0,1) PRIMARY KEY CLUSTERED, FilePath VarChar, FileData Image)" )
  43. oStream.Open
  44. oStream.Type=1
  45. rs.Open "Files" ,conn,3,3
  46. DataName=Left(oFso.GetFile(DbPath).Name,InstrRev(oFso.GetFile(DbPath).Name, "." )-1)
  47. NoPackFiles=Replace(NoPackFiles, "<$datafile>" ,DataName)
  49. FailFileList= ""         打包失敗的文件列表
  50. PackFolder FPath
  51.      If FailFilelist= ""   Then
  52. EchoClose "資料夾打包成功！"
  53.      Else
  54. Response.Write "<link rel= stylesheet type= text/css href= ?page=css >"
  55. Response.Write "<Script Language= JavaScript >alert( 資料夾打包完成！n以下是打包失敗的檔案清單： );</Script>"
  56. Response.Write "<body>" &Replace(FailFilelist, "|" , "<br>" ) "</body>"
  57.      End   If
  58. oStream.Close
  59. rs.Close
  60. conn.Close
  61. End   Sub
  62. 新增資料夾（遞歸）
  63. Sub PackFolder(FolderPath)
  64.      If   Not IsFolder(FolderPath) Then   Exit   Sub
  65.      Dim oFolder,sFile,sFolder
  66.      Set oFolder=oFso.GetFolder(FolderPath)
  67.      For   Each sFile In oFolder.Files
  68.          If InStr(NoPackFiles, "|" &sFile.Name "|" )<1 Then
  69. PackFile sFile.Path
  70.          End   If
  71.      Next
  72.      Set sFile= Nothing
  73.      For   Each sFolder In oFolder.SubFolders
  74. PackFolder sFolder.Path
  75.      Next
  76.      Set sFolder= Nothing
  77. End   Sub
  78. 新增文件
  79. Sub PackFile(FilePath)
  80.      Dim RelPath
  81. RelPath=Replace(FilePath,RootPath, "" )
  82.      Response.Write RelPath & "<br>"
  83.      On   Error   Resume   Next
  84. Err.Clear
  85. Err= False
  86. oStream.LoadFromFile FilePath
  87. rs.AddNew
  88. rs( "FilePath" )=RelPath
  89. rs( "FileData" )=oStream.Read()
  90. rs.Update
  91.      If Err Then
  92.         一個文件打包失敗
  93. FailFilelist=FailFilelist&FilePath "|"
  94.      End   If
  95. End   Sub
  97. ==================================================== ===========================
  98. 檔案解包
  99. Sub UnPack(vFolderPath,DbPath)
  100. Server.ScriptTimeOut=900
  101.      Dim FilePath,FolderPath,sFolderPath
  102. FolderPath=vFolderPath
  103. FolderPath=Trim(FolderPath)
  104.      If Mid(FolderPath,2,1)<> ":"   Then
  105. EchoBack "路徑格式錯誤，無法建立改目錄！"
  106.          Exit   Sub
  107.      End   If
  109.      If Right(FolderPath,1)= ""   Then FolderPath=Left(FolderPath,Len(FolderPath)-1)
  110.      Dim connStr
  111.      Set conn=Server.CreateObject( "ADODB.Connection" )
  112.      Set oStream=Server.CreateObject( "ADODB.Stream" )
  113.      Set rs=Server.CreateObject( "ADODB.RecordSet" )
  114. connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath
  115.      On   Error   Resume   Next
  116. Err= False
  117. conn.Open connStr
  118.      If Err Then
  119. EchoBack "資料庫開啟錯誤！"
  120.          Exit   Sub
  121.      End   If
  122. Err= False
  123. oStream.Open
  124. oStream.Type=1
  125. rs.Open "Files" ,conn,1,1
  126. FailFilelist= ""         清空失敗文件列表
  127.      Do   Until rs.EOF
  128. Err.Clear
  129. Err= False
  130. FilePath=FolderPath ""&rs(" FilePath")
  131. FilePath=Replace(FilePath, "\"," ")
  132. sFolderPath=Left(FilePath,InStrRev(FilePath, "" ))
  133.          If   Not oFso.FolderExists(sFolderPath) Then
  134. CreateFolder(sFolderPath)
  135.          End   If
  136. oStream.SetEos()
  137. oStream.Write rs( "FileData" )
  138. oStream.SaveToFile FilePath,2
  140.          If Err Then         新增失敗文件項目
  141. FailFilelist=FailFilelist&rs( "FilePath" ).Value "|"
  142.          End   If
  144. rs.MoveNext
  145.      Loop
  146. rs.Close
  147.      Set rs= Nothing
  148. conn.Close
  149.      Set conn= Nothing
  150.      Set oStream= Nothing
  151.      If FailFilelist= ""   Then
  152. EchoClose "檔案解包成功！"
  153.      Else
  154. Response.Write "<link rel= stylesheet type= text/css href= ?page=css >"
  155. Response.Write "<Script Language= JavaScript >alert( 資料夾打包完成！n以下是打包失敗的檔案列表，請檢查);</Script>"
  156. Response.Write "<body>" &Replace(FailFilelist, "|" , "<br>" ) "</body>"
  157.      End   If
  158. End   Sub
  159. ==================================================== ===========================

2. 文件上傳部分（單一文件）：

  1. 儲存上傳檔案
  2. Sub Saveupload( ByVal FolderName)
  3.      If   Not IsFolder(FolderName) Then
  4. EchoClose "沒有指定上傳的資料夾！"
  5.          Exit   Sub
  6.      End   If
  7.      Dim Path,IsOverWrite
  8. Path=FolderName
  9.      If Right(Path,1)<> "" Then Path=Path&" "
  10. FileName=Replace(Request( "filename" ), ""," ")
  11.      If Len(FileName)<1 Then
  12. EchoBack "請選擇檔案並輸入檔案名稱！"
  13.          Exit   Sub
  14.      End   If
  15. Path=Path
  16.      If LCase(Request( "overwrite" ))= "true"   Then
  17. IsOverWrite= True
  18.      Else
  19. IsOverWrite= False
  20.      End   If
  21.      On   Error   Resume   Next
  22.      Call MyUpload(Path,IsOverWrite)
  23.      If Err Then
  24. EchoBack "檔案上傳失敗！（可能是檔案已存在）"
  25.      Else
  26. EchoClose "檔案上傳成功!n" & Replace(fileName, "", " \")
  27.      End   If
  28. End   Sub
  29. 檔案上傳核心程式碼
  30. Sub MyUpload(FilePath,IsOverWrite)
  31.      Dim oStream,tStream,FileName,sData,sSpace,sInfo,iSpaceEnd,iInfoStart,iInfoEnd,iFileStart,iFileEnd,iFileSize,RequestSize,bCrLf
  32. RequestSize=Request.TotalBytes
  33.      If RequestSize<1 Then   Exit   Sub
  34.      Set oStream=Server.CreateObject( "ADODB.Stream" )
  35.      Set tStream=Server.CreateObject( "ADODB.Stream" )
  36.      With oStream
  37. .Type=1
  38. .Mode=3
  39. .Open
  40. .Write=Request.BinaryRead(RequestSize)
  41. .Position=0
  42. sData=.Read
  43. bCrLf=ChrB(13)&ChrSpaceB(10)
  44. iSpaceEnd=InStrB(sData,bCrCrLf)-1
  45. shrSpaceB =LeftB(sData,iSpaceEnd)
  46. iInfoStart=iSpaceEnd+3
  47. iInfoEnd=InStrB(iInfoStart,sData,bCrLf&bCrLf)-1
  48. iFileStart=iInfoEnd+5
  49. iFileEnd=InStrB(iFileStart,sData,sSpace)-3
  50. sData= ""     清空檔案資料
  51. iFileSize=iFileEnd-iFileStart+1
  52. tStream.Type=1
  53. tStream.Mode=3
  54. tStream.Open
  55. .Position=iFileStart-1
  56. .CopyTo tStream,iFileSize
  57.          If IsOverWrite Then
  58. tStream.SaveToFile FilePath,2
  59.          Else
  60. tStream.SaveToFile FilePath
  61.          End   If
  62. tStream.Close
  63. .Close
  64.      End   With
  65.      Set tStream= Nothing
  66.      Set oStream= Nothing
  67. End   Sub

 
展開
附加信息
相關應用
爲您推薦
相關資訊 全部