1666 lines
45 KiB
Plaintext
1666 lines
45 KiB
Plaintext
{*******************************************************}
|
||
{ }
|
||
{ Tocsg.Files }
|
||
{ }
|
||
{ Copyright (C) 2022 kkuzil }
|
||
{ }
|
||
{*******************************************************}
|
||
|
||
unit Tocsg.Files;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, System.SysUtils, Tocsg.Obj, superobject, Tocsg.Thread,
|
||
System.SyncObjs, System.Classes, System.Generics.Collections,
|
||
System.Generics.Defaults;
|
||
|
||
const
|
||
{$IF CompilerVersion <= 21}
|
||
FILE_LIST_DIRECTORY = $0001;
|
||
{$IFEND}
|
||
|
||
DEFAULT_FILEWATCH_FILTER = FILE_NOTIFY_CHANGE_FILE_NAME or
|
||
FILE_NOTIFY_CHANGE_DIR_NAME or
|
||
FILE_NOTIFY_CHANGE_SIZE or
|
||
FILE_NOTIFY_CHANGE_LAST_WRITE; // FILE_NOTIFY_CHANGE_SIZE <20><><EFBFBD><EFBFBD><EFBFBD>δ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> ijġ <20><><EFBFBD>ؼ<EFBFBD> <20>߰<EFBFBD><DFB0><EFBFBD>.
|
||
|
||
|
||
STOP_WORK = $FFFFFFFF;
|
||
|
||
type
|
||
PDirWatchInfo = ^TDirWatchInfo;
|
||
TDirWatchInfo = packed record
|
||
dwNextOffset,
|
||
dwAction,
|
||
dwLength: DWORD;
|
||
sPath: PChar;
|
||
end;
|
||
|
||
// Action : 1 = Add, 2 = Delete, 3 = Modify, 4 = Rename, 5 = NewName
|
||
PDirWatchEnt = ^TDirWatchEnt;
|
||
TDirWatchEnt = record
|
||
sPath: String;
|
||
dwAction: DWORD;
|
||
end;
|
||
|
||
TEvDirWatchNotification = procedure(Sender: TObject; pEnt: PDirWatchEnt) of object;
|
||
|
||
TThdProcDirWatchEnt = class(TTgThread)
|
||
private
|
||
qDirWatchEntry_: TQueue<PDirWatchEnt>;
|
||
evDirWatchNotification_: TEvDirWatchNotification;
|
||
protected
|
||
procedure OnDirWatchNotify(Sender: TObject; const Item: PDirWatchEnt;
|
||
Action: TCollectionNotification);
|
||
procedure Execute; override;
|
||
public
|
||
Constructor Create(bSync: Boolean);
|
||
Destructor Destroy; override;
|
||
procedure Clear;
|
||
|
||
function Count: Integer;
|
||
|
||
procedure PushDirWatch(pEnt: PDirWatchEnt); virtual;
|
||
property OnProcessDirWatch: TEvDirWatchNotification write evDirWatchNotification_;
|
||
end;
|
||
|
||
TThdDirWatchEnt = class(TTgThread)
|
||
private
|
||
Processor_: TThdProcDirWatchEnt;
|
||
sTgDir_: String;
|
||
hDir_,
|
||
hCompPort_: THandle;
|
||
dwFilter_: DWORD;
|
||
OverL_: TOverlapped;
|
||
pOVerL_: POverlapped;
|
||
pBuf_: array [0..4096] of Byte;
|
||
bSubDirWatch_,
|
||
bRemoveAbleDrive_: Boolean;
|
||
bCoInit_: Boolean;
|
||
protected
|
||
function GetFilter: DWORD;
|
||
procedure SetFilter(dwFilter: DWORD);
|
||
procedure Execute; override;
|
||
procedure DoTerminate; override;
|
||
public
|
||
Constructor Create(aProcessor: TThdProcDirWatchEnt; const sTgDir: String;
|
||
bSubDirWatch: Boolean; dwFilter: DWORD; bCoInit: Boolean = false);
|
||
Destructor Destroy; override;
|
||
|
||
property Filter: DWORD read GetFilter write SetFilter;
|
||
end;
|
||
|
||
TThdDirWatchEntList = class(TList<TThdDirWatchEnt>)
|
||
protected
|
||
procedure Notify(const Item: TThdDirWatchEnt; Action: TCollectionNotification); override;
|
||
public
|
||
function GetEntByTgDir(sTgDir: String): TThdDirWatchEnt;
|
||
end;
|
||
|
||
TTgDirWatchBase = class(TTgObject)
|
||
private
|
||
CS_: TCriticalSection;
|
||
bSubDirWatch_: Boolean;
|
||
dwFilter_: DWORD;
|
||
DcDirWatch_: TDictionary<String,TThdDirWatchEnt>;
|
||
procedure OnDirWatchNotify(Sender: TObject; const Item: TThdDirWatchEnt;
|
||
Action: TCollectionNotification);
|
||
protected
|
||
Processor_: TThdProcDirWatchEnt;
|
||
protected
|
||
procedure Lock;
|
||
procedure Unlock;
|
||
procedure SetFilter(dwFilter: DWORD);
|
||
procedure ProcessDirWatchEnt(Sender: TObject; pInfo: PDirWatchEnt); virtual; abstract;
|
||
public
|
||
Constructor Create(bSubDir, bSync: Boolean);
|
||
Destructor Destroy; override;
|
||
|
||
procedure AddDirWatch(sDir: String; bCoInit: Boolean = false);
|
||
function DelDirWatch(sDir: String): Boolean;
|
||
function ExistsDirWatch(sDir: String): Boolean;
|
||
procedure ClearDirWatch;
|
||
|
||
procedure StartWatch; virtual;
|
||
procedure StopWatch; virtual;
|
||
|
||
property Filter: DWORD read dwFilter_ write SetFilter;
|
||
property Processor: TThdProcDirWatchEnt read Processor_;
|
||
end;
|
||
|
||
PFileInfo = ^TFileInfo;
|
||
TFileInfo = record
|
||
Path: String;
|
||
Size: LONGLONG;
|
||
CreateDT,
|
||
ModifyDT,
|
||
AccessDT: TDateTime;
|
||
IsDir: Boolean;
|
||
end;
|
||
|
||
PModFile = ^TModFile;
|
||
TModFile = record
|
||
sDir,
|
||
sFName: String;
|
||
dtModify: TDateTime;
|
||
end;
|
||
TModFileList = class(TList<PModFile>)
|
||
protected
|
||
procedure Notify(const Item: PModFile; Action: TCollectionNotification); override;
|
||
end;
|
||
|
||
TModeFileComparer = class(TComparer<PModFile>)
|
||
public
|
||
function Compare(const Left, Right: PModFile): Integer; override;
|
||
end;
|
||
|
||
function GetFileSize_path(const sPath: String): LONGLONG; inline;
|
||
function GetFileSizeHiLow(dwHi, dwLow: DWORD): LONGLONG; inline;
|
||
function GetFilesSizeFromDir(sDir: String; bSubDir: Boolean; pnCnt: PInteger = nil; sIgrKwd: String = ''): LONGLONG;
|
||
|
||
function MoveFile_wait(sSrcPath, sDecPath: String; nWaitSec: WORD = 10; bForce: Boolean = false): Boolean;
|
||
function DeleteFile_wait(sSrcPath: String; nWaitSec: Integer = 10): Boolean;
|
||
|
||
function IsValidFilename(const sFName: String): Boolean; inline;
|
||
function GetValidFileName(sFName: String; sRepStr: String = ''): String; inline;
|
||
|
||
procedure ExtrFilesFromDir(sDir: String; aList: TStrings; bSubDir: Boolean = false; sFileExts: String = '');
|
||
procedure ExtrDirFromDir(sDir: String; aList: TStrings);
|
||
procedure ExtrFilesPathFromDir(sDir: String; aList: TStrings; bSubDir: Boolean = false; sFileExts: String = '');
|
||
procedure ExtrModFilesFromDir(sDir: String; aList: TModFileList; bSubDir: Boolean = false; sFileExts: String = '');
|
||
procedure DeleteDirSub(sDir: String; bIncludeSubDir: Boolean = true;
|
||
bForceDel: Boolean = false; aIgrList: TStringList = nil; bSafeDel: Boolean = false);
|
||
function DeleteDir(sDir: String; bIncludeSubDir: Boolean = true;
|
||
bForceDel: Boolean = false; aIgrList: TStringList = nil): Boolean;
|
||
function DeleteFileForce(sPath: String): Boolean;
|
||
function CopyDirSub(sSrcDir, sDestDir: String; bIncludeSubDir: Boolean = true): Boolean;
|
||
procedure GetDirInfo(sDir: String; var dwDirCnt: DWORD; var dwFileCnt: DWORD; var llTotalSize: LONGLONG; bSubDir: Boolean = false);
|
||
function CountFileExt(sDir: String; const arrExt: array of string; bIncSubDir: Boolean = false): Integer;
|
||
|
||
function GetFileDateTime(const sPath: String; var ftCreate, ftModify, ftAccess: TFileTime): Boolean; overload;
|
||
function GetFileDateTime(const sPath: String; var dtCreate, dtModify, dtAccess: TDateTime): Boolean; overload;
|
||
function GetFileDateTime_Local(const sPath: String; var dtCreate, dtModify, dtAccess: TDateTime): Boolean; overload;
|
||
function GetFileDateTime_Local(const sPath: String; var ftCreate, ftModify, ftAccess: TFileTime): Boolean; overload;
|
||
function SetFileDateTime(const sPath: String; ftCreate, ftModify, ftAccess: TFileTime): Boolean; overload;
|
||
function SetFileDateTime(const sPath: String; dtCreate, dtModify, dtAccess: TDateTime): Boolean; overload;
|
||
function ConvFileAttrToStr(dwAttr: DWORD; bIncDir: Boolean = false): String;
|
||
|
||
function GetSameFileNameInc(sPath: String): String;
|
||
|
||
function StringListCompareFileCreateDate(List: TStringList; Index1, Index2: Integer): Integer;
|
||
function StringListCompareFileModifyDate(List: TStringList; Index1, Index2: Integer): Integer;
|
||
|
||
function CheckSign(aStream: TStream; pBuf: Pointer; nLen: Integer): Boolean; overload;
|
||
function CheckSign(sPath: String; pBuf: Pointer; nLen: Integer): Boolean; overload;
|
||
function CheckSign(sPath: String; sSign: AnsiString): Boolean; overload;
|
||
function CheckSignFromList(sPath: String; BinStrList: TStrings): Boolean;
|
||
|
||
function CopyFileAfOpenCheck(sSrcPath, sDestPath: String; nTOSec: Integer = 5): Boolean;
|
||
function GetLastOpenFileFromJumpListAuto(const sJmpAutoPath: String): String;
|
||
|
||
// 사용하지 않음, 나중에 정리 25_1029 10:51:37 kku
|
||
//function FileExistsTO(sPath: String; nTOSec: Integer = 3): Boolean;
|
||
|
||
implementation
|
||
|
||
uses
|
||
System.IOUtils, Tocsg.Json, Tocsg.Exception, Tocsg.DateTime, Tocsg.Path,
|
||
Tocsg.Strings, System.DateUtils, System.StrUtils, Tocsg.Safe, Tocsg.Hex, Winapi.ActiveX, EM.GSStorage;
|
||
|
||
{ TThdProcDirWatchEnt }
|
||
|
||
Constructor TThdProcDirWatchEnt.Create(bSync: Boolean);
|
||
begin
|
||
Inherited Create;
|
||
|
||
{$IFDEF TRACE1} _Trace('Process DirWatch Begin ...'); {$ENDIF}
|
||
qDirWatchEntry_ := TQueue<PDirWatchEnt>.Create;
|
||
end;
|
||
|
||
Destructor TThdProcDirWatchEnt.Destroy;
|
||
begin
|
||
{$IFDEF TRACE1} _Trace('Process DirWatch End ...'); {$ENDIF}
|
||
Inherited;
|
||
qDirWatchEntry_.OnNotify := OnDirWatchNotify;
|
||
FreeAndNil(qDirWatchEntry_);
|
||
end;
|
||
|
||
procedure TThdProcDirWatchEnt.OnDirWatchNotify(Sender: TObject; const Item: PDirWatchEnt;
|
||
Action: TCollectionNotification);
|
||
begin
|
||
if Action = cnRemoved then
|
||
Dispose(Item);
|
||
end;
|
||
|
||
procedure TThdProcDirWatchEnt.Clear;
|
||
begin
|
||
Lock;
|
||
qDirWatchEntry_.OnNotify := OnDirWatchNotify;
|
||
try
|
||
qDirWatchEntry_.Clear;
|
||
finally
|
||
qDirWatchEntry_.OnNotify := nil;
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
function TThdProcDirWatchEnt.Count: Integer;
|
||
begin
|
||
Lock;
|
||
try
|
||
Result := qDirWatchEntry_.Count;
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
procedure TThdProcDirWatchEnt.Execute;
|
||
var
|
||
pEnt: PDirWatchEnt;
|
||
begin
|
||
while not Terminated and not GetWorkStop do
|
||
begin
|
||
try
|
||
if qDirWatchEntry_.Count = 0 then
|
||
begin
|
||
Sleep(500);
|
||
continue;
|
||
end;
|
||
|
||
Lock;
|
||
try
|
||
pEnt := qDirWatchEntry_.Dequeue
|
||
finally
|
||
Unlock;
|
||
end;
|
||
|
||
if (pEnt <> nil) then
|
||
begin
|
||
if Assigned(evDirWatchNotification_) then
|
||
evDirWatchNotification_(Self, pEnt);
|
||
Dispose(pEnt);
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
begin
|
||
ETgException.TraceException(Self, E, 'Fail .. Execute()');
|
||
Sleep(1000);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TThdProcDirWatchEnt.PushDirWatch(pEnt: PDirWatchEnt);
|
||
begin
|
||
Lock;
|
||
try
|
||
qDirWatchEntry_.Enqueue(pEnt);
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
{ TThdFileWathchEntry }
|
||
|
||
Constructor TThdDirWatchEnt.Create(aProcessor: TThdProcDirWatchEnt;
|
||
const sTgDir: String; bSubDirWatch: Boolean; dwFilter: DWORD; bCoInit: Boolean = false);
|
||
var
|
||
dwLen: DWORD;
|
||
begin
|
||
Inherited Create;
|
||
|
||
hCompPort_ := 0;
|
||
Processor_ := aProcessor;
|
||
sTgDir_ := IncludeTrailingPathDelimiter(sTgDir);
|
||
bCoInit_ := bCoInit;
|
||
|
||
{$IFDEF TRACE1} _Trace('DirWatch Begin ... Drive = %s', [sDrive_]); {$ENDIF}
|
||
|
||
hDir_ := CreateFile(PChar(sTgDir_),
|
||
FILE_LIST_DIRECTORY,
|
||
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
|
||
nil,
|
||
OPEN_EXISTING,
|
||
FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED,
|
||
0);
|
||
|
||
if hDir_ = INVALID_HANDLE_VALUE then
|
||
begin
|
||
_Trace('CreateFile() - Fail!, Drive = %s, Error = %d', [sTgDir_, GetLastError]);
|
||
nLastError_ := 1;
|
||
hDir_ := 0;
|
||
exit;
|
||
end;
|
||
|
||
dwFilter_ := dwFilter;
|
||
if dwFilter_ = 0 then
|
||
begin
|
||
_Trace('No Filter... - Fail!');
|
||
nLastError_ := 2;
|
||
exit;
|
||
end;
|
||
|
||
hCompPort_ := CreateIoCompletionPort(hDir_, 0, DWORD(Self), 0);
|
||
if hCompPort_ = 0 then
|
||
begin
|
||
_Trace('CreateIoCompletionPort() - Fail!, Drive = %s, Error = %d', [sTgDir_, GetLastError]);
|
||
nLastError_ := 3;
|
||
CloseHandle(hDir_);
|
||
hDir_ := 0;
|
||
exit;
|
||
end;
|
||
|
||
ZeroMemory(@OverL_, SizeOf(OverL_));
|
||
ZeroMemory(@pBuf_, SizeOf(pBuf_));
|
||
pOVerL_ := @OverL_;
|
||
|
||
dwLen := 0;
|
||
bSubDirWatch_ := bSubDirWatch;
|
||
if not ReadDirectoryChanges(hDir_,
|
||
@pBuf_,
|
||
SizeOf(pBuf_),
|
||
bSubDirWatch_,
|
||
dwFilter_,
|
||
@dwLen,
|
||
pOVerL_,
|
||
nil) then
|
||
begin
|
||
_Trace('ReadDirectoryChanges() - Fail!, Drive = %s, Error = %d', [sTgDir_, GetLastError]);
|
||
nLastError_ := 4;
|
||
CloseHandle(hCompPort_);
|
||
CloseHandle(hDir_);
|
||
hCompPort_ := 0;
|
||
hDir_ := 0;
|
||
exit;
|
||
end;
|
||
|
||
if GetDriveType(PChar(sTgDir_)) = DRIVE_REMOVABLE then
|
||
bRemoveAbleDrive_ := true
|
||
else
|
||
bRemoveAbleDrive_ := false;
|
||
|
||
StartThread;
|
||
end;
|
||
|
||
Destructor TThdDirWatchEnt.Destroy;
|
||
begin
|
||
{$IFDEF TRACE1} _Trace('DirWatch End - Drive = %s', [sDrive_]); {$ENDIF}
|
||
|
||
if hCompPort_ <> 0 then
|
||
begin
|
||
PostQueuedCompletionStatus(hCompPort_, 0, 0, Pointer(STOP_WORK));
|
||
CloseHandle(hCompPort_);
|
||
hCompPort_ := 0;
|
||
end;
|
||
|
||
if (hDir_ <> 0) and (hDir_ <> INVALID_HANDLE_VALUE) then
|
||
begin
|
||
CloseHandle(hDir_);
|
||
hDir_ := 0;
|
||
end;
|
||
|
||
Inherited;
|
||
end;
|
||
|
||
function TThdDirWatchEnt.GetFilter: DWORD;
|
||
begin
|
||
Lock;
|
||
try
|
||
Result := dwFilter_;
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
procedure TThdDirWatchEnt.SetFilter(dwFilter: DWORD);
|
||
begin
|
||
Lock;
|
||
try
|
||
dwFilter_ := dwFilter;
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
procedure TThdDirWatchEnt.DoTerminate;
|
||
begin
|
||
if hCompPort_ <> 0 then
|
||
PostQueuedCompletionStatus(hCompPort_, 0, 0, Pointer(STOP_WORK));
|
||
end;
|
||
|
||
procedure TThdDirWatchEnt.Execute;
|
||
var
|
||
dwTrans: DWORD;
|
||
{$IF CompilerVersion <= 21}
|
||
nCompKey: DWORD;
|
||
{$ELSE}
|
||
nCompKey: NativeUInt;
|
||
{$IFEND}
|
||
|
||
procedure CloseWork;
|
||
begin
|
||
bWorkStop_ := false;
|
||
// if hCompPort_ <> 0 then
|
||
// begin
|
||
// CloseHandle(hCompPort_);
|
||
// hCompPort_ := 0;
|
||
// end;
|
||
//
|
||
// if hDir_ <> 0 then
|
||
// begin
|
||
// CloseHandle(hDir_);
|
||
// hDir_ := 0;
|
||
// end;
|
||
end;
|
||
|
||
procedure ProcessResult;
|
||
var
|
||
pInfo: PDirWatchInfo;
|
||
nOffset: Integer;
|
||
pEnt: PDirWatchEnt;
|
||
begin
|
||
pInfo := PDirWatchInfo(@pBuf_[0]);
|
||
while True do
|
||
begin
|
||
if Terminated then
|
||
exit;
|
||
|
||
New(pEnt);
|
||
{$IFDEF UNICODE}
|
||
pEnt.sPath := sTgDir_ + WideCharLenToString(@pInfo.sPath, pInfo.dwLength div 2);
|
||
{$ELSE}
|
||
pEnt.sPath := sDrive_ + WideCharLenToString(@pInfo.sPath, pInfo.dwLength);
|
||
{$ENDIF}
|
||
pEnt.dwAction := pInfo.dwAction;
|
||
|
||
Processor_.PushDirWatch(pEnt);
|
||
|
||
nOffset := pInfo.dwNextOffset;
|
||
if nOffset = 0 then
|
||
exit;
|
||
|
||
PAnsiChar(pInfo) := PAnsiChar(pInfo) + nOffset;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
if bCoInit_ then
|
||
CoInitialize(nil);
|
||
try
|
||
while not Terminated do
|
||
begin
|
||
try
|
||
if not bWorkStop_ and (hCompPort_ <> 0) then
|
||
begin
|
||
if GetQueuedCompletionStatus(hCompPort_,
|
||
dwTrans,
|
||
nCompKey,
|
||
pOVerL_,
|
||
INFINITE) then
|
||
begin
|
||
if DWORD(pOVerL_) = STOP_WORK then
|
||
begin
|
||
// _Trace('Stop work...., Drive = %s', [sDrive_]);
|
||
break;
|
||
end;
|
||
|
||
if nCompKey = DWORD(Self) then
|
||
begin
|
||
ProcessResult;
|
||
|
||
dwTrans := 0;
|
||
ZeroMemory(@pBuf_, SizeOf(pBuf_));
|
||
|
||
if not ReadDirectoryChanges(hDir_,
|
||
@pBuf_,
|
||
SizeOf(pBuf_),
|
||
bSubDirWatch_,
|
||
GetFilter,
|
||
@dwTrans,
|
||
pOVerL_,
|
||
nil) then
|
||
begin
|
||
nLastError_ := 7;
|
||
_Trace('>> ReadDirectoryChanges() - Fail! in Thread, Drive = %s, Error = %d', [sTgDir_, GetLastError]);
|
||
CloseWork;
|
||
end;
|
||
end else begin
|
||
nLastError_ := 6;
|
||
_Trace('Invlid completion key - Fail!, Drive = %s, Error = %d', [sTgDir_, GetLastError]);
|
||
CloseWork;
|
||
end;
|
||
end else begin
|
||
nLastError_ := 5;
|
||
_Trace('GetQueuedCompletionStatus() - Fail!, Drive = %s, Error = %d', [sTgDir_, GetLastError]);
|
||
CloseWork;
|
||
end;
|
||
end else Sleep(100);
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. Execute()');
|
||
end;
|
||
end;
|
||
finally
|
||
if bCoInit_ then
|
||
CoUninitialize;
|
||
end;
|
||
end;
|
||
|
||
{ TThdDirWatchEntList }
|
||
|
||
procedure TThdDirWatchEntList.Notify(const Item: TThdDirWatchEnt; Action: TCollectionNotification);
|
||
begin
|
||
if Action = cnRemoved then
|
||
Item.Free;
|
||
end;
|
||
|
||
function TThdDirWatchEntList.GetEntByTgDir(sTgDir: String): TThdDirWatchEnt;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := nil;
|
||
for i := 0 to Count - 1 do
|
||
if CompareText(Items[i].sTgDir_, sTgDir) = 0 then
|
||
begin
|
||
Result := Items[i];
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
{ TTgDirWatchBase }
|
||
|
||
Constructor TTgDirWatchBase.Create(bSubDir, bSync: Boolean);
|
||
begin
|
||
Inherited Create;
|
||
|
||
CS_ := TCriticalSection.Create;
|
||
|
||
dwFilter_ := DEFAULT_FILEWATCH_FILTER;
|
||
|
||
bSubDirWatch_ := bSubDir;
|
||
Processor_ := TThdProcDirWatchEnt.Create(bSync);
|
||
Processor_.OnProcessDirWatch := ProcessDirWatchEnt;
|
||
DcDirWatch_ := TDictionary<String,TThdDirWatchEnt>.Create;
|
||
DcDirWatch_.OnValueNotify := OnDirWatchNotify;
|
||
end;
|
||
|
||
Destructor TTgDirWatchBase.Destroy;
|
||
begin
|
||
StopWatch;
|
||
DcDirWatch_.Clear;
|
||
FreeAndNil(DcDirWatch_);
|
||
FreeAndNil(Processor_);
|
||
Inherited;
|
||
FreeAndNil(CS_);
|
||
end;
|
||
|
||
procedure TTgDirWatchBase.Lock;
|
||
begin
|
||
CS_.Acquire;
|
||
end;
|
||
|
||
procedure TTgDirWatchBase.Unlock;
|
||
begin
|
||
CS_.Release;
|
||
end;
|
||
|
||
procedure TTgDirWatchBase.OnDirWatchNotify(Sender: TObject; const Item: TThdDirWatchEnt;
|
||
Action: TCollectionNotification);
|
||
begin
|
||
if Action = cnRemoved then
|
||
Item.Free;
|
||
end;
|
||
|
||
procedure TTgDirWatchBase.SetFilter(dwFilter: DWORD);
|
||
var
|
||
enum: TEnumerator<TThdDirWatchEnt>;
|
||
begin
|
||
if dwFilter_ <> dwFilter then
|
||
begin
|
||
dwFilter_ := dwFilter;
|
||
Lock;
|
||
try
|
||
enum := DcDirWatch_.Values.GetEnumerator;
|
||
finally
|
||
Unlock;
|
||
end;
|
||
|
||
while enum.MoveNext do
|
||
enum.Current.Filter := dwFilter_;
|
||
enum.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTgDirWatchBase.AddDirWatch(sDir: String; bCoInit: Boolean = false);
|
||
var
|
||
ThdDirWatch: TThdDirWatchEnt;
|
||
begin
|
||
if DirectoryExists(sDir) then
|
||
begin
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
if not DcDirWatch_.ContainsKey(sDir) then
|
||
begin
|
||
ThdDirWatch := TThdDirWatchEnt.Create(Processor_,
|
||
sDir,
|
||
bSubDirWatch_,
|
||
dwFilter_, bCoInit);
|
||
if ThdDirWatch.LastError <> 0 then
|
||
begin
|
||
_Trace('Fail .. AddDirWatch() .. Error=%d', [ThdDirWatch.LastError], 1);
|
||
ThdDirWatch.Free;
|
||
exit;
|
||
end;
|
||
|
||
Lock;
|
||
try
|
||
DcDirWatch_.Add(UpperCase(sDir), ThdDirWatch);
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TTgDirWatchBase.DelDirWatch(sDir: String): Boolean;
|
||
begin
|
||
Result := false;
|
||
sDir := UpperCase(IncludeTrailingPathDelimiter(sDir));
|
||
Lock;
|
||
try
|
||
if DcDirWatch_.ContainsKey(sDir) then
|
||
begin
|
||
DcDirWatch_.Remove(sDir);
|
||
Result := true;
|
||
end;
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
function TTgDirWatchBase.ExistsDirWatch(sDir: String): Boolean;
|
||
begin
|
||
sDir := UpperCase(IncludeTrailingPathDelimiter(sDir));
|
||
Lock;
|
||
try
|
||
Result := DcDirWatch_.ContainsKey(sDir);
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
procedure TTgDirWatchBase.ClearDirWatch;
|
||
begin
|
||
Lock;
|
||
try
|
||
DcDirWatch_.Clear;
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
procedure TTgDirWatchBase.StartWatch;
|
||
begin
|
||
Processor_.StartThread;
|
||
end;
|
||
|
||
procedure TTgDirWatchBase.StopWatch;
|
||
begin
|
||
Processor_.Clear;
|
||
Processor_.PauseThread;
|
||
ClearDirWatch;
|
||
end;
|
||
|
||
{ TModFileList }
|
||
|
||
procedure TModFileList.Notify(const Item: PModFile; Action: TCollectionNotification);
|
||
begin
|
||
if Action = cnRemoved then
|
||
Dispose(Item);
|
||
end;
|
||
|
||
{ TModeFileComparer }
|
||
|
||
function TModeFileComparer.Compare(const Left, Right: PModFile): Integer;
|
||
begin
|
||
// Result := CompareDateTime(Left.dtModify, Right.dtModify);
|
||
Result := CompareDateTime(Right.dtModify, Left.dtModify); // <20>ֽż<D6BD>
|
||
end;
|
||
|
||
{ Function }
|
||
|
||
function GetFileSize_path(const sPath: String): LONGLONG;
|
||
var
|
||
sr: TSearchRec;
|
||
begin
|
||
Result := -1;
|
||
try
|
||
if FindFirst(sPath, faAnyFile, sr) = 0 then
|
||
begin
|
||
Result := sr.Size;
|
||
FindClose(sr);
|
||
end;
|
||
except
|
||
// ..
|
||
end;
|
||
end;
|
||
|
||
function GetFileSizeHiLow(dwHi, dwLow: DWORD): LONGLONG;
|
||
begin
|
||
Result := LONGLONG(LONGLONG(dwHi) * MAXDWORD) + dwLow;
|
||
end;
|
||
|
||
function GetFilesSizeFromDir(sDir: String; bSubDir: Boolean; pnCnt: PInteger = nil; sIgrKwd: String = ''): LONGLONG;
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
begin
|
||
Result := 0;
|
||
try
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
if sIgrKwd <> '' then
|
||
sIgrKwd := UpperCase(sIgrKwd);
|
||
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
if bSubDir then
|
||
Inc(Result, GetFilesSizeFromDir(sDir + wfd.cFileName, bSubDir, pnCnt, sIgrKwd));
|
||
end else begin
|
||
if (sIgrKwd = '') or (Pos(sIgrKwd, UpperCase(wfd.cFileName)) = 0) then
|
||
begin
|
||
Inc(Result, GetFileSizeHiLow(wfd.nFileSizeHigh, wfd.nFileSizeLow));
|
||
if pnCnt <> nil then
|
||
pnCnt^ := pnCnt^ + 1;
|
||
end;
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. GetFilesSizeFromDir()');
|
||
end;
|
||
end;
|
||
|
||
function MoveFile_wait(sSrcPath, sDecPath: String; nWaitSec: WORD = 10; bForce: Boolean = false): Boolean;
|
||
var
|
||
w: WORD;
|
||
begin
|
||
Result := false;
|
||
try
|
||
if FileExists(sSrcPath) and FileExists(sDecPath) then
|
||
begin
|
||
if bForce then
|
||
DeleteFile(sDecPath)
|
||
else exit;
|
||
end;
|
||
|
||
if DirectoryExists(sSrcPath) and DirectoryExists(sDecPath) then
|
||
begin
|
||
if bForce then
|
||
DeleteDir(sDecPath)
|
||
else exit;
|
||
end;
|
||
|
||
Result := true;
|
||
w := 0;
|
||
while not MoveFile(PChar(sSrcPath), PChar(sDecPath)) do
|
||
begin
|
||
Sleep(1000);
|
||
if w = nWaitSec then
|
||
begin
|
||
Result := false;
|
||
break;
|
||
end;
|
||
Inc(w);
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. MoveFile_wait()');
|
||
end;
|
||
end;
|
||
|
||
function DeleteFile_wait(sSrcPath: String; nWaitSec: Integer = 10): Boolean;
|
||
var
|
||
n: Integer;
|
||
begin
|
||
Result := true;
|
||
n := 0;
|
||
while FileExists(sSrcPath) and
|
||
not DeleteFile(PChar(sSrcPath)) do
|
||
begin
|
||
Sleep(1000);
|
||
if n = nWaitSec then
|
||
begin
|
||
Result := false;
|
||
exit;
|
||
end;
|
||
Inc(n);
|
||
end;
|
||
end;
|
||
|
||
function IsValidFilename(const sFName: String): Boolean;
|
||
begin
|
||
// \ / : * ? " < > |
|
||
Result := TPath.HasValidFileNameChars(sFName, false);
|
||
end;
|
||
|
||
function GetValidFileName(sFName: String; sRepStr: String = ''): String; inline;
|
||
var
|
||
sNoFileChars: String;
|
||
i: Integer;
|
||
begin
|
||
Result := sFName;
|
||
sNoFileChars := '\/:*?"<>|';
|
||
for i := 1 to Length(sNoFileChars) do
|
||
Result := ReplaceStr(Result, sNoFileChars[i], sRepStr);
|
||
end;
|
||
|
||
procedure ExtrFilesFromDir(sDir: String; aList: TStrings; bSubDir: Boolean = false; sFileExts: String = '');
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
begin
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
if sFileExts <> '' then
|
||
sFileExts := UpperCase(sFileExts);
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
if bSubDir then
|
||
ExtrFilesFromDir(sDir + wfd.cFileName, aList, bSubDir, sFileExts);
|
||
end else begin
|
||
if (sFileExts = '') or (Pos(GetFileExt(wfd.cFileName).ToUpper, sFileExts) <> 0) then
|
||
aList.Add(wfd.cFileName);
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
end;
|
||
|
||
procedure ExtrDirFromDir(sDir: String; aList: TStrings);
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
begin
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
aList.Add(wfd.cFileName);
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
end;
|
||
|
||
procedure ExtrFilesPathFromDir(sDir: String; aList: TStrings; bSubDir: Boolean = false; sFileExts: String = '');
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
begin
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
if sFileExts <> '' then
|
||
sFileExts := UpperCase(sFileExts);
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
if bSubDir then
|
||
ExtrFilesPathFromDir(sDir + wfd.cFileName, aList, bSubDir, sFileExts);
|
||
end else begin
|
||
if (sFileExts = '') or (Pos(GetFileExt(wfd.cFileName).ToUpper, sFileExts) <> 0) then
|
||
aList.Add(sDir + wfd.cFileName);
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
end;
|
||
|
||
procedure ExtrModFilesFromDir(sDir: String; aList: TModFileList; bSubDir: Boolean = false; sFileExts: String = '');
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
pEnt: PModFile;
|
||
begin
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
if sFileExts <> '' then
|
||
sFileExts := UpperCase(sFileExts);
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
if bSubDir then
|
||
ExtrModFilesFromDir(sDir + wfd.cFileName, aList, bSubDir, sFileExts);
|
||
end else begin
|
||
if (sFileExts = '') or (Pos(GetFileExt(wfd.cFileName).ToUpper, sFileExts) <> 0) then
|
||
begin
|
||
New(pEnt);
|
||
pEnt.sDir := sDir;
|
||
pEnt.sFName := wfd.cFileName;
|
||
pEnt.dtModify := ConvFileTimeToDateTime(wfd.ftLastWriteTime);
|
||
aList.Add(pEnt);
|
||
end;
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
end;
|
||
|
||
procedure DeleteDirSub(sDir: String; bIncludeSubDir: Boolean = true;
|
||
bForceDel: Boolean = false; aIgrList: TStringList = nil; bSafeDel: Boolean = false);
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
bOpen: Boolean;
|
||
begin
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
if aIgrList <> nil then
|
||
aIgrList.CaseSensitive := false;
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
if (aIgrList = nil) or
|
||
( (aIgrList.IndexOf(wfd.cFileName) = -1) and
|
||
(aIgrList.IndexOf(String(wfd.cFileName) + '\') = -1) ) then
|
||
DeleteDir(sDir + wfd.cFileName, bIncludeSubDir, bForceDel, aIgrList);
|
||
end else begin
|
||
if (aIgrList = nil) or (aIgrList.IndexOf(wfd.cFileName) = -1) then
|
||
begin
|
||
sPath := sDir + wfd.cFileName;
|
||
if bForceDel and
|
||
((wfd.dwFileAttributes and FILE_ATTRIBUTE_READONLY) <> 0) then
|
||
begin
|
||
// 22_0510 10:28:28 kku
|
||
SetFileAttributes(PChar(sPath), FILE_ATTRIBUTE_NORMAL);
|
||
end;
|
||
|
||
bOpen := false;
|
||
if bSafeDel then
|
||
begin
|
||
var fs: TFileStream := nil;
|
||
try
|
||
fs := TFileStream.Create(sPath, fmOpenReadWrite or fmShareExclusive);
|
||
fs.Free;
|
||
except
|
||
on E: EFOpenError do
|
||
bOpen := True;
|
||
on E: EInOutError do
|
||
bOpen := True;
|
||
end;
|
||
end;
|
||
|
||
if not bOpen then
|
||
DeleteFile(PChar(sPath));
|
||
end;
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
end;
|
||
|
||
function DeleteDir(sDir: String; bIncludeSubDir: Boolean = true;
|
||
bForceDel: Boolean = false; aIgrList: TStringList = nil): Boolean;
|
||
begin
|
||
DeleteDirSub(sDir, bIncludeSubDir, bForceDel, aIgrList);
|
||
Result := RemoveDir(sDir);
|
||
end;
|
||
|
||
function DeleteFileForce(sPath: String): Boolean;
|
||
begin
|
||
Result := DeleteFile(PChar(sPath));
|
||
if not Result then
|
||
begin
|
||
SetFileAttributes(PChar(sPath), FILE_ATTRIBUTE_NORMAL);
|
||
Result := DeleteFile(PChar(sPath));
|
||
end;
|
||
end;
|
||
|
||
function CopyDirSub(sSrcDir, sDestDir: String; bIncludeSubDir: Boolean = true): Boolean;
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
begin
|
||
Result := false;
|
||
|
||
try
|
||
sSrcDir := IncludeTrailingPathDelimiter(sSrcDir);
|
||
sDestDir := IncludeTrailingPathDelimiter(sDestDir);
|
||
|
||
sPath := sSrcDir + '*.*';
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
if not ForceDirectories(sDestDir) then
|
||
exit;
|
||
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
if not CopyDirSub(sSrcDir + wfd.cFileName, sDestDir + wfd.cFileName, bIncludeSubDir) then
|
||
exit;
|
||
end else begin
|
||
if FileExists(sDestDir + wfd.cFileName) then
|
||
DeleteFile(sDestDir + wfd.cFileName);
|
||
|
||
if not CopyFile(PChar(sSrcDir + wfd.cFileName),
|
||
PChar(sDestDir + wfd.cFileName), false) then
|
||
exit;
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
Result := true;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. CopyDirSub()');
|
||
end;
|
||
end;
|
||
|
||
procedure GetDirInfo(sDir: String; var dwDirCnt: DWORD; var dwFileCnt: DWORD; var llTotalSize: LONGLONG; bSubDir: Boolean = false);
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
begin
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
Inc(dwDirCnt);
|
||
if bSubDir then
|
||
GetDirInfo(sDir + wfd.cFileName, dwDirCnt, dwFileCnt, llTotalSize, bSubDir);
|
||
end else begin
|
||
Inc(dwFileCnt);
|
||
Inc(llTotalSize, GetFileSizeHiLow(wfd.nFileSizeHigh, wfd.nFileSizeLow));
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
end;
|
||
|
||
function CountFileExt(sDir: String; const arrExt: array of string; bIncSubDir: Boolean = false): Integer;
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sPath: String;
|
||
i: Integer;
|
||
begin
|
||
Result := 0;
|
||
|
||
sDir := IncludeTrailingPathDelimiter(sDir);
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
|
||
begin
|
||
if bIncSubDir then
|
||
Inc(Result, CountFileExt(sDir + wfd.cFileName, arrExt, bIncSubDir));
|
||
end else begin
|
||
for i := Low(arrExt) to High(arrExt) do
|
||
if CompareText(GetFileExt(wfd.cFileName), arrExt[i]) = 0 then
|
||
Inc(Result);
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
end;
|
||
|
||
function GetFileDateTime(const sPath: String; var ftCreate, ftModify, ftAccess: TFileTime): Boolean;
|
||
var
|
||
h: THandle;
|
||
begin
|
||
Result := false;
|
||
if FileExists(sPath) then
|
||
begin
|
||
h := FileOpen(sPath, fmOpenRead or fmShareDenyNone);
|
||
if h <> INVALID_HANDLE_VALUE then
|
||
begin
|
||
try
|
||
Result := GetFileTime(h, @ftCreate, @ftAccess, @ftModify);
|
||
finally
|
||
FileClose(h);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function GetFileDateTime(const sPath: String; var dtCreate, dtModify, dtAccess: TDateTime): Boolean;
|
||
var
|
||
ftCreate, ftAccess, ftModify: TFileTime;
|
||
begin
|
||
try
|
||
dtCreate := 0;
|
||
dtModify := 0;
|
||
dtAccess := 0;
|
||
|
||
Result := GetFileDateTime(sPath, ftCreate, ftModify, ftAccess);
|
||
if Result then
|
||
begin
|
||
dtCreate := ConvFileTimeToDateTime(ftCreate);
|
||
dtModify := ConvFileTimeToDateTime(ftModify);
|
||
dtAccess := ConvFileTimeToDateTime(ftAccess);
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
begin
|
||
Result := false;
|
||
ETgException.TraceException(E, 'Fail .. GetFileDateTime()');
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function GetFileDateTime_Local(const sPath: String; var dtCreate, dtModify, dtAccess: TDateTime): Boolean;
|
||
var
|
||
ftCreate, ftAccess, ftModify: TFileTime;
|
||
begin
|
||
Result := GetFileDateTime(sPath, ftCreate, ftModify, ftAccess);
|
||
if Result then
|
||
begin
|
||
dtCreate := ConvFileTimeToDateTime_Local(ftCreate);
|
||
dtModify := ConvFileTimeToDateTime_Local(ftModify);
|
||
dtAccess := ConvFileTimeToDateTime_Local(ftAccess);
|
||
end;
|
||
end;
|
||
|
||
function GetFileDateTime_Local(const sPath: String; var ftCreate, ftModify, ftAccess: TFileTime): Boolean; overload;
|
||
begin
|
||
Result := GetFileDateTime(sPath, ftCreate, ftModify, ftAccess);
|
||
if Result then
|
||
begin
|
||
WinApi.Windows.FileTimeToLocalFileTime(ftCreate, ftCreate);
|
||
WinApi.Windows.FileTimeToLocalFileTime(ftModify, ftModify);
|
||
WinApi.Windows.FileTimeToLocalFileTime(ftAccess, ftAccess);
|
||
end;
|
||
end;
|
||
|
||
function SetFileDateTime(const sPath: String; ftCreate, ftModify, ftAccess: TFileTime): Boolean;
|
||
var
|
||
h: THandle;
|
||
begin
|
||
Result := false;
|
||
try
|
||
if FileExists(sPath) then
|
||
begin
|
||
h := FileOpen(sPath, fmOpenWrite);
|
||
try
|
||
Result := SetFileTime(h, @ftCreate, @ftAccess, @ftModify);
|
||
finally
|
||
FileClose(h);
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. SetFileDateTime()');
|
||
end;
|
||
end;
|
||
|
||
function SetFileDateTime(const sPath: String; dtCreate, dtModify, dtAccess: TDateTime): Boolean;
|
||
begin
|
||
Result := SetFileDateTime(sPath, ConvDateTimeToFileTime(dtCreate),
|
||
ConvDateTimeToFileTime(dtModify),
|
||
ConvDateTimeToFileTime(dtAccess));
|
||
end;
|
||
|
||
function ConvFileAttrToStr(dwAttr: DWORD; bIncDir: Boolean = false): String;
|
||
begin
|
||
Result := '';
|
||
|
||
if (dwAttr and $01) <> 0 then
|
||
Result := 'R'; // <20>б<EFBFBD> <20><><EFBFBD><EFBFBD> (Read only)
|
||
if (dwAttr and $02) <> 0 then
|
||
Result := Result + 'H'; // <20><><EFBFBD><EFBFBD> (Hidden)
|
||
if (dwAttr and $04) <> 0 then
|
||
Result := Result + 'S'; // <20>ý<EFBFBD><C3BD><EFBFBD> (System)
|
||
if (dwAttr and $08) <> 0 then
|
||
Result := Result + 'V'; // FAT <20><><EFBFBD><EFBFBD> <20><><EFBFBD>̺<EFBFBD>. <20>ݵ<EFBFBD><DDB5> <20><>Ʈ<EFBFBD><C6AE> <20>ִ<EFBFBD>.
|
||
if bIncDir and ((dwAttr and $10) <> 0) then // <20><><EFBFBD>丮<EFBFBD><E4B8AE> <20>ϴ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ϴ°ɷ<C2B0>
|
||
Result := Result + 'D';
|
||
if bIncDir and ((dwAttr and $10000000) <> 0) then
|
||
Result := Result + 'D';
|
||
if (dwAttr and $20) <> 0 then
|
||
Result := Result + 'A'; // Archive
|
||
if (dwAttr and $40) <> 0 then
|
||
Result := Result + 'd'; // <20><>ġ (Device)
|
||
if (dwAttr and $80) <> 0 then
|
||
Result := Result + 'N'; // <20>˹<EFBFBD> (Normal)
|
||
if (dwAttr and $100) <> 0 then
|
||
Result := Result + 'T'; // <20>ӽ<EFBFBD><D3BD><EFBFBD><EFBFBD><EFBFBD> (Temp)
|
||
if (dwAttr and $200) <> 0 then
|
||
Result := Result + 'S'; // Sparese <20><><EFBFBD><EFBFBD>
|
||
if (dwAttr and $400) <> 0 then
|
||
Result := Result + 'P'; // Reparse Point
|
||
if (dwAttr and $800) <> 0 then
|
||
Result := Result + 'C'; // <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
if (dwAttr and $1000) <> 0 then
|
||
Result := Result + 'F'; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if (dwAttr and $2000) <> 0 then
|
||
Result := Result + 'X'; // <20>ε<EFBFBD><CEB5><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ƴ<EFBFBD> (NTFS)
|
||
if (dwAttr and $4000) <> 0 then
|
||
Result := Result + 'E'; // <20><>ȣȭ<C8A3><C8AD>
|
||
if (dwAttr and $20000000) <> 0 then
|
||
Result := Result + 'I'; // Index View
|
||
end;
|
||
|
||
function GetSameFileNameInc(sPath: String): String;
|
||
var
|
||
sDir, sFName, sExt: String;
|
||
nCnt: Integer;
|
||
begin
|
||
if not FileExists(sPath) then
|
||
begin
|
||
Result := sPath;
|
||
exit;
|
||
end;
|
||
|
||
sDir := ExtractFilePath(sPath);
|
||
if not DirectoryExists(sDir) then
|
||
begin
|
||
Result := sPath;
|
||
exit;
|
||
end;
|
||
|
||
sExt := GetFileExt(sPath);
|
||
sFName := CutFileExt(ExtractFileName(sPath));
|
||
nCnt := 1;
|
||
Result := sDir + Format('%s (%d).%s', [sFName, nCnt, sExt]);
|
||
while FileExists(Result) do
|
||
begin
|
||
Inc(nCnt);
|
||
Result := sDir + Format('%s (%d).%s', [sFName, nCnt, sExt]);
|
||
end;
|
||
end;
|
||
|
||
//function StringListCompareFileSize(List: TStringList; Index1, Index2: Integer): Integer;
|
||
//var
|
||
// ullSize1, ullSize2: ULONGLONG;
|
||
//begin
|
||
// if (Index1 >= 0) and (Index1 < List.Count) and
|
||
// (Index2 >= 0) and (Index2 < List.Count) then
|
||
// begin
|
||
// ullSize1 := GetFileSize_path(List[Index1]);
|
||
// ullSize2 := GetFileSize_path(List[Index2]);
|
||
// Result := CompareValue(ullSize1, ullSize2);
|
||
// end else
|
||
// Result := 0;
|
||
//end;
|
||
|
||
function StringListCompareFileCreateDate(List: TStringList; Index1, Index2: Integer): Integer;
|
||
var
|
||
ftCreate1, ftCreate2, ftModify, ftAccess: TFileTime;
|
||
begin
|
||
if (Index1 >= 0) and (Index1 < List.Count) and
|
||
(Index2 >= 0) and (Index2 < List.Count) then
|
||
begin
|
||
GetFileDateTime(List[Index1], ftCreate1, ftModify, ftAccess);
|
||
GetFileDateTime(List[Index2], ftCreate2, ftModify, ftAccess);
|
||
Result := CompareFileTime(ftCreate1, ftCreate2);
|
||
end else
|
||
Result := 0;
|
||
end;
|
||
|
||
function StringListCompareFileModifyDate(List: TStringList; Index1, Index2: Integer): Integer;
|
||
var
|
||
ftCreate, ftModify1, ftModify2, ftAccess: TFileTime;
|
||
begin
|
||
if (Index1 >= 0) and (Index1 < List.Count) and
|
||
(Index2 >= 0) and (Index2 < List.Count) then
|
||
begin
|
||
GetFileDateTime(List[Index1], ftCreate, ftModify1, ftAccess);
|
||
GetFileDateTime(List[Index2], ftCreate, ftModify2, ftAccess);
|
||
Result := CompareFileTime(ftModify1, ftModify2);
|
||
end else
|
||
Result := 0;
|
||
end;
|
||
|
||
function CheckSign(aStream: TStream; pBuf: Pointer; nLen: Integer): Boolean;
|
||
var
|
||
pData: TBytes;
|
||
begin
|
||
Result := false;
|
||
|
||
try
|
||
SetLength(pData, nLen);
|
||
|
||
aStream.Position := 0;
|
||
if aStream.Read(pData[0], nLen) <> nLen then
|
||
exit;
|
||
|
||
Result := CompareMem(@pData[0], pBuf, nLen);
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. CheckSign() .. 1');
|
||
end;
|
||
end;
|
||
|
||
function CheckSign(sPath: String; pBuf: Pointer; nLen: Integer): Boolean;
|
||
var
|
||
fs: TFileStream;
|
||
begin
|
||
Result := false;
|
||
try
|
||
Guard(fs, TFileStream.Create(sPath, fmOpenRead));
|
||
Result := CheckSign(fs, pBuf, nLen);
|
||
except
|
||
{$IFDEF DEBUG}
|
||
// <20>ǻ<EFBFBD><C7BB><EFBFBD><EFBFBD> <20>αװ<CEB1> <20>ʹ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. CheckSign() .. 2');
|
||
{$ENDIF}
|
||
end;
|
||
end;
|
||
|
||
function CheckSign(sPath: String; sSign: AnsiString): Boolean;
|
||
begin
|
||
Result := CheckSign(sPath, @sSign[1], Length(sSign));
|
||
end;
|
||
|
||
function CheckSignFromList(sPath: String; BinStrList: TStrings): Boolean;
|
||
var
|
||
arrBufs: array of TBytes;
|
||
i, nLen, nMaxLen: Integer;
|
||
pData: TBytes;
|
||
fs: TFileStream;
|
||
begin
|
||
Result := false;
|
||
try
|
||
if BinStrList.Count = 0 then
|
||
exit;
|
||
|
||
nMaxLen := 0;
|
||
SetLength(arrBufs, BinStrList.Count);
|
||
for i := 0 to BinStrList.Count - 1 do
|
||
begin
|
||
nLen := ConvStrToBin(BinStrList[i], arrBufs[i]);
|
||
if nLen > nMaxLen then
|
||
nMaxLen := nLen;
|
||
end;
|
||
|
||
if nMaxLen = 0 then
|
||
exit;
|
||
|
||
SetLength(pData, nMaxLen);
|
||
Guard(fs, TFileStream.Create(sPath, fmOpenRead));
|
||
nMaxLen := fs.Read(pData[0], nMaxLen);
|
||
|
||
for i := 0 to High(arrBufs) do
|
||
begin
|
||
nLen := Length(arrBufs[i]);
|
||
if nLen > nMaxLen then
|
||
nLen := nMaxLen;
|
||
|
||
if CompareMem(arrBufs[i], pData, nLen) then
|
||
begin
|
||
Result := true;
|
||
exit;
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. CheckSignFromList() ..', 3);
|
||
end;
|
||
end;
|
||
|
||
function CopyFileAfOpenCheck(sSrcPath, sDestPath: String; nTOSec: Integer = 5): Boolean;
|
||
var
|
||
fs: TFileStream;
|
||
dwTick: DWORD;
|
||
bFail: Boolean;
|
||
Label
|
||
LB_Retry;
|
||
begin
|
||
Result := false;
|
||
if CopyFile(PChar(sSrcPath), PChar(sDestPath), false) then
|
||
begin
|
||
nTOSec := nTOSec * 1000;
|
||
dwTick := GetTickCount;
|
||
bFail := false;
|
||
|
||
LB_Retry :
|
||
try
|
||
Guard(fs, TFileStream.Create(sDestPath, fmOpenRead));
|
||
except
|
||
bFail := true;
|
||
end;
|
||
|
||
if bFail then
|
||
begin
|
||
if (GetTickCount - dwTick) < nTOSec then
|
||
begin
|
||
Sleep(200);
|
||
goto LB_Retry;
|
||
end else exit;
|
||
end;
|
||
|
||
Result := true;
|
||
end;
|
||
end;
|
||
|
||
type
|
||
TJmpDestInfo = packed record
|
||
dwVersion: DWORD;
|
||
arrUnknown: array [0..27] of Byte;
|
||
end;
|
||
|
||
TJmpDestH = packed record
|
||
sCheckSum: array [0..7] of AnsiChar; // 가리키고 있는 Stream의 Check Sum 값이 저장되어 있다.
|
||
VolDroidId, // Volume Droid ID
|
||
FileDroidId, // File Droid ID
|
||
BrhVolDroidId, // Birth volume Droid ID
|
||
BrhFileDroidId: TGUID; // Birth file Droid ID
|
||
sHostName: array [0..15] of AnsiChar; // 해당 Stream이 생성 된 컴퓨터 이름이 저장 된다.
|
||
end;
|
||
|
||
PJmpDestM78 = ^TJmpDestM78; // Windows 7, 8 용 중간 데이터
|
||
TJmpDestM78 = packed record
|
||
llSeq: LONGLONG; // 가리키고 있는 Stream의 이름이 저장 된다.
|
||
fCount: Single; // Stream의 접근 횟수를 부동소수점으로 표현한 값을 저장하고 있다.
|
||
ftLastAccess: TFileTime; // Stream의 마지막 수정 시간을 저장하고 있다.
|
||
end;
|
||
|
||
PJmpDestM10 = ^TJmpDestM10; // Windows 10 용 중간 데이터
|
||
TJmpDestM10 = packed record
|
||
dwSeq: DWORD;
|
||
llUnDefined: LONGLONG; // In all test ‘0x00 0x00 0x00 0x00’
|
||
ftLastAccess: TFileTime; // Stream의 마지막 수정 시간을 저장하고 있다.
|
||
end;
|
||
|
||
TJmpDestT78 = packed record // Windows 7, 8 용 끝 데이터
|
||
dwPin: DWORD;
|
||
wUniStrLen: WORD;
|
||
end;
|
||
|
||
TJmpDestT10 = packed record // Windows 10 용 끝 데이터
|
||
dwPin: DWORD;
|
||
dwUnDefined1: DWORD; // In all tests, ‘0xFF 0xFF 0xFF 0xFF’
|
||
dwCount: DWORD;
|
||
llUnDefined2: LONGLONG; // In all test ‘0x00 0x00 0x00 0x00’
|
||
wUniStrLen: WORD;
|
||
end;
|
||
|
||
function GetLastOpenFileFromJumpListAuto(const sJmpAutoPath: String): String;
|
||
var
|
||
ms: TMemoryStream;
|
||
stg: TGSStorage;
|
||
stgRoot: TGSStorageCursor;
|
||
enum: TGSStorageEnum;
|
||
i: Integer;
|
||
|
||
DestInfo: TJmpDestInfo;
|
||
DestH: TJmpDestH;
|
||
DestM: array [0..19] of Byte;
|
||
DestT78: TJmpDestT78;
|
||
DestT10: TJmpDestT10;
|
||
sTemp: array of Char;
|
||
wUniStrLen: WORD;
|
||
begin
|
||
Result := '';
|
||
try
|
||
if FileExists(sJmpAutoPath) then
|
||
begin
|
||
if GetFileExt(sJmpAutoPath).ToUpper <> 'AUTOMATICDESTINATIONS-MS' then
|
||
exit;
|
||
|
||
Guard(stg, TGSStorage.Create);
|
||
if stg.OpenFile(sJmpAutoPath, false, stgRoot) <> S_OK then
|
||
exit;
|
||
|
||
if stgRoot.Enumerate(enum) <> S_OK then
|
||
exit;
|
||
|
||
try
|
||
for i := 0 to enum.Count - 1 do
|
||
begin
|
||
if CompareText('DestList', enum.ElementEnum[i].pwcsName) <> 0 then
|
||
continue;
|
||
|
||
Guard(ms, TMemoryStream.Create);
|
||
try
|
||
stgRoot.ReadStream(enum.ElementEnum[i].pwcsName, ms);
|
||
except
|
||
exit;
|
||
end;
|
||
|
||
if ms.Read(DestInfo, SizeOf(DestInfo)) <> SizeOf(DestInfo) then
|
||
exit;
|
||
|
||
while ms.Size > ms.Position do
|
||
begin
|
||
if ms.Read(DestH, SizeOf(DestH)) <> SizeOf(DestH) then
|
||
break;
|
||
|
||
if ms.Read(DestM, 20) <> 20 then
|
||
break;
|
||
|
||
if DestInfo.dwVersion >= 4 then // Windows 7은 1, 10은 4로 보이는데...
|
||
begin
|
||
// Windows 10
|
||
// Header.llSeq := PJmpDestM10(@DestM[0]).dwSeq;
|
||
// Header.ftLastAccess := PJmpDestM10(@DestM[0]).ftLastAccess;
|
||
|
||
if ms.Read(DestT10, SizeOf(DestT10)) <> SizeOf(DestT10) then
|
||
break;
|
||
|
||
// Header.fCount := DestT10.dwCount;
|
||
wUniStrLen := DestT10.wUniStrLen;
|
||
end else begin
|
||
// Windows 7, 8
|
||
// Header.llSeq := PJmpDestM78(@DestM[0]).llSeq;
|
||
// Header.fCount := PJmpDestM78(@DestM[0]).fCount;
|
||
// Header.ftLastAccess := PJmpDestM78(@DestM[0]).ftLastAccess;
|
||
|
||
if ms.Read(DestT78, SizeOf(DestT78)) <> SizeOf(DestT78) then
|
||
break;
|
||
|
||
// if DestT78.dwPin <> $FFFFFFFF then
|
||
// break;
|
||
|
||
wUniStrLen := DestT78.wUniStrLen;
|
||
end;
|
||
|
||
if (wUniStrLen > 0) and (wUniStrLen <> WORD(-1)) then
|
||
begin
|
||
SetLength(sTemp, wUniStrLen + 1);
|
||
ms.Read(sTemp[0], wUniStrLen * 2);
|
||
sTemp[wUniStrLen] := #0;
|
||
Result := PChar(@sTemp[0]);
|
||
|
||
if DestInfo.dwVersion > 1 then
|
||
ms.Position := ms.Position + 4;
|
||
|
||
exit;
|
||
end;
|
||
end;
|
||
end;
|
||
finally
|
||
stgRoot.FreeMemAfterEnum(enum);
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. GetRecentOpenFileFromJumpListAuto()');
|
||
end;
|
||
end;
|
||
|
||
end.
|