xfiles.pas

关于c++ builder编程的很好的资料

unit xFiles;

interface

uses SysUtils, Windows, ShellAPI, Forms, Classes, Math, ActiveX, ComObj, Dialogs;

type
  TEnumDirectoryFileProc = procedure (Filename: string; Attr: Integer; UserData: Integer; var bContinue: Boolean) of object;
  
function PathWithoutSlash(const Path: string; PathDelimiter: Char = '\'): string;
function PathWithSlash(const Path: string; PathDelimiter: Char = '\'): string;
function RelativePath(BaseDir, FilePath: string; PathDelimiter: Char = '\'): string;
function BelongToPath(BaseDir, FilePath: string; PathDelimiter: Char = '\'): Boolean;
function Slashize(const Path: string; PathDelimiter: Char = '\'): string;

function MyExtractFileName(const Filename: string; PathDelimiter: Char = '\'): string;
function MyExtractFilePath(const Filename: string; PathDelimiter: Char = '\'): string;

function MyShellExecute(const sAction, sFileName, sPara: string): Boolean;
function Execute(const Command: string; bWaitExecute: Boolean; bShowWindow: Boolean; PI: PProcessInformation): Boolean;
function MyFindExecutable(const Filename: string): string;

function ExtractFileNameNoExt(Filename: string): string;
function MyGetFileSize(const Filename: string): DWORD;
function MyCopyFile(const sSrcFile, sDstFile: string): Boolean;
function MyGetFileDateTime(const Filename: string): TDateTime;

function TruncateTrailNumber(var S: string): Integer;
function TruncateTrailIfNotDLL(S: string): string;
function FileExistsAfterTruncate(Filename: string): Boolean;

function TruncateDirSpecifier(const Path: string): string;

function ComparePath(const Path1, Path2: string): Boolean;
function ParentDirectory(Path: string): string;

function SystemDirFile(const Filename: string): string;
function WindowsDirFile(const Filename: string): string;
function SystemDriveFile(const Filename: string): string;
function TempDirFile(const Filename: string): string;

procedure EnumDirectoryFiles(sDir, sMask: string; Attr: Integer; bRecursive: Boolean; UserData: Integer; EnumDirectoryFileProc: TEnumDirectoryFileProc);
procedure CleanDirectory(sDir: string);
procedure CopyDirectory(sDir, tDir: string; bRecursive: Boolean);
procedure GetDirectoryFiles(sDir, sMask: string; bRecursive: Boolean; FileAttr: Integer; SL: TStrings);

function GetUniqueFileName(Filename: string): string;
function GetTemporaryFileName(Prefix: string = ''): string;
function GetGUIDFileName(Ext: string = ''): string;

function GetSystemPath: string;
function GetWindowsPath: string;
function GetTemporaryPath: string;

function GetRootDir(var sPath: string): string;
function GetLeafDir(var sPath: string): string;

function IsFileLocked(Filename: string): Boolean;
function CheckFileExtension(Filename: string; Extensions: array of string): Boolean;

function GetShortFilename(const Filename: string): string;

var
  AppDir: string;
  
implementation

uses xUtils, Filectrl, xStrings;

function PathWithoutSlash(const Path: string; PathDelimiter: Char = '\'): string;
begin
  if (Length(Path) > 0) and (Path[Length(Path)] = PathDelimiter) then
    Result := Copy(Path, 1, Length(Path) - 1)
  else
    Result := Path;
end;

function PathWithSlash(const Path: string; PathDelimiter: Char = '\'): string;
begin
  Result := Path;
  if (Length(Result) > 0) and (Result[Length(Result)] <> PathDelimiter) then
    AppendStr(Result, PathDelimiter);
end;

function RelativePath(BaseDir, FilePath: string; PathDelimiter: Char = '\'): string;
var
  I, MaxMatchLen: Integer;
begin
  BaseDir := PathWithSlash(BaseDir, PathDelimiter);
  
  if BelongToPath(BaseDir, FilePath, PathDelimiter) then
    Result := Copy(FilePath, Length(BaseDir) + 1, Maxint)
  else
  begin
    MaxMatchLen := Min(Length(BaseDir), Length(FilePath));
    while CompareText(Copy(BaseDir, 1, MaxMatchLen), Copy(FilePath, 1, MaxMatchLen)) <> 0 do
      dec(MaxMatchLen);
    
    Delete(BaseDir, 1, MaxMatchLen);
    Delete(FilePath, 1, MaxMatchLen);
    
    Result := '';
    for I := 1 to CountWords(BaseDir, '/') do
      Result := Result + '../';
    
    Result := Result + FilePath;
  end;
end;

function BelongToPath(BaseDir, FilePath: string; PathDelimiter: Char = '\'): Boolean;
begin
  BaseDir := AnsiUpperCaseFileName(PathWithSlash(BaseDir, PathDelimiter));
  FilePath := AnsiUpperCaseFileName(FilePath);
  
  Result := Copy(FilePath, 1, Length(BaseDir)) = BaseDir;
end;

function Slashize(const Path: string; PathDelimiter: Char = '\'): string;
var
  CounterPathDelimiters: array[Char] of Char;
var
  I: Integer;
begin
  CounterPathDelimiters['\'] := '/';
  CounterPathDelimiters['/'] := '\';
  
  Result := Path;
  for I := 1 to Length(Result) do
    if Result[I] = CounterPathDelimiters[PathDelimiter] then
      Result[I] := PathDelimiter;
end;

function MyShellExecute(const sAction, sFileName, sPara: string): Boolean;
begin
  Result := ShellExecute(Application.Handle, PChar(sAction), PChar(sFileName), PChar(sPara), PChar(''), SW_SHOW) > 32;
end;

function Execute(const Command: string; bWaitExecute: Boolean; bShowWindow: Boolean; PI: PProcessInformation): Boolean;
var
  StartupInfo       : TStartupInfo;       
  ProcessInformation: TProcessInformation;
begin
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    if bShowWindow then
      wShowWindow := SW_NORMAL
    else
      wShowWindow := SW_HIDE;
  end;
  
  Result := CreateProcess(nil, PChar(Command),
    nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil,
    StartupInfo, ProcessInformation);
  
  if not Result then Exit;
  
  if bWaitExecute then
    WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
  
  if Assigned(PI) then
    Move(ProcessInformation, PI^, SizeOf(ProcessInformation));
end;

function ExtractFileNameNoExt(Filename: string): string;
begin
  Filename := ExtractFileName(Filename);
  Result := Copy(Filename, 1, Length(Filename) - Length(ExtractFileExt(Filename)));
end;

function MyGetFileSize(const Filename: string): DWORD;
var
  HFILE: THandle;
begin
  HFILE := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if HFILE <> INVALID_HANDLE_VALUE then
  begin
    Result := GetFileSize(HFILE, nil);
    CloseHandle(HFILE);
  end else
    Result := 0;
end;

function MyCopyFile(const sSrcFile, sDstFile: string): Boolean;
begin
  if AnsiCompareFileName(sSrcFile, sDstFile) <> 0 then
    Result := CopyFile(PChar(sSrcFile), PChar(sDstFile), False)
  else
    Result := True;
end;

function GetTemporaryFileName(Prefix: string = ''): string;
var
  Buf, PathBuf: array[0..255] of Char;
begin
  if Prefix = '' then Prefix := ExtractFileNameNoExt(Application.ExeName);
  if Prefix = '' then Prefix := IntToStr(GetCurrentProcessId);
  
  GetTempPath(255, @PathBuf);
  
  GetTempFileName(PathBuf, PChar(Prefix), 0, @Buf);
  DeleteFile(Buf);
  Result := StrPas(@Buf);
end;

function TruncateTrailNumber(var S: string): Integer;
var
  I: Integer;
begin
  Result := -1;
  
  I := Pos(',', S);
  if I <> 0 then
  begin
    Result := StrToIntDef(Copy(S, I + 1, Length(S)), - 1);
    Delete(S, I, Length(S));
  end;
end;

function TruncateTrailIfNotDLL(S: string): string;
begin
  Result := S;
  TruncateTrailNumber(S);
  
  if (CompareText(ExtractFileExt(S), '.DLL') <> 0) and
    (CompareText(ExtractFileExt(S), '.ICL') <> 0) and
    (CompareText(ExtractFileExt(S), '.EXE') <> 0) then Result := S;
end;

function FileExistsAfterTruncate(Filename: string): Boolean;
begin
  TruncateTrailNumber(Filename);
  Result := FileExists(Filename);
end;

function TruncateDirSpecifier(const Path: string): string;
var
  I1, I2: Integer;
begin
  Result := Path;
  
  I1 := AnsiPos('%', Path);
  I2 := AnsiPos('%', Copy(Path, I1 + 1, Length(Path)));
  if (I1 = 0) or (I2 = 0) then Exit;
  
  Result := Copy(Path, I2 + I1 + 1, Length(Path));
end;

function ParentDirectory(Path: string): string;
var
  iLastAntiSlash: Integer;
  
  function CountAntiSlash: Integer;
  var
    I: Integer;
  begin
    Result := 0;
    I := 1;
    repeat
      if IsDBCSLeadByte(Ord(Path[I])) then
        Inc(I, 2)
      else
      begin
        if Path[I] = '\' then
        begin
          iLastAntiSlash := I;
          Inc(Result);
        end;
        Inc(I);
      end;
    until I > Length(Path);
  end;
  
  function UpOneDirectory: string;
  begin
    Result := Copy(Path, 1, iLastAntiSlash); // with slash
  end;
  
begin
  // 'c:\windows\system\' => 'c:\window\'
  // 'f:\' => 'f:\'
  // '\\xshadow\f\fonts' => '\\xshadow\f\'
  // '\\xshadow\f\' => '\\xshadow\f\'
  Path := PathWithoutSlash(Path);
  
  if Length(Path) > 3 then
  begin
    if (Path[1] = '\') and (Path[2] = '\') then // UNC path
    begin
      if CountAntiSlash > 3 then
        Result := UpOneDirectory;
    end else
    begin
      if CountAntiSlash > 1 then
        Result := UpOneDirectory;
    end;
  end else Result := Path;
end;

function SystemDirFile(const Filename: string): string;
var
  Buf: array[0..255] of Char;
begin
  GetSystemDirectory(@Buf, 255);
  Result := PathWithSlash(StrPas(@Buf)) + Filename;
end;

function WindowsDirFile(const Filename: string): string;
var
  Buf: array[0..255] of Char;
begin
  GetWindowsDirectory(@Buf, 255);
  Result := PathWithSlash(StrPas(@Buf)) + Filename;
end;

function SystemDriveFile(const Filename: string): string;
var
  Buf: array[0..255] of Char;
begin
  GetSystemDirectory(@Buf, 255);
  Result := PathWithSlash(ExtractFileDrive(StrPas(@Buf))) + Filename;
end;

function ComparePath(const Path1, Path2: string): Boolean;
begin
  Result := AnsiCompareFileName(PathWithoutSlash(Path1), PathWithoutSlash(Path2)) = 0;