Uses SysUtils;
//取檔案名稱
//Ex: C:\Test\NoName.txt -> NoName.txt
function
ExtractFileName(const FileName: string): string;
//取檔案副檔名
//Ex: C:\Test\NoName.txt -> .txt
function
ExtractFileExt(const FileName: string): string;
//取檔案所在磁碟代號
//Ex: C:\Test\NoName.txt -> C:
function
ExtractFileDrive(const FileName: string): string;
//取檔案路徑
//Ex: C:\Test\NoName.txt -> C:\Test\
function
ExtractFilePath(const FileName: string): string;
//取檔案目錄
//Ex: C:\Test\NoName.txt -> C:\Test
function
ExtractFileDir(const FileName: string): string;
//變更副檔案名稱
//Ex: C:\Test\NoName.txt -> C:\Test\NoName.xxx
function
ChangeFileExt(const FileName, Extension: string): string;
//取得檔案目錄路徑 (目錄後面加斜線符號)
//Ex: C:\Test -> C:\Test\
function
IncludeTrailingPathDelimiter(const S: string): string;
function
IncludeTrailingBackslash(const S: string): string;
//取得檔案目錄路徑 (目錄後面去除斜線符號)
//Ex: C:\Test\ -> C:\Test
function
ExcludeTrailingPathDelimiter(const S: string): string;
function
ExcludeTrailingBackslash(const S: string): string;
//檢查檔案是否存在
function
FileExists(const FileName: string): Boolean;
//檢查目錄是否存在
function
DirectoryExists(const Directory: string): Boolean;
//產生多層資料夾
//Ex: ForceDirectories('c:\a\b\c')
function
ForceDirectories(Dir: string): Boolean;
//檢查檔案是否唯讀
function
FileIsReadOnly(const FileName: string): Boolean;
//取得檔案屬性
function
FileGetAttr(const FileName: string): Integer;
//設定檔案屬性
function
FileSetAttr(const FileName: string; Attr: Integer): Integer;
//設定唯讀檔案
function
FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean;
//刪除檔案
function
DeleteFile(const FileName: string): Boolean;
//變更檔案名稱
function
RenameFile(const OldName, NewName: string): Boolean;
//取得磁碟空間
function
DiskSize(Drive: Byte): Int64;
//取得目前所在目錄
function
GetCurrentDir: string;
//設定目前所在目錄
function
SetCurrentDir(const Dir: string): Boolean;
//建立目錄
function
CreateDir(const Dir: string): Boolean;
//移除目錄
function
RemoveDir(const Dir: string): Boolean;
//----------------------------------------------------------------------------------------------------------------
//取檔案日期
//----------------------------------------------------------------------------------------------------------------
function
fn_Get_FileDatetime(AFileName:String):TDatetime;
var
iFileAag:Integer;
begin
iFileAag := FileAge(AFileName);
Result := FileDateToDatetime(iFileAge);
end;
//----------------------------------------------------------------------------------------------------------------
//取檔案清單
//----------------------------------------------------------------------------------------------------------------
function
fn_Get_FileList(APath:String; AFullPath:Boolean=False; ASearchSubPath:Boolean=False):TStringList;
var SearchRec: TSearchRec;
Status: Integer;
sFileList:TStringList;
sPath:String;
begin
sPath := '';
if AFullPath then
sPath := IncludeTrailingPathDelimiter
(APath); // Ex: C:\temp -> C:\temp\
sFileList := TStringList.Create;
Status := FindFirst(APath+'\*.*', faAnyFile, SearchRec);
try
while Status = 0 do
begin
if ((SearchRec.Attr and faHidden)<>faHidden) and //非隱藏檔
((SearchRec.Attr and faSysFile)<>faSysFile) and //非系統檔
(SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
begin
if ((SearchRec.Attr and faDirectory) = faDirectory) then //目錄
begin
if ASearchSubPath then
sFileList.AddStrings(fn_Get_FileList(APath+'\'+SearchRec.Name, AFullPath, ASearchSubPath))
end
else
sFileList.Add(sPath+SearchRec.Name);
end;
Status := FindNext(SearchRec);
end;
Finally
FindClose(SearchRec);
end;
Result := sFileList;
end;
//----------------------------------------------------------------------------------------------------------------
//檔案被使用中
//----------------------------------------------------------------------------------------------------------------
function
fn_FileInUse(fName: string): boolean;
var
HFileRes: HFILE;
begin
Result := false;
if not FileExists(fName) then
exit;
HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;
//----------------------------------------------------------------------------------------------------------------
//建立資料夾
//----------------------------------------------------------------------------------------------------------------
procedure
pr_CreateDir(ADir:String);
var sFolderList:TStringList;
sDrive, sFolder:String;
i:Integer;
begin
sFolderList := TStringList.Create;
ADir := ExcludeTrailingPathDelimiter(ADir); //Ex: C:\Temp\A\1\ -> C:\Temp\A\1
sDrive := ExtractFileDrive(ADir)+'\'; //Ex: C:\
//
sFolderList.Add(ADir);
sFolder := ADir;
while True do
begin
sFolder := ExtractFileDir(sFolder);
if sFolder=sDrive then
Break;
sFolderList.Insert(0, sFolder);
end;
//
for i:=0 to sFolderList.Count-1 do
begin
if not DirectoryExists(sFolderList[i]) then
CreateDir(sFolderList[i]);
end;
FreeAndNil(sFolderList);
end;
//----------------------------------------------------------------------------------------------------------------
//檔案複製/搬移 (含子資料夾)
//----------------------------------------------------------------------------------------------------------------
procedure
pr_CopyFile(ASourceFile, ATargetPath:String; ASearchSubPath:Boolean=False; AMoveFile:Boolean=False);
var SearchRec: TSearchRec;
Status: Integer;
sSourcePath, sTargetPath, sTargetDir,
sSearchFileName, sTargetFileName, sFileName:String;
begin
sFileName := ExtractFileName(ASourceFile);
sSourcePath := ExtractFilePath(ASourceFile);
sTargetPath := IncludeTrailingPathDelimiter(ATargetPath);
sTargetDir := ExcludeTrailingPathDelimiter(ATargetPath);
if CompareText(sSourcePath, sTargetPath)=0 then
Exit;
//
pr_CreateDir(sTargetDir); //建立目的資料夾
//
Status := FindFirst(ASourceFile, faAnyFile, SearchRec);
try
while Status = 0 do
begin
if ((SearchRec.Attr and faHidden)<>faHidden) and //非隱藏檔
((SearchRec.Attr and faSysFile)<>faSysFile) and //非系統檔
(SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
begin
sSearchFileName := sSourcePath + SearchRec.Name;
if ((SearchRec.Attr and faDirectory) = faDirectory) then //目錄
begin
if ASearchSubPath then
begin
if CompareText(sSearchFileName, sTargetDir)<>0 then
begin
pr_CopyFile(sSearchFileName+'\'+sFileName, sTargetPath+SearchRec.Name, ASearchSubPath);
end;
end;
end
else if not fn_FileInUse(sSearchFileName) then
begin
sTargetFileName := sTargetPath + SearchRec.Name;
if AMoveFile then
MoveFile(PWideChar(sSearchFileName), PWideChar(sTargetFileName)) //搬移
else
CopyFile(PWideChar(sSearchFileName), PWideChar(sTargetFileName), False); //複製
end;
end;
Status := FindNext(SearchRec);
end;
Finally
FindClose(SearchRec);
end;
end;
//----------------------------------------------------------------------------------------------------------------
//檔案版本 FileVersion
//----------------------------------------------------------------------------------------------------------------
function GetFileVersion(const FileName: string): string;
var
Size, Handle: DWORD;
Buffer: Pointer;
FileInfo: PVSFixedFileInfo;
FileInfoSize: UINT;
Major, Minor, Release, Build: WORD;
begin
Result := '';
Size := GetFileVersionInfoSize(PChar(FileName), Handle);
if Size = 0 then Exit;
GetMem(Buffer, Size);
try
if GetFileVersionInfo(PChar(FileName), Handle, Size, Buffer) then
begin
if VerQueryValue(Buffer, '\', Pointer(FileInfo), FileInfoSize) then
begin
Major := HiWord(FileInfo.dwFileVersionMS);
Minor := LoWord(FileInfo.dwFileVersionMS);
Release := HiWord(FileInfo.dwFileVersionLS);
Build := LoWord(FileInfo.dwFileVersionLS);
Result := Format('%d.%d.%d.%d', [Major, Minor, Release, Build]);
end;
end;
finally
FreeMem(Buffer);
end;
end;
//----------------------------------------------------------------------------------------------------------------
//檔案版本 ProductVersion
//----------------------------------------------------------------------------------------------------------------
function GetProductVersion(const FileName: string): string;
var
Size, Handle: DWORD;
Buffer: Pointer;
FileInfo: PVSFixedFileInfo;
FileInfoSize: UINT;
VersionPointer: Pointer;
VersionSize: UINT;
VersionStr: string;
begin
Result := '';
Size := GetFileVersionInfoSize(PChar(FileName), Handle);
if Size = 0 then Exit;
GetMem(Buffer, Size);
try
if GetFileVersionInfo(PChar(FileName), Handle, Size, Buffer) then
begin
// Get the product version string
if VerQueryValue(Buffer, '\StringFileInfo\040904E4\ProductVersion', VersionPointer, VersionSize) then
begin
SetString(VersionStr, PChar(VersionPointer), VersionSize - 1);
Result := VersionStr;
end;
end;
finally
FreeMem(Buffer);
end;
end;
