因工作需要,最近与同事合作使用Dokan开发了一个虚拟磁盘的简单程序,初步实现了远程目录映射到本地虚拟磁盘的功能。
远程服务端是用Python写的,主要是将远程主机上的目录文件传给客戶端,在这里就不细说了。
Dokan客户端则由Delphi开发,其参考代码来自网络上的Delphi例子,比如Mirror Driver。
本篇文章主要是Dokan开发过程的一些总结,所以不会对Dokan本身做介绍,与Dokan有关的资料及代码,请到google里搜索,或到Dokan的官方网站去下载(Dokan官网),源码是C语言的,应用例子有Ruby、.Net及C的。如果想要Delphi的例子代码,只能自己去找了。
刚开始时由于不清楚如何用Dokan来实现一个文件系统,所以需要做一些试验,结果一不小心就蓝屏了!悲剧啊,用XP系统已经好多年没遇到蓝屏了。几次蓝屏之后,终于受不了了,于是在VMWare里装了个虚拟机的XP,这下不怕蓝屏了,哈哈。强烈建议装个虚拟机来玩Dokan,否则刚开始的时候你会蓝屏N次!
为简单起见,我做的Dokan虚拟磁盘采用将远程目录缓存到本地目录的方法来实现,这样就不用自己维护一堆目录、文件的信息,只需要关注如何更新同步目录与文件就可以了。由于Dokan是多线程的,因此实现时需要做到线程安全;查看Dokan使用的结构类型,发现只有两个成员可以使用,即DOKAN_OPTIONS里的GlobalContext和DOKAN_FILE_INFO里的Context,其中GlobalContext只能用来存储全局的信息,比如存放线程实例的指针,这样一来,实际上就剩下 DOKAN_FILE_INFO里的Context 一个成员可以用来存储与文件有关的信息了,一般用它来存储文件指针。我这次实现没有自己定义类来管理目录与文件,而是直接利用缓存目录,因此只需要处理文件指针和是否需要更新文件两个信息就可以了,而 DOKAN_FILE_INFO里的Context是Int64的,在Win32里可以用32位存文件指针,另32位用来存储文件更新信息。
//以下来自于Dokan.pas里的定义
_DOKAN_OPTIONS = packed record DriveLetter: WCHAR; // Drive letter to be mounted ThreadCount: Word; // Number of threads to be used DebugMode: Boolean; UseStdErr: Boolean; UseAltStream: Boolean; UseKeepAlive: Boolean; GlobalContext: Int64; // User-mode filesystem can use this variable end; PDOKAN_OPTIONS = ^_DOKAN_OPTIONS; DOKAN_OPTIONS = _DOKAN_OPTIONS;
TDokanOptions = _DOKAN_OPTIONS; PDokanOptions = PDOKAN_OPTIONS;
_DOKAN_FILE_INFO = packed record Context: Int64; // User-mode filesystem can use this variable DokanContext: Int64; // Reserved. Don't touch this! DokanOptions: PDOKAN_OPTIONS; ProcessId: ULONG; // Process id for the thread that originally requested the I/O operation IsDirectory: Boolean; // Indicates a directory file DeleteOnClose: Boolean; // Delete when Cleanup is called PagingIo: Boolean; // Read or write is paging IO SynchronousIo: Boolean; // Read or write is synchronous IO Nocache: Boolean; // No caching WriteToEndOfFile: Boolean; // If true, write to the current end of file instead of Offset parameter end; PDOKAN_FILE_INFO = ^_DOKAN_FILE_INFO; DOKAN_FILE_INFO = _DOKAN_FILE_INFO;
TDokanFileInfo = _DOKAN_FILE_INFO; PDokanFileInfo = PDOKAN_FILE_INFO;
研究了几天,发现只需要实现少数几个回调函数就可以了:
1.FindFiles: 在这个回调函数里可以实现从远程目录同步其下的所有目录及文件。当然也可以在OpenDirectory回调函数里做,但实际使用时我发现OpenDirectory调用太频繁,而FindFiles调用次数要少一些。
2.CreateDirectory: 在这个回调函数里可以实现同步创建远程目录。
3.DeleteDirectory: 实现同步删除远程目录。
4.CreateFile: 这个回调函数调用极其频繁,每次操作目录文件(包括打开文件)时首先都会调到它,我在这里实现了从远程目录同步更新本地文件的内容。需要注意的是,在虚拟磁盘里新建文件时,为了能在Cleanup里正确同步到远程目录,必须记下来。我使用了以下代码来实现:
if not DokanFileInfo.IsDirectory and (CreationDisposition in [CREATE_NEW, OPEN_ALWAYS, CREATE_ALWAYS]) then begin MySetFileDate(DokanFileInfo, DateTimeToFileDate(Now)); //Cleanup里会判断FileDate来决定是否保存到远程目录 end;
5.WriteFile: 可用于指示文件是否已修改,和Cleanup配合,以便保存文件时能正确提交到远程服务器。需要注意的WriteFile可能会被调用多次,所以它并不适合提交修改,只能记录修改标志。
6.Cleanup: 同步删除远程目录中的文件及保存本地修改的文件到远程目录。实现时我发现,在Cleanup中判断DokanFileInfo.DeleteOnClose及DokanFileInfo.IsDirectory来删除目录的代码根本就不会走到(所以我在DeleteDirectory里实现删除目录的同步),而删除文件则没问题。
这里有一点需要注意:因为执行Cleanup之前,可能会多次调用CreateFile,比如记事本保存文档时就会执行两次CreateFile之后再调用Cleanup,所以我在Cleanup的最后执行MySetFileDate(DokanFileInfo, 0)来清空标志,而没有在CreateFile里清空标志。
7.MoveFile: 这个回调函数仅在移动虚拟磁盘里的文件到另一个虚拟磁盘目录中去时才触发,故实现在远程目录中同步移动文件后,就可以正常实现目录文件的移动了。由于操作多个目录文件时,Windows会每个目录文件分别调用相关操作,因此实现这个回调函数后,自然就实现了多个目录文件的移动。如果是从其他盘移动目录文件到虚拟磁盘或从虚拟磁盘移动目录文件到其他盘,都不会触发MoveFile这个回调函数;而目录文件改名,则会触发MoveFile这个回调函数。
实现时还有一个调试信息如何显示的问题,对控制台程序,可以直接写到控制台;而对带窗口的程序,可以写日志文件,也可以发Windows消息。我采用了SendMessage来处理调试信息,具体实现请参看下面的代码。
最终的实现是由一个线程来实现Dokan虚拟磁盘的,目录与文件的同步函数则放到一个单独的单元文件里,连接远程服务端则采用IndyTCPClient实现,传输采用了JSON,以便于和服务端的Python脚本通讯。
附录部分是实现的代码,Dokan.pas及superobject.pas等代码请自己搜索下载。
附录(代码部分):
//Mirror Drive (从 Mirror Driver修改而来)
unit cfMirrorDrive;
(******************************************************************************* * * Copyright (c) 2007, 2008 Hiroki Asakawa info@ * * Delphi translation by Vincent Forman (vincent.forman@gmail.com) * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN * THE SOFTWARE. * *******************************************************************************)
interface
uses Windows, SysUtils, Classes, {$IFNDEF CONSOLE} Messages, Forms, {$ENDIF} FileCtrl, Dokan, cfFileMapping;
{$IFNDEF CONSOLE} const WM_IW_LOGMSG = WM_USER + 1001; {$ENDIF}
type TMirrorDrive = class(TThread) protected FRootDirectory: string; FDokanOperations: TDokanOperations; FDokanOptions: TDokanOptions; {$IFNDEF CONSOLE} FHandle: THandle; {$ENDIF} procedure Execute; override; public constructor Create(const ADirectory: string; ADrive: WideChar; {$IFNDEF CONSOLE}AHandle: THandle;{$ENDIF} ADebugMode: Boolean = False); end;
implementation
type TMyInt64 = record case Integer of 0: (MyInt64: Int64); 1: (LowInt32: Integer; HighInt32: Integer) end; PMyInt64 = ^TMyInt64;
function GetMirrorDrive(const DokanFileInfo: TDokanFileInfo): TMirrorDrive; begin Result := TMirrorDrive(Integer(DokanFileInfo.DokanOptions.GlobalContext)); end;
function MyGetFileDate(const DokanFileInfo: TDokanFileInfo): Integer; begin Result := PMyInt64(@DokanFileInfo.Context).HighInt32; end;
procedure MySetFileDate(const DokanFileInfo: TDokanFileInfo; ADate: Integer); begin PMyInt64(@DokanFileInfo.Context).HighInt32 := ADate; end;
function MyGetFileHandle(const DokanFileInfo: TDokanFileInfo): THandle; begin Result := PMyInt64(@DokanFileInfo.Context).LowInt32; end;
procedure MySetFileHandle(const DokanFileInfo: TDokanFileInfo; AHandle: THandle); begin PMyInt64(@DokanFileInfo.Context).LowInt32 := AHandle; end;
// Not available in Windows.pas function SetFilePointerEx(hFile: THandle; lDistanceToMove: LARGE_INTEGER; lpNewFilePointer: Pointer; dwMoveMethod: DWORD): BOOL; stdcall; external kernel32;
// Some additional Win32 flags const FILE_READ_DATA = $00000001; FILE_WRITE_DATA = $00000002; FILE_APPEND_DATA = $00000004; FILE_READ_EA = $00000008; FILE_WRITE_EA = $00000010; FILE_EXECUTE = $00000020; FILE_READ_ATTRIBUTES = $00000080; FILE_WRITE_ATTRIBUTES = $00000100;
FILE_ATTRIBUTE_ENCRYPTED = $00000040; FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $00002000; FILE_FLAG_OPEN_NO_RECALL = $00100000; FILE_FLAG_OPEN_REPARSE_POINT = $00200000;
STATUS_DIRECTORY_NOT_EMPTY = $C0000101;
INVALID_SET_FILE_POINTER = $FFFFFFFF;
// Utilities routines, to be defined later procedure DbgPrint(const DokanFileInfo: TDokanFileInfo; const Message: string); overload; forward; procedure DbgPrint(const DokanFileInfo: TDokanFileInfo; const Format: string; const Args: array of const); overload; forward; function MirrorConvertPath(const DokanFileInfo: TDokanFileInfo; FileName: PWideChar): string; forward;
// Output the value of a flag by searching amongst an array of value/name pairs procedure CheckFlag(const DokanFileInfo: TDokanFileInfo; const Flag: Cardinal; Values: array of Cardinal; Names: array of string); var i:Integer; begin for i:=Low(Values) to High(Values) do if Values[i]=Flag then DbgPrint(DokanFileInfo, ' %s',[Names[i]]); end;
type EDokanMainError = class(Exception) public constructor Create(DokanErrorCode: Integer); end;
constructor EDokanMainError.Create(DokanErrorCode: Integer); var s:string; begin case DokanErrorCode of DOKAN_SUCCESS: s := 'Success'; DOKAN_ERROR: s := 'Generic error'; DOKAN_DRIVE_LETTER_ERROR: s := 'Bad drive letter'; DOKAN_DRIVER_INSTALL_ERROR: s := 'Cannot install driver'; DOKAN_START_ERROR: s := 'Cannot start driver'; DOKAN_MOUNT_ERROR: s := 'Cannot mount on the specified drive letter'; else s := 'Unknown error'; end; inherited CreateFmt('Dokan Error: (%d) %s',[DokanErrorCode,s]); end;
// Dokan callbacks function MirrorCreateFile(FileName: PWideChar; AccessMode, ShareMode, CreationDisposition, FlagsAndAttributes: Cardinal; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; const AccessModeValues: array[1..19] of Cardinal = ( GENERIC_READ, GENERIC_WRITE, GENERIC_EXECUTE, _DELETE, FILE_READ_DATA, FILE_READ_ATTRIBUTES, FILE_READ_EA, READ_CONTROL, FILE_WRITE_DATA, FILE_WRITE_ATTRIBUTES, FILE_WRITE_EA, FILE_APPEND_DATA, WRITE_DAC, WRITE_OWNER, SYNCHRONIZE, FILE_EXECUTE, STANDARD_RIGHTS_READ, STANDARD_RIGHTS_WRITE, STANDARD_RIGHTS_EXECUTE ); AccessModeNames: array[1..19] of string = ( 'GENERIC_READ', 'GENERIC_WRITE', 'GENERIC_EXECUTE', 'DELETE', 'FILE_READ_DATA', 'FILE_READ_ATTRIBUTES', 'FILE_READ_EA', 'READ_CONTROL', 'FILE_WRITE_DATA', 'FILE_WRITE_ATTRIBUTES', 'FILE_WRITE_EA', 'FILE_APPEND_DATA', 'WRITE_DAC', 'WRITE_OWNER', 'SYNCHRONIZE', 'FILE_EXECUTE', 'STANDARD_RIGHTS_READ', 'STANDARD_RIGHTS_WRITE', 'STANDARD_RIGHTS_EXECUTE' ); ShareModeValues: array[1..3] of Cardinal = ( FILE_SHARE_READ, FILE_SHARE_WRITE, FILE_SHARE_DELETE ); ShareModeNames: array[1..3] of string = ( 'FILE_SHARE_READ', 'FILE_SHARE_WRITE', 'FILE_SHARE_DELETE' ); CreationDispositionValues: array[1..5] of Cardinal = ( CREATE_NEW, OPEN_ALWAYS, CREATE_ALWAYS, OPEN_EXISTING, TRUNCATE_EXISTING ); CreationDispositionNames: array[1..5] of string = ( 'CREATE_NEW', 'OPEN_ALWAYS', 'CREATE_ALWAYS', 'OPEN_EXISTING', 'TRUNCATE_EXISTING' ); FlagsAndAttributesValues: array[1..26] of Cardinal = ( FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_ENCRYPTED, FILE_ATTRIBUTE_HIDDEN, FILE_ATTRIBUTE_NORMAL, FILE_ATTRIBUTE_NOT_CONTENT_INDEXED, FILE_ATTRIBUTE_OFFLINE, FILE_ATTRIBUTE_READONLY, FILE_ATTRIBUTE_SYSTEM, FILE_ATTRIBUTE_TEMPORARY, FILE_FLAG_WRITE_THROUGH, FILE_FLAG_OVERLAPPED, FILE_FLAG_NO_BUFFERING, FILE_FLAG_RANDOM_ACCESS, FILE_FLAG_SEQUENTIAL_SCAN, FILE_FLAG_DELETE_ON_CLOSE, FILE_FLAG_BACKUP_SEMANTICS, FILE_FLAG_POSIX_SEMANTICS, FILE_FLAG_OPEN_REPARSE_POINT, FILE_FLAG_OPEN_NO_RECALL, SECURITY_ANONYMOUS, SECURITY_IDENTIFICATION, SECURITY_IMPERSONATION, SECURITY_DELEGATION, SECURITY_CONTEXT_TRACKING, SECURITY_EFFECTIVE_ONLY, SECURITY_SQOS_PRESENT ); FlagsAndAttributesNames: array[1..26] of string = ( 'FILE_ATTRIBUTE_ARCHIVE', 'FILE_ATTRIBUTE_ENCRYPTED', 'FILE_ATTRIBUTE_HIDDEN', 'FILE_ATTRIBUTE_NORMAL', 'FILE_ATTRIBUTE_NOT_CONTENT_INDEXED', 'FILE_ATTRIBUTE_OFFLINE', 'FILE_ATTRIBUTE_READONLY', 'FILE_ATTRIBUTE_SYSTEM', 'FILE_ATTRIBUTE_TEMPORARY', 'FILE_FLAG_WRITE_THROUGH', 'FILE_FLAG_OVERLAPPED', 'FILE_FLAG_NO_BUFFERING', 'FILE_FLAG_RANDOM_ACCESS', 'FILE_FLAG_SEQUENTIAL_SCAN', 'FILE_FLAG_DELETE_ON_CLOSE', 'FILE_FLAG_BACKUP_SEMANTICS', 'FILE_FLAG_POSIX_SEMANTICS', 'FILE_FLAG_OPEN_REPARSE_POINT', 'FILE_FLAG_OPEN_NO_RECALL', 'SECURITY_ANONYMOUS', 'SECURITY_IDENTIFICATION', 'SECURITY_IMPERSONATION', 'SECURITY_DELEGATION', 'SECURITY_CONTEXT_TRACKING', 'SECURITY_EFFECTIVE_ONLY', 'SECURITY_SQOS_PRESENT' ); begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'CreateFile: %s', [filePath]);
(* if (ShareMode = 0) and ((AccessMode and FILE_WRITE_DATA) <> 0) then ShareMode := FILE_SHARE_WRITE else if ShareMode = 0 then ShareMode := FILE_SHARE_READ; *)
DbgPrint(DokanFileInfo, ' AccessMode = 0x%x', [AccessMode]); CheckFlag(DokanFileInfo, AccessMode, AccessModeValues, AccessModeNames);
DbgPrint(DokanFileInfo, ' ShareMode = 0x%x', [ShareMode]); CheckFlag(DokanFileInfo, ShareMode, ShareModeValues, ShareModeNames);
DbgPrint(DokanFileInfo, ' CreationDisposition = 0x%x', [CreationDisposition]); CheckFlag(DokanFileInfo, CreationDisposition, CreationDispositionValues, CreationDispositionNames);
// Check if FilePath is a directory if (GetFileAttributes(PChar(FilePath)) and FILE_ATTRIBUTE_DIRECTORY) <> 0 then FlagsAndAttributes := FlagsAndAttributes or FILE_FLAG_BACKUP_SEMANTICS; if not DokanFileInfo.IsDirectory and (CreationDisposition in [CREATE_NEW, OPEN_ALWAYS, CREATE_ALWAYS]) then begin MySetFileDate(DokanFileInfo, DateTimeToFileDate(Now)); end; DbgPrint(DokanFileInfo, ' FlagsAndAttributes = 0x%x', [FlagsAndAttributes]); CheckFlag(DokanFileInfo, FlagsAndAttributes, FlagsAndAttributesValues, FlagsAndAttributesNames);
FmUpdateFile(FilePath, FileName);
// Save the file handle in Context MySetFileHandle(DokanFileInfo, CreateFile(PChar(FilePath), AccessMode, ShareMode, nil, CreationDisposition, FlagsAndAttributes, 0)); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin // Error codes are negated value of Win32 error codes Result := -GetLastError; DbgPrint(DokanFileInfo, 'CreateFile failed, error code = %d', [-Result]); end else Result := 0; DbgPrint(DokanFileInfo, ''); end;
function MirrorOpenDirectory(FileName: PWideChar; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'OpenDirectory: %s', [FilePath]); MySetFileHandle(DokanFileInfo, CreateFile(PChar(FilePath), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0)); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'CreateFile failed, error code = %d', [-Result]); end else begin Result := 0; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorCreateDirectory(FileName: PWideChar; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'CreateDirectory: %s', [FilePath]); if not CreateDirectory(PChar(FilePath), nil) then begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'CreateDirectory failed, error code = %d', [-Result]); end else begin Result := 0; FmCreateDir(FilePath, FileName); end; DbgPrint(DokanFileInfo, ''); end;
function MirrorCleanup(FileName: PWideChar; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'Cleanup: %s', [FilePath]); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -1; DbgPrint(DokanFileInfo, 'Error: invalid handle', [FilePath]); end else begin Result := 0;
if not DokanFileInfo.DeleteOnClose and not DokanFileInfo.IsDirectory and (MyGetFileDate(DokanFileInfo) > 0) then begin FlushFileBuffers(MyGetFileHandle(DokanFileInfo)); //?! end;
CloseHandle(MyGetFileHandle(DokanFileInfo)); MySetFileHandle(DokanFileInfo, INVALID_HANDLE_VALUE); if DokanFileInfo.DeleteOnClose then begin if DokanFileInfo.IsDirectory then begin DbgPrint(DokanFileInfo, 'DeleteOnClose -> RemoveDirectory'); if not RemoveDirectory(PChar(FilePath)) then DbgPrint(DokanFileInfo, 'RemoveDirectory failed, error code = %d', [GetLastError]); end else begin FmDeleteFile(FilePath, FileName); DbgPrint(DokanFileInfo, 'DeleteOnClose -> DeleteFile'); if not DeleteFile(PChar(FIlePath)) then DbgPrint(DokanFileInfo, 'DeleteFile failed, error code = %d', [GetLastError]); end; end;
if (MyGetFileDate(DokanFileInfo) > 0) and not DokanFileInfo.DeleteOnClose then begin FmSaveFile(FilePath, FileName); DbgPrint(DokanFileInfo, 'Cleanup.File(%s) has modified, save it.', [FileName]); end; end; MySetFileDate(DokanFileInfo, 0); DbgPrint(DokanFileInfo, ''); end;
function MirrorCloseFile(FileName: PWideChar; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin Result := 0; FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'CloseFile: %s', [FilePath]); if MyGetFileHandle(DokanFileInfo) <> INVALID_HANDLE_VALUE then begin DbgPrint(DokanFileInfo, 'Error: file was not closed during cleanup'); CloseHandle(MyGetFileHandle(DokanFileInfo)); MySetFileHandle(DokanFileInfo, INVALID_HANDLE_VALUE); end; DbgPrint(DokanFileInfo, ''); end;
function MirrorReadFile(FileName: PWideChar; var Buffer; NumberOfBytesToRead: Cardinal; var NumberOfBytesRead: Cardinal; Offset: Int64; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; Opened: Boolean; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'ReadFile: %s (Offset: %d, Length: %d)', [FilePath, Offset, NumberOfBytesToRead]); Opened := MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE; if Opened then begin DbgPrint(DokanFileInfo, 'Invalid handle (maybe passed through cleanup?), creating new one'); MySetFileHandle(DokanFileInfo, CreateFile(PChar(FilePath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0)); end; if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'CreateFile failed, error code = %d', [-Result]); end else try if SetFilePointerEx(MyGetFileHandle(DokanFileInfo), LARGE_INTEGER(Offset), nil, FILE_BEGIN) then begin if ReadFile(MyGetFileHandle(DokanFileInfo), Buffer, NumberOfBytesToRead, NumberOfBytesRead, nil) then begin Result := 0; DbgPrint(DokanFileInfo, 'Read: %d', [NumberOfBytesRead]); end else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'ReadFile failed, error code = %d', [-Result]); end; end else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'Seek failed, error code = %d', [-Result]); end; finally if Opened then begin CloseHandle(MyGetFileHandle(DokanFileInfo)); MySetFileHandle(DokanFileInfo, INVALID_HANDLE_VALUE); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorWriteFile(FileName: PWideChar; var Buffer; NumberOfBytesToWrite: Cardinal; var NumberOfBytesWritten: Cardinal; Offset: Int64; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; Opened: Boolean; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'WriteFile: %s (Offset: %d, Length: %d)', [FilePath, Offset, NumberOfBytesToWrite]); Opened := MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE; if Opened then begin DbgPrint(DokanFileInfo, 'Invalid handle (maybe passed through cleanup?), creating new one'); MySetFileHandle(DokanFileInfo, CreateFile(PChar(FilePath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0)); end; if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'CreateFile failed, error code = %d', [-Result]); end else try if not DokanFileInfo.IsDirectory and (MyGetFileDate(DokanFileInfo) = 0) then begin MySetFileDate(DokanFileInfo, FileGetDate(MyGetFileHandle(DokanFileInfo))); DbgPrint(DokanFileInfo, 'GetFileDate = %d', [MyGetFileDate(DokanFileInfo)]); end; if SetFilePointerEx(MyGetFileHandle(DokanFileInfo), LARGE_INTEGER(Offset), nil, FILE_BEGIN) then begin if WriteFile(MyGetFileHandle(DokanFileInfo), Buffer, NumberOfBytesToWrite, NumberOfBytesWritten, nil) then begin Result := 0; DbgPrint(DokanFileInfo, 'Written: %d', [NumberOfBytesWritten]); end else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'WriteFile failed, error code = %d', [-Result]); end; end else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'Seek failed, error code = %d', [-Result]); end; finally if Opened then begin CloseHandle(MyGetFileHandle(DokanFileInfo)); MySetFileHandle(DokanFileInfo, INVALID_HANDLE_VALUE); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorFlushFileBuffers(FileName: PWideChar; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'FlushFileBuffers: %s', [FilePath]); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -1; DbgPrint(DokanFileInfo, 'Error: invalid handle') end else begin if FlushFileBuffers(MyGetFileHandle(DokanFileInfo)) then Result := 0 else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'FlushFileBuffers failed, error code = %d', [-Result]); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorGetFileInformation(FileName: PWideChar; FileInformation: PByHandleFileInformation; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; Opened: Boolean; FindData: WIN32_FIND_DATAA; FindHandle: THandle; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'GetFileInformation: %s', [FilePath]); Opened := MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE; if Opened then begin DbgPrint(DokanFileInfo, 'Invalid handle (maybe passed through cleanup?), creating new one'); MySetFileHandle(DokanFileInfo, CreateFile(PChar(FilePath), GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0)); end; if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -1; DbgPrint(DokanFileInfo, 'CreateFile failed, error code = %d', [GetLastError]); end else try if GetFileInformationByHandle(MyGetFileHandle(DokanFileInfo), FileInformation^) then Result := 0 else begin DbgPrint(DokanFileInfo, 'GetFileInformationByHandle failed, error code = %d', [GetLastError]); if Length(FileName) = 1 then begin Result := 0; FileInformation.dwFileAttributes := GetFileAttributes(PChar(FilePath)); end else begin ZeroMemory(@FindData, SizeOf(FindData)); FindHandle := FindFirstFile(PChar(FilePath), FindData); if FindHandle = INVALID_HANDLE_VALUE then begin Result := -1; DbgPrint(DokanFileInfo, 'FindFirstFile failed, error code = %d', [GetLastError]); end else begin Result := 0; FileInformation.dwFileAttributes := FindData.dwFileAttributes; FileInformation.ftCreationTime := FindData.ftCreationTime; FileInformation.ftLastAccessTime := FindData.ftLastAccessTime; FileInformation.ftLastWriteTime := FindData.ftLastWriteTime; FileInformation.nFileSizeHigh := FindData.nFileSizeHigh; FileInformation.nFileSizeLow := FindData.nFileSizeLow; Windows.FindClose(FindHandle); end; end; end; finally if Opened then begin CloseHandle(MyGetFileHandle(DokanFileInfo)); MySetFileHandle(DokanFileInfo, INVALID_HANDLE_VALUE); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorFindFiles(PathName: PWideChar; FillFindDataCallback: TDokanFillFindData; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: widestring; FindData: WIN32_FIND_DATAW; FindHandle: THandle; begin FilePath := MirrorConvertPath(DokanFileInfo, PathName); FmListDir(FilePath, PathName); FilePath := IncludeTrailingBackslash(FilePath) + '*'; DbgPrint(DokanFileInfo, 'FindFiles: %s', [FilePath]); FindHandle := FindFirstFileW(PWideChar(FilePath), FindData); if FindHandle = INVALID_HANDLE_VALUE then begin Result := -1; DbgPrint(DokanFileInfo, 'FindFirstFile failed, error code = %d', [GetLastError]); end else begin Result := 0; try FillFindDataCallback(FindData, DokanFileInfo); while FindNextFileW(FindHandle, FindData) do FillFindDataCallback(FindData, DokanFileInfo); finally Windows.FindClose(FindHandle); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorSetFileAttributes(FileName: PWideChar; FileAttributes: Cardinal; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'SetFileAttributes: %s', [FilePath]); if SetFileAttributes(PChar(FilePath), FileAttributes) then Result := 0 else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'SetFileAttributes failed, error code = %d', [-Result]); end; DbgPrint(DokanFileInfo, ''); end;
function MirrorSetFileTime(FileName: PWideChar; CreationTime, LastAccessTime, LastWriteTime: PFileTime; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'SetFileTime: %s', [FilePath]); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -1; DbgPrint(DokanFileInfo, 'Error: invalid handle'); end else begin if SetFileTime(MyGetFileHandle(DokanFileInfo), CreationTime, LastAccessTime, LastWriteTime) then Result := 0 else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'SetFileTime failed, error code = %d', [-Result]); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorDeleteFile(FileName: PWideChar; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin Result := 0; FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'DeleteFile: %s', [FilePath]); DbgPrint(DokanFileInfo, ''); end;
function MirrorDeleteDirectory(FileName: PWideChar; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; FindData: WIN32_FIND_DATAA; FindHandle: THandle; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'DeleteDirectory: %s', [FilePath]); FindHandle := FindFirstFile(PChar(FilePath), FindData); if FindHandle = INVALID_HANDLE_VALUE then begin Result := -GetLastError; if Result = -ERROR_NO_MORE_FILES then Result := 0 else DbgPrint(DokanFileInfo, 'FindFirstFile failed, error code = %d', [-Result]); end else begin Cardinal(Result) := STATUS_DIRECTORY_NOT_EMPTY; Result := -Result; Windows.FindClose(FindHandle); end; if (Result = 0) or (FindHandle <> INVALID_HANDLE_VALUE) then begin FmDeleteDir(FilePath, FileName); end; DbgPrint(DokanFileInfo, ''); end;
function MirrorMoveFile(ExistingFileName, NewFileName: PWideChar; ReplaceExisiting: LongBool; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var ExistingFilePath, NewFilePath: string; Status: Boolean; begin ExistingFilePath := MirrorConvertPath(DokanFileInfo, ExistingFileName); NewFilePath := MirrorConvertPath(DokanFileInfo, NewFileName); DbgPrint(DokanFileInfo, 'MoveFile: %s -> %s', [ExistingFilePath, NewFilePath]); if MyGetFileHandle(DokanFileInfo) <> INVALID_HANDLE_VALUE then begin CloseHandle(MyGetFileHandle(DokanFileInfo)); MySetFileHandle(DokanFileInfo, INVALID_HANDLE_VALUE); end; FmMoveFile(ExistingFileName, NewFileName); if ReplaceExisiting then Status := MoveFileEx(PChar(ExistingFilePath), PChar(NewFilePath), MOVEFILE_REPLACE_EXISTING) else Status := MoveFile(PChar(ExistingFilePath), PChar(NewFilePath)); if Status then Result := 0 else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'MoveFile failed, error code = %d', [-Result]); end; DbgPrint(DokanFileInfo, ''); end;
function MirrorSetEndOfFile(FileName: PWideChar; Length: Int64; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'SetEndOfFile: %s', [FilePath]); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -1; DbgPrint(DokanFileInfo, 'Invalid handle'); end else begin if SetFilePointerEx(MyGetFileHandle(DokanFileInfo), LARGE_INTEGER(Length), nil, FILE_BEGIN) then begin if SetEndOfFile(MyGetFileHandle(DokanFileInfo)) then Result := 0 else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'SetEndOfFile failed, error code = %d', [-Result]); end; end else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'Seek failed, error code = %d', [-Result]); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorSetAllocationSize(FileName: PWideChar; Length: Int64; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'SetAllocationSize: %s', [FilePath]); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin Result := -1; DbgPrint(DokanFileInfo, 'Invalid handle'); end else begin if SetFilePointerEx(MyGetFileHandle(DokanFileInfo), LARGE_INTEGER(Length), nil, FILE_BEGIN) then begin if SetEndOfFile(MyGetFileHandle(DokanFileInfo)) then Result := 0 else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'SetEndOfFile failed, error code = %d', [-Result]); end; end else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'Seek failed, error code = %d', [-Result]); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorLockFile(FileName: PWideChar; Offset, Length: Int64; var DokanFileInfo: TDokanFileInfo): Integer; stdcall; var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'LockFile: %s', [FilePath]); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin DbgPrint(DokanFileInfo, 'Invalid handle'); Result := -1; end else begin if LockFile(MyGetFileHandle(DokanFileInfo), LARGE_INTEGER(Offset).LowPart, LARGE_INTEGER(Offset).HighPart, LARGE_INTEGER(Length).LowPart, LARGE_INTEGER(Length).HighPart) then Result := 0 else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'LockFile failed, error code = %d', [-Result]); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorUnlockFile(FileName: PWideChar; Offset, Length: Int64; var DokanFileInfo: TDokanFileInfo): Integer; stdcall;
var FilePath: string; begin FilePath := MirrorConvertPath(DokanFileInfo, FileName); DbgPrint(DokanFileInfo, 'UnlockFile: %s', [FilePath]); if MyGetFileHandle(DokanFileInfo) = INVALID_HANDLE_VALUE then begin DbgPrint(DokanFileInfo, 'Invalid handle'); Result := -1; end else begin if UnlockFile(MyGetFileHandle(DokanFileInfo), LARGE_INTEGER(Offset).LowPart, LARGE_INTEGER(Offset).HighPart, LARGE_INTEGER(Length).LowPart, LARGE_INTEGER(Length).HighPart) then Result := 0 else begin Result := -GetLastError; DbgPrint(DokanFileInfo, 'UnlockFile failed, error code = %d', [-Result]); end; end; DbgPrint(DokanFileInfo, ''); end;
function MirrorGetVolumeInfo(VolumeNameBuffer: LPWSTR; VolumeNameSize: DWORD; var VolumeSerialNumber, MaximumComponentLength, FileSystemFlags: DWORD; FileSystemNameBuffer: LPWSTR; FileSystemNameSize: DWORD; var DokanFileInfo: DOKAN_FILE_INFO): Integer; stdcall; var sVolume: WideString; begin Result := 0; sVolume := Format('Dokan(%s)', [MirrorConvertPath(DokanFileInfo, nil)]); if VolumeNameSize < DWord((Length(sVolume)+1) * 2) then begin Result := (Length(sVolume)+1) * 2; end else begin CopyMemory(VolumeNameBuffer, Pointer(sVolume), Length(sVolume)* 2); VolumeNameBuffer[Length(sVolume)+1] := #0; VolumeSerialNumber := $12345678; //testing end; end;
function MirrorUnmount(var DokanFileInfo: TDokanFileInfo): Integer; stdcall; begin Result := 0; DbgPrint(DokanFileInfo, 'Unmount'); DbgPrint(DokanFileInfo, ''); end;
{ TMirror Thread (for multi thread testing) }
procedure TMirrorDrive.Execute; var i: integer; begin DokanUnmount(FDokanOptions.DriveLetter); //try to unmount i := DokanMain(FDokanOptions, FDokanOperations); if i <> DOKAN_SUCCESS then raise EDokanMainError.Create(i); end;
constructor TMirrorDrive.Create(const ADirectory: string; ADrive: WideChar; {$IFNDEF CONSOLE}AHandle: THandle;{$ENDIF} ADebugMode: Boolean); begin FRootDirectory := ADirectory;
with FDokanOperations do begin CreateFile := MirrorCreateFile; OpenDirectory := MirrorOpenDirectory; CreateDirectory := MirrorCreateDirectory; Cleanup := MirrorCleanup; CloseFile := MirrorCloseFile; ReadFile := MirrorReadFile; WriteFile := MirrorWriteFile; FlushFileBuffers := MirrorFlushFileBuffers; GetFileInformation := MirrorGetFileInformation; FindFiles := MirrorFindFiles; FindFilesWithPattern := nil; SetFileAttributes := MirrorSetFileAttributes; SetFileTime := MirrorSetFileTime; DeleteFile := MirrorDeleteFile; DeleteDirectory := MirrorDeleteDirectory; MoveFile := MirrorMoveFile; SetEndOfFile := MirrorSetEndOfFile; SetAllocationSize := MirrorSetAllocationSize; LockFile := MirrorLockFile; UnlockFile := MirrorUnlockFile; GetDiskFreeSpace := nil; GetVolumeInformation := MirrorGetVolumeInfo; Unmount := MirrorUnmount end;
with FDokanOptions do begin DriveLetter := ADrive; ThreadCount := 0; DebugMode := ADebugMode; UseStdErr := False; UseAltStream := False; UseKeepAlive := False; GlobalContext := Integer(Self); end;
{$IFNDEF CONSOLE} FHandle := AHandle; {$ENDIF}
inherited Create(True); end;
// Utilities routines procedure DbgPrint(const DokanFileInfo: TDokanFileInfo; const Message: string); overload; begin if DokanFileInfo.DokanOptions.DebugMode then begin // if g_DokanOptions.UseStdErr then // Writeln(ErrOutput,Message) // else {$IFDEF CONSOLE} Writeln(Message) {$ELSE} try with GetMirrorDrive(DokanFileInfo) do begin if FHandle > 0 then begin SendMessage(FHandle, WM_IW_LOGMSG, Integer(PChar(Message)), Length(Message)); end; end; except end; {$ENDIF} end; end;
procedure DbgPrint(const DokanFileInfo: TDokanFileInfo; const Format: string; const Args: array of const); overload; begin DbgPrint(DokanFileInfo, SysUtils.Format(Format,Args)); end;
function MirrorConvertPath(const DokanFileInfo: TDokanFileInfo; FileName: PWideChar): string; var path: string; begin path := GetMirrorDrive(DokanFileInfo).FRootDirectory; if FileName = nil then begin DbgPrint(DokanFileInfo, 'Null filename'); Result := path end else Result := path + FileName; end;
end.
// File Mapping (与远程服务端同步)
unit cfFileMapping;
interface
uses Windows, Messages, SysUtils, Classes, {$IFNDEF CONSOLE}Forms, {$ENDIF} FileCtrl, ShellApi, Math, SuperObject, {$IFDEF VER130}Unicode, {$ENDIF}cfConnect;
procedure FmCreateDir(const vOriginDir, vMapDir: string); procedure FmListDir(const vOriginDir, vMapDir: string); procedure FmDeleteDir(const vOriginDir, vMapDir: string);
procedure FmUpdateFile(const vOriginFile, vMapFile: string); procedure FmSaveFile(const vOriginFile, vMapFile: string); procedure FmDeleteFile(const vOriginFile, vMapFile: string);
procedure FmMoveFile(const vOldMapFile, vNewMapFile: string);
implementation
{$IFNDEF CONSOLE} const WM_IW_LOGMSG = WM_USER + 1001; {$ENDIF}
const cLogonID = 100; // "logon", cReceiveFile = 200; // "receivefile", cSendFile = 300; // "sendfile", cListDir = 400; // "listdir", cCreateDir = 500; // "createfolder", cDeleteDir = 600; // "deletefloder", cDeleteFile = 700; // "deletefile", cMoveFile = 800; // "movefile", cDefault = 999; // "default"
function SetFilePointerEx(hFile: THandle; lDistanceToMove: LARGE_INTEGER; lpNewFilePointer: Pointer; dwMoveMethod: DWORD): BOOL; stdcall; external kernel32;
{------------------------------------------------------------------------------ Internal functions ------------------------------------------------------------------------------}
procedure LogIt(const S: string); begin {$IFDEF CONSOLE} WriteLn(S); {$ELSE} if Assigned(Application.MainForm) then begin //for testing SendMessage(Application.MainForm.Handle, WM_IW_LOGMSG, Integer(PChar(S)), Length(S)); end; {$ENDIF} end;
function FmtMapDir(const S: string): string; var i: Integer; begin Result := S; if (Result <> '') and (Result[1] in ['/', '\']) then begin Delete(Result, 1, 1); end; for i := 1 to Length(Result) do begin if Result[i] = '\' then begin Result[i] := '/'; end; end; end;
function MyDeleteDir(const vDir: string): Boolean; var fo: TSHFILEOPSTRUCT; begin FillChar(fo, SizeOf(fo), 0); with fo do begin Wnd := 0; wFunc := FO_DELETE; pFrom := PChar(vDir + #0); pTo := #0#0; fFlags := FOF_NOCONFIRMATION + FOF_SILENT; end; Result := (SHFileOperation(fo) = 0); end;
function MyStrToDateTime(const S: string): TDateTime; const DIGIT = ['0'..'9']; var i: Integer;
procedure ExtractNum(var vNum: Word); begin vNum := 0; while (i <= Length(S)) and (S[i] in DIGIT) do begin vNum := vNum * 10 + Ord(S[i]) - Ord('0'); Inc(i); end; while (i <= Length(S)) and not(S[i] in DIGIT) do Inc(i); end;
var y, m, d, hour, mins, secs: Word; begin Result := 0; if S = '' then Exit; try // TBD: for "yyyy-mm-dd hh:nn:ss" or "yyyy/mm/dd hh:nn:ss" date format, ... i := 1; ExtractNum(y); ExtractNum(m); ExtractNum(d); ExtractNum(hour); ExtractNum(mins); ExtractNum(secs); Result := EncodeDate(y, m, d) + EncodeTime(hour, mins, secs, 0); except end; end;
{ create map dir/files }
procedure CreateLocalMapping(const vDir, vName: string; vIsFile: Boolean; vSize: Int64; vLastVisitTime, vCreateTime, vLastModifyTime: TDateTime); const cNullHead = #0#0#0#0#0#0#0#0; var hFile: Integer; path: string; begin path := IncludeTrailingBackslash(vDir) + vName; if vIsFile then begin if FileExists(path) then begin hFile := FileOpen(path, fmOpenReadWrite or fmShareDenyNone); try if FileGetDate(hFile) < DateTimeToFileDate(vLastModifyTime) then begin FileWrite(hFile, PChar(cNullHead)^, Min(vSize, Length(cNullHead))); if vSize <> GetFileSize(hFile, nil) then begin // if SetFilePointerEx(hFile, LARGE_INTEGER(vSize), nil, FILE_BEGIN) then begin SetEndOfFile(hFile); end; end; FileSetDate(hFile, DateTimeToFileDate(vLastModifyTime)); end; finally FileClose(hFile); end; end else begin hFile := FileCreate(path); try if SetFilePointerEx(hFile, LARGE_INTEGER(vSize), nil, FILE_BEGIN) then begin SetEndOfFile(hFile); end; FileSetDate(hFile, DateTimeToFileDate(vLastModifyTime)); finally FileClose(hFile); end; end; end else begin ForceDirectories(path); hFile := FileOpen(path, fmOpenReadWrite or fmShareDenyNone); try FileSetDate(hFile, DateTimeToFileDate(vLastModifyTime)); finally FileClose(hFile); end; end; end;
{------------------------------------------------------------------------------ Public Interface ------------------------------------------------------------------------------}
procedure FmCreateDir(const vOriginDir, vMapDir: string); begin try CloudConnector.ExecuteCommand(Format('{"msgid":%d,"path":"%s"}', [cCreateDir, AnsiToUtf8(FmtMapDir(vMapDir))])); except on E: Exception do begin LogIt(E.Message); end; end; end;
procedure FmListDir(const vOriginDir, vMapDir: string); const cDirFileFlags: array[Boolean] of Integer = (0, 1); var s: string; jsonObj, subObj: ISuperObject; jsonArray: TSuperArray; i: Integer; path: string; dirFiles: TStringList; sr: TSearchRec; idx: Integer; isFile: Boolean; begin try s := CloudConnector.ExecuteCommand(Format('{"msgid":%d,"path":"%s"}', [cListDir, AnsiToUtf8(FmtMapDir(vMapDir))])); jsonObj := SO(Utf8ToAnsi(s)); jsonArray := jsonObj.AsArray; if jsonArray = nil then begin LogIt('Error: Empty Array from JSon Object.'); Exit; end; dirFiles := TStringList.Create; try // delete obsolete directories/files for i := 0 to jsonArray.Length -1 do begin dirFiles.AddObject(jsonArray[i].S['name'], TObject(StrToIntDef(jsonArray[i].S['isfile'], 0))); end; path := IncludeTrailingBackslash(vOriginDir); dirFiles.Sorted := True; if FindFirst(path + '*.*', faAnyFile, sr) = 0 then try repeat if (sr.Name <> '.') and (sr.Name <> '..') then begin // ignore hidden & system dir/file ??!! if ((sr.Attr and faHidden) = 0) or ((sr.Attr and faSysFile) = 0) then begin isFile := (sr.Attr and faDirectory) = 0; if not dirFiles.Find(sr.Name, idx) or (Integer(dirFiles.Objects[idx]) <> cDirFileFlags[isFile]) then begin if isFile then begin DeleteFile(path + sr.Name); LogIt('Delete Obsolete File: ' + path + sr.Name); end else begin MyDeleteDir(path + sr.Name); LogIt('Delete Obsolete Folder: ' + path + sr.Name); end; end; end; end; until FindNext(sr) <> 0; finally FindClose(sr); end; // save to local for i := 0 to jsonArray.Length -1 do begin subObj := jsonArray[i]; CreateLocalMapping( vOriginDir, subObj.S['name'], '1'= subObj.S['isfile'], subObj.I['size'], MyStrToDateTime(subObj.S['lastvisittime']), MyStrToDateTime(subObj.S['createtime']), MyStrToDateTime(subObj.S['lastmodifytime']) ); end; finally dirFiles.Free; end; except on E: Exception do begin LogIt(E.Message); end; end; end;
procedure FmDeleteDir(const vOriginDir, vMapDir: string); begin try CloudConnector.ExecuteCommand(Format('{"msgid":%d,"path":"%s"}', [cDeleteDir, AnsiToUtf8(FmtMapDir(vMapDir))])); except on E: Exception do begin LogIt(E.Message); end; end; end;
procedure FmUpdateFile(const vOriginFile, vMapFile: string); var stream: TFileStream; fDate: Integer; buf: string; begin try if not FileExists(vOriginFile) then Exit; stream := TFileStream.Create(vOriginFile, fmOpenReadWrite or fmShareDenyWrite); try if stream.Size > 0 then begin SetLength(buf, Min(stream.Size, 8)); stream.Read(PChar(buf)^, Length(buf)); if buf <> StringOfChar(#0, Length(buf)) then begin Exit; end; stream.Position := 0; end; fDate := FileGetDate(stream.Handle); CloudConnector.ReadFile(Format('{"msgid":%d,"path":"%s"}', [cSendFile, AnsiToUtf8(FmtMapDir(vMapFile))]), stream); FlushFileBuffers(stream.Handle); FileSetDate(stream.Handle, fDate); finally stream.Free; end; except on E: Exception do begin LogIt(E.Message); end; end; end;
procedure FmSaveFile(const vOriginFile, vMapFile: string); var stream: TFileStream; fDate: Integer; begin try stream := TFileStream.Create(vOriginFile, fmOpenRead or fmShareDenyNone); try fDate := DateTimeToFileDate(MyStrToDateTime(CloudConnector.SaveFile( Format('{"msgid":%d,"path":"%s","size":%d}', [cReceiveFile, AnsiToUtf8(FmtMapDir(vMapFile)), stream.Size]), stream))); FileSetDate(stream.Handle, fDate); finally stream.Free; end; except on E: Exception do begin LogIt(E.Message); end; end; end;
procedure FmDeleteFile(const vOriginFile, vMapFile: string); begin try CloudConnector.ExecuteCommand(Format('{"msgid":%d,"path":"%s"}', [cDeleteFile, AnsiToUtf8(FmtMapDir(vMapFile))])); except on E: Exception do begin LogIt(E.Message); end; end; end;
procedure FmMoveFile(const vOldMapFile, vNewMapFile: string); begin try CloudConnector.ExecuteCommand(Format('{"msgid":%d,"old":"%s","new":"%s"}', [cMoveFile, AnsiToUtf8(FmtMapDir(vOldMapFile)), AnsiToUtf8(FmtMapDir(vNewMapFile))])); except on E: Exception do begin LogIt(E.Message); end; end; end;
end.
// Connector (通过IndyTCPClient与远程服务端通讯)
unit cfConnect;
interface
uses Windows, Messages, SysUtils, Classes, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, SyncObjs, superobject;
type TCloudConnector = class private FLocker: TCriticalSection; FConnector: TIdTCPClient; FTimeout: Integer; FUser: string; FToken: string; function AddInternalParams(const vCmdLine: string): string; public constructor Create; destructor Destroy; override; procedure Init(const vHost: string; vPort: Integer); procedure Logon(const vUser, vPW: string; vTimeout: Integer = 5000); function ExecuteCommand(const vCmdLine: string): string; function ReadFile(const vCmdLine: string; vStream: TStream): Boolean; function SaveFile(const vCmdLine: string; vStream: TStream): string; end;
function CloudConnector: TCloudConnector;
implementation
const LF = #10;
var g_CloudConnector: TCloudConnector;
{ Public Functions }
function CloudConnector: TCloudConnector; begin if g_CloudConnector = nil then begin g_CloudConnector := TCloudConnector.Create; end; Result := g_CloudConnector; end;
{ Internal Functions }
function Fetch(var S: string; const vDelimiter: string): string; var idx: Integer; begin idx := Pos(vDelimiter, S); if idx > 0 then begin Result := Copy(S, 1, idx -1); Delete(S, 1, idx + Length(vDelimiter) -1); end else begin Result := S; S := ''; end; end;
{ TCloudConnector }
constructor TCloudConnector.Create; begin FLocker := TCriticalSection.Create; FConnector := TIdTCPClient.Create(nil); FConnector.Host := '127.0.0.1'; FConnector.Port := 9288; FTimeout := 5000; end;
destructor TCloudConnector.Destroy; begin FConnector.Free; FLocker.Free; inherited; end;
{ private interface }
function TCloudConnector.AddInternalParams(const vCmdLine: string): string; var idx: Integer; begin Result := vCmdLine; idx := LastDelimiter('}', Result); System.Insert(Format(',"user":"%s","token":"%s"', [FUser, FToken]), Result, idx); end;
{ public interface }
procedure TCloudConnector.Init(const vHost: string; vPort: Integer); begin with FConnector do begin Host := vHost; Port := vPort; end; end;
procedure TCloudConnector.Logon(const vUser, vPW: string; vTimeout: Integer); var s: string; code: Integer; superObj: ISuperObject; begin FTimeout := vTimeout; with FConnector do begin Connect(FTimeout); try WriteLn('{"msgid":100}'); //logon s := ReadLn(LF, FTimeout); code := superObj.I['result'] ; if code <> 100 then begin //process error s := superObj.S['message']; raise Exception.Create(Format('Error: %d - %s', [code, s])); end; FUser := vUser; FToken := superObj.S['token']; finally Disconnect; end; end; end;
function TCloudConnector.ExecuteCommand(const vCmdLine: string): string; begin FLocker.Enter; try Result := ''; with FConnector do begin Connect(FTimeout); try WriteLn(AddInternalParams(vCmdLine)); Result := ReadLn(LF, FTimeout); finally Disconnect; end; end; finally FLocker.Leave; end; end;
function TCloudConnector.ReadFile(const vCmdLine: string; vStream: TStream): Boolean; var superObj: ISuperObject; begin FLocker.Enter; try try with FConnector do begin Connect(FTimeout); try WriteLn(AddInternalParams(vCmdLine)); superObj := SO(ReadLn()); ReadStream(vStream, superObj.I['filesize']); finally Disconnect; end; end; Result := True; except on E: Exception do begin Result := False; end; end; finally FLocker.Leave; end; end;
function TCloudConnector.SaveFile(const vCmdLine: string; vStream: TStream): string; var superObj: ISuperObject; begin Result := ''; FLocker.Enter; try try with FConnector do begin Connect(FTimeout); try WriteLn(AddInternalParams(vCmdLine)); WriteStream(vStream); superObj := SO(ReadLn()); Result := superObj.S['lastmodifytime']; finally Disconnect; end; end; except on E: Exception do begin end; end; finally FLocker.Leave; end; end;
initialization
finalization g_CloudConnector.Free;
end.
// 对Delphi5,还需要一个Unicode转换单元;Delphi6以上就不需要了
{****************************************************************************} { Some Function of Ansi, UTF8, Unicode Converting (copy from Delphi6) } {****************************************************************************}
unit Unicode;
interface
uses Classes, Windows, SysUtils;
type UTF8String = type string; PUTF8String = ^UTF8String;
{ PChar/PWideChar Unicode <-> UTF8 conversion }
// UnicodeToUTF8(3): // UTF8ToUnicode(3): // Scans the source data to find the null terminator, up to MaxBytes // Dest must have MaxBytes available in Dest. // MaxDestBytes includes the null terminator (last char in the buffer will be set to null) // Function result includes the null terminator.
function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: Integer): Integer; overload; //deprecated; function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: Integer): Integer; overload; //deprecated;
// UnicodeToUtf8(4): // UTF8ToUnicode(4): // MaxDestBytes includes the null terminator (last char in the buffer will be set to null) // Function result includes the null terminator. // Nulls in the source data are not considered terminators - SourceChars must be accurate
function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal; overload; function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal; overload;
{ WideString <-> UTF8 conversion }
function UTF8Encode(const WS: WideString): UTF8String; function UTF8Decode(const S: UTF8String): WideString;
{ Ansi <-> UTF8 conversion }
function AnsiToUtf8(const S: string): UTF8String; function Utf8ToAnsi(const S: UTF8String): string;
function AnsiToUtf8Xml(const S: string): UTF8String;
implementation
// UnicodeToUTF8(3): // Scans the source data to find the null terminator, up to MaxBytes // Dest must have MaxBytes available in Dest.
function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: Integer): Integer; var len: Cardinal; begin len := 0; if Source <> nil then while Source[len] <> #0 do Inc(len); Result := UnicodeToUtf8(Dest, MaxBytes, Source, len); end;
// UnicodeToUtf8(4): // MaxDestBytes includes the null terminator (last char in the buffer will be set to null) // Function result includes the null terminator. // Nulls in the source data are not considered terminators - SourceChars must be accurate
function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal; var i, count: Cardinal; c: Cardinal; begin Result := 0; if Source = nil then Exit; count := 0; i := 0; if Dest <> nil then begin while (i < SourceChars) and (count < MaxDestBytes) do begin c := Cardinal(Source[i]); Inc(i); if c <= $7F then begin Dest[count] := Char(c); Inc(count); end else if c > $7FF then begin if count + 3 > MaxDestBytes then break; Dest[count] := Char($E0 or (c shr 12)); Dest[count+1] := Char($80 or ((c shr 6) and $3F)); Dest[count+2] := Char($80 or (c and $3F)); Inc(count,3); end else // $7F < Source[i] <= $7FF begin if count + 2 > MaxDestBytes then break; Dest[count] := Char($C0 or (c shr 6)); Dest[count+1] := Char($80 or (c and $3F)); Inc(count,2); end; end; if count >= MaxDestBytes then count := MaxDestBytes-1; Dest[count] := #0; end else begin while i < SourceChars do begin c := Integer(Source[i]); Inc(i); if c > $7F then begin if c > $7FF then Inc(count); Inc(count); end; Inc(count); end; end; Result := count+1; // convert zero based index to byte count end;
function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: Integer): Integer; var len: Cardinal; begin len := 0; if Source <> nil then while Source[len] <> #0 do Inc(len); Result := Utf8ToUnicode(Dest, MaxChars, Source, len); end;
function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal; var i, count: Cardinal; c: Byte; wc: Cardinal; begin if Source = nil then begin Result := 0; Exit; end; Result := Cardinal(-1); count := 0; i := 0; if Dest <> nil then begin while (i < SourceBytes) and (count < MaxDestChars) do begin wc := Cardinal(Source[i]); Inc(i); if (wc and $80) <> 0 then begin wc := wc and $3F; if i > SourceBytes then Exit; // incomplete multibyte char if (wc and $20) <> 0 then begin c := Byte(Source[i]); Inc(i); if (c and $C0) <> $80 then Exit; // malformed trail byte or out of range char if i > SourceBytes then Exit; // incomplete multibyte char wc := (wc shl 6) or (c and $3F); end; c := Byte(Source[i]); Inc(i); if (c and $C0) <> $80 then Exit; // malformed trail byte
Dest[count] := WideChar((wc shl 6) or (c and $3F)); end else Dest[count] := WideChar(wc); Inc(count); end; if count >= MaxDestChars then count := MaxDestChars-1; Dest[count] := #0; end else begin while (i <= SourceBytes) do begin c := Byte(Source[i]); Inc(i); if (c and $80) <> 0 then begin if (c and $F0) = $F0 then Exit; // too many bytes for UCS2 if (c and $40) = 0 then Exit; // malformed lead byte if i > SourceBytes then Exit; // incomplete multibyte char
if (Byte(Source[i]) and $C0) <> $80 then Exit; // malformed trail byte Inc(i); if i > SourceBytes then Exit; // incomplete multibyte char if ((c and $20) <> 0) and ((Byte(Source[i]) and $C0) <> $80) then Exit; // malformed trail byte Inc(i); end; Inc(count); end; end; Result := count+1; end;
function Utf8Encode(const WS: WideString): UTF8String; var L: Integer; Temp: UTF8String; begin Result := ''; if WS = '' then Exit; SetLength(Temp, Length(WS) * 3); // SetLength includes space for null terminator
L := UnicodeToUtf8(PChar(Temp), Length(Temp)+1, PWideChar(WS), Length(WS)); if L > 0 then SetLength(Temp, L-1) else Temp := ''; Result := Temp; end;
function Utf8Decode(const S: UTF8String): WideString; var L: Integer; Temp: WideString; begin Result := ''; if S = '' then Exit; SetLength(Temp, Length(S));
L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PChar(S), Length(S)); if L > 0 then SetLength(Temp, L-1) else Temp := ''; Result := Temp; end;
function AnsiToUtf8(const S: string): UTF8String; begin Result := Utf8Encode(S); end;
function Utf8ToAnsi(const S: UTF8String): string; begin Result := Utf8Decode(S); end;
function AnsiToUtf8Xml(const S: string): UTF8String; var //only process '&', ... ´ ... i: Integer; begin Result := S; i := 1; while i <= Length(Result) do begin case Result[i] of '&': begin Insert('amp;', Result, i+1); Inc(i, 4); end; '>': begin Result[i] := '&'; Insert('gt;', Result, i+1); Inc(i, 3); end; '<': begin Result[i] := '&'; Insert('lt;', Result, i+1); Inc(i, 3); end; '"': begin Result[i] := '&'; Insert('quot;', Result, i+1); Inc(i, 5); end; '''': begin Result[i] := '&'; Insert('apos;', Result, i+1); Inc(i, 5); end; #128..#255: //process wearer′s ′=´ begin Insert('#x' + IntToHex(Ord(Result[i]), 2) + ';', Result, i+1); Result[i] := '&'; Inc(i, 5); end; end; Inc(i); end; Result := AnsiToUtf8(Result); end;
end.
|