{*******************************************************} { } { 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 �����δ� ���� ����� �� ����� ijġ ���ؼ� �߰���. 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 bCoInit_: Boolean; qDirWatchEntry_: TQueue; evDirWatchNotification_: TEvDirWatchNotification; protected procedure OnDirWatchNotify(Sender: TObject; const Item: PDirWatchEnt; Action: TCollectionNotification); procedure Execute; override; public Constructor Create(bSync: Boolean; bProcCoInit: 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) 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; 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; bProcCoInit: Boolean = false); 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) protected procedure Notify(const Item: PModFile; Action: TCollectionNotification); override; end; TModeFileComparer = class(TComparer) 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; bProcCoInit: Boolean); begin Inherited Create; bCoInit_ := bProcCoInit; {$IFDEF TRACE1} _Trace('Process DirWatch Begin ...'); {$ENDIF} qDirWatchEntry_ := TQueue.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 if bCoInit_ then CoInitialize(nil); 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; if bCoInit_ then CoUninitialize; 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; bProcCoInit: Boolean = false); begin Inherited Create; CS_ := TCriticalSection.Create; dwFilter_ := DEFAULT_FILEWATCH_FILTER; bSubDirWatch_ := bSubDir; Processor_ := TThdProcDirWatchEnt.Create(bSync, bProcCoInit); Processor_.OnProcessDirWatch := ProcessDirWatchEnt; DcDirWatch_ := TDictionary.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; 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); // �ֽż� 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'; // �б� ���� (Read only) if (dwAttr and $02) <> 0 then Result := Result + 'H'; // ���� (Hidden) if (dwAttr and $04) <> 0 then Result := Result + 'S'; // �ý��� (System) if (dwAttr and $08) <> 0 then Result := Result + 'V'; // FAT ���� ���̺�. �ݵ�� ��Ʈ�� �ִ�. if bIncDir and ((dwAttr and $10) <> 0) then // ���丮�� �ϴ� �����ϴ°ɷ� 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'; // ��ġ (Device) if (dwAttr and $80) <> 0 then Result := Result + 'N'; // �˹� (Normal) if (dwAttr and $100) <> 0 then Result := Result + 'T'; // �ӽ����� (Temp) if (dwAttr and $200) <> 0 then Result := Result + 'S'; // Sparese ���� if (dwAttr and $400) <> 0 then Result := Result + 'P'; // Reparse Point if (dwAttr and $800) <> 0 then Result := Result + 'C'; // ����� if (dwAttr and $1000) <> 0 then Result := Result + 'F'; // �������� if (dwAttr and $2000) <> 0 then Result := Result + 'X'; // �ε����� ��� ������ �ƴ� (NTFS) if (dwAttr and $4000) <> 0 then Result := Result + 'E'; // ��ȣȭ�� 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} // �ǻ���� �αװ� �ʹ� ���� ���� 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.