檔案文件相關的函式

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;