dokan 开发实战

痛定思痛。 2021-11-05 00:26 370阅读 0赞

因工作需要，最近与同事合作使用Dokan开发了一个虚拟磁盘的简单程序，初步实现了远程目录映射到本地虚拟磁盘的功能。

远程服务端是用Python写的，主要是将远程主机上的目录文件传给客戶端，在这里就不细说了。

Dokan客户端则由Delphi开发，其参考代码来自网络上的Delphi例子，比如[Mirror Driver][]。

本篇文章主要是Dokan开发过程的一些总结，所以不会对Dokan本身做介绍，与Dokan有关的资料及代码，请到google里搜索，或到Dokan的官方网站去下载([Dokan官网][Dokan])，源码是C语言的，应用例子有Ruby、.Net及C的。如果想要Delphi的例子代码，只能自己去找了。

刚开始时由于不清楚如何用Dokan来实现一个文件系统，所以需要做一些试验，结果一不小心就蓝屏了！悲剧啊，用XP系统已经好多年没遇到蓝屏了。几次蓝屏之后，终于受不了了，于是在VMWare里装了个虚拟机的XP，这下不怕蓝屏了，哈哈。强烈建议装个虚拟机来玩Dokan，否则刚开始的时候你会蓝屏Ｎ次！

为简单起见，我做的Dokan虚拟磁盘采用将远程目录缓存到本地目录的方法来实现，这样就不用自己维护一堆目录、文件的信息，只需要关注如何更新同步目录与文件就可以了。由于Dokan是多线程的，因此实现时需要做到线程安全；查看Dokan使用的结构类型，发现只有两个成员可以使用，即DOKAN\_OPTIONS里的GlobalContext和DOKAN\_FILE\_INFO里的Context，其中GlobalContext只能用来存储全局的信息，比如存放线程实例的指针，这样一来，实际上就剩下 DOKAN\_FILE\_INFO里的Context 一个成员可以用来存储与文件有关的信息了，一般用它来存储文件指针。我这次实现没有自己定义类来管理目录与文件，而是直接利用缓存目录，因此只需要处理文件指针和是否需要更新文件两个信息就可以了，而 DOKAN\_FILE\_INFO里的Context是Int64的，在Ｗin32里可以用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][Mirror Driver]修改而来）

unit cfMirrorDrive;  
  
(\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*  
\*  
\* Copyright (c) 2007, 2008 Hiroki Asakawa info@dokan-dev.net  
\*  
\* 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 '&', ... &\#xB4 ...  
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 ′=&\#xB4;  
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.

[Mirror Driver]: http://4coder.org/delphi-source-code/137/
[Dokan]: http://dokan-dev.net/en/