xfiles.pas

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

end;

procedure EnumDirectoryFiles(sDir, sMask: string; Attr: Integer; bRecursive: Boolean; UserData: Integer; EnumDirectoryFileProc: TEnumDirectoryFileProc);
var
  SearchRec: TSearchRec;
  Status   : Integer;   
  bContinue: Boolean;   
begin
  sDir := PathWithSlash(sDir);
  
  // traverse child directories
  if bRecursive then
  begin
    Status := FindFirst(sDir + '*.*', faDirectory, SearchRec);
    try
      while Status = 0 do
      begin
        if (SearchRec.Attr and faDirectory <> 0) and (SearchRec.name <> '.') and (SearchRec.name <> '..') then
          EnumDirectoryFiles(sDir + SearchRec.name, sMask, Attr, bRecursive, UserData, EnumDirectoryFileProc);
        
        Status := FindNext(SearchRec);
      end;
    finally
      SysUtils.FindClose(SearchRec);
    end;
  end;
  
  // exam each valid file and invoke the callback func
  Status := FindFirst(sDir + sMask, faAnyFile and not faVolumeID, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory <> 0) and ((SearchRec.name = '.') or (SearchRec.name = '..')) then
      begin
        Status := FindNext(SearchRec);
        continue;
      end;
      
      if (Attr = 0) or (SearchRec.Attr and Attr <> 0) then
      begin
        bContinue := True;
        EnumDirectoryFileProc(sDir + SearchRec.name, SearchRec.Attr, UserData, bContinue);
        if not bContinue then Break;
      end;
      
      Status := FindNext(SearchRec);
    end;
  finally
    SysUtils.FindClose(SearchRec);
  end;
end;

type
  TMyClass = class
  private
    FSL: TStrings;
    
    procedure CleanDirectoryProc(sFileName: string; Attr: Integer; UserData: Integer; var bContinue: Boolean);
    procedure GetDirectoryFilesProc(sFileName: string; Attr: Integer; UserData: Integer; var bContinue: Boolean);
  end;
  
procedure TMyClass.GetDirectoryFilesProc(sFileName: string; Attr: Integer; UserData: Integer; var bContinue: Boolean);
begin
{  faReadOnly  = $00000001;
  faHidden    = $00000002;
  faSysFile   = $00000004;
  faVolumeID  = $00000008;
  faDirectory = $00000010;
  faArchive   = $00000020;
  faAnyFile   = $0000003F;
}
  if Attr and faAnyFile = 0 then Attr := Attr or faArchive;
  
  if (UserData <> 0) and (Attr and UserData = 0) then Exit;
  
  if Attr and faDirectory <> 0 then sFileName := PathWithSlash(sFileName);
  FSL.Add(sFileName);
end;

procedure GetDirectoryFiles(sDir, sMask: string; bRecursive: Boolean; FileAttr: Integer; SL: TStrings);
begin
  with TMyClass.Create do
    try
      FSL := SL;
      EnumDirectoryFiles(sDir, sMask, 0, bRecursive, FileAttr, GetDirectoryFilesProc);
    finally
      Free;
    end;
end;

procedure TMyClass.CleanDirectoryProc(sFileName: string; Attr: Integer; UserData: Integer; var bContinue: Boolean);
begin
  Attr := (not faReadOnly) and Attr; // Turn off ReadOnly attribute
  Attr := (not faHidden) and Attr; // Turn off Hidden attribute
  FileSetAttr(sFileName, Attr);
  
  if Attr and faDirectory <> 0 then
    RMDir(sFileName)
  else
    SysUtils.DeleteFile(sFileName);
end;

procedure CleanDirectory(sDir: string);
begin
  if not DirectoryExists(sDir) then Exit;
  
  with TMyClass.Create do
    try
      EnumDirectoryFiles(sDir, '*.*', faAnyFile, True, 0, CleanDirectoryProc);
    finally
      Free;
    end;
  {$I-}
  RMDir(sDir);
  {$I+}
end;

procedure CopyDirectory(sDir, tDir: string; bRecursive: Boolean);
var
  SearchRec: TSearchRec;
  Status   : Integer;   
begin
  sDir := PathWithSlash(sDir);
  tDir := PathWithSlash(tDir);
  
  Status := FindFirst(sDir + '*.*', faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if bRecursive and (SearchRec.Attr and faDirectory <> 0) then
      begin
        if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
          CopyDirectory(sDir + SearchRec.name, tDir, bRecursive);
      end else
        CopyFile(PChar(sDir + SearchRec.name), PChar(tDir + SearchRec.name), False);
      
      Status := FindNext(SearchRec);
    end;
  finally
    SysUtils.FindClose(SearchRec);
  end;
end;

function GetUniqueFileName(Filename: string): string;
var
  I         : Integer;
  Path, sExt: string; 
begin
  if not FileExists(Filename) then
  begin
    Result := Filename;
    Exit;
  end;
  
  Path := PathWithSlash(ExtractFilePath(Filename));
  sExt := ExtractFileExt(Filename);
  Filename := ExtractFileNameNoExt(Filename);
  
  I := 1;
  repeat
    Result := Path + Filename + IntToStr(I) + sExt;
    if not FileExists(Result) then Exit;
    
    Inc(I);
  until False;
end;


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

function GetWindowsPath: string;
var
  Buf: array[0..255] of Char;
begin
  GetWindowsDirectory(@Buf, 255);
  Result := PathWithSlash(StrPas(@Buf));
end;
{
function GetLongFilename(const Filename: string): string;
var
  H : THandle;                        
  fd: WIN32_FIND_DATA;
begin
  H := FindFirstFile(PChar(PathWithoutSlash(Filename)), fd);
  if H = INVALID_HANDLE_VALUE then
  begin
    showlasterror;
    Result := Filename;
    Exit;
  end;
  Result := StrPas(fd.cFileName);
  FindClose(H);
end;
}

function GetShortFilename(const Filename: string): string;
var
  Buf: array[0..255] of Char;
begin
  GetShortPathName(PChar(Filename), @Buf, SizeOf(Buf));
  Result := StrPas(Buf);
end;

function GetTemporaryPath: string;
var
  Buf: array[0..255] of Char;
begin
  GetTempPath(255, @Buf);
  Result := PathWithSlash(StrPas(@Buf));
end;

function GetRootDir(var sPath: string): string;
var
  I: Integer;
begin
  I := AnsiPos('\', sPath);
  if I <> 0 then
    Result := Copy(sPath, 1, I)
  else
    Result := sPath;
  
  Delete(sPath, 1, Length(Result));
  Result := PathWithoutSlash(Result);
end;

function GetLeafDir(var sPath: string): string;
begin
  sPath := PathWithoutSlash(sPath);
  Result := ExtractFileName(sPath);
  sPath := ExtractFilePath(sPath);
end;

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

function MyExtractFileName(const Filename: string; PathDelimiter: Char = '\'): string;
begin
  Result := Copy(Filename, Length(MyExtractFilePath(Filename, PathDelimiter)) + 1, Maxint);
end;

function MyExtractFilePath(const Filename: string; PathDelimiter: Char = '\'): string;
var
  I: Integer;
begin
  I := Length(Filename);
  while I >= 1 do
  begin
    if Filename[I] = PathDelimiter then
    begin
      Result := Copy(Filename, 1, I); // include the path delimiter
      Exit;
    end;
    dec(I);
  end;
  
  Result := '';
end;

function GetGUIDFileName(Ext: string = ''): string;
var
  ID: TGUID;
begin
  CoCreateGuid(ID);
  Result := GUIDToString(ID) + Ext;
end;

function IsFileLocked(Filename: string): Boolean;
var
  HFILE: THandle;
begin
  HFILE := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if HFILE = INVALID_HANDLE_VALUE then
    Result := True
  else
  begin
    Result := False;
    CloseHandle(HFILE);
  end;
end;

function CheckFileExtension(Filename: string; Extensions: array of string): Boolean;
var
  Ext: string; 
  I  : Integer;
begin
  Ext := LowerCase(ExtractFileExt(Filename));
  for I := Low(Extensions) to High(Extensions) do
    if Extensions[I] = Ext then
    begin
      Result := True;
      Exit;
    end;
  
  Result := False;
end;

function MyFindExecutable(const Filename: string): string;
var
  Buf: array[0..255] of Char;
begin
  if FindExecutable(PChar(Filename), nil, Buf) > 32 then
    Result := StrPas(Buf);
end;

function MyGetFileDateTime(const Filename: string): TDateTime;
var
  Age: Integer;
begin
  Age := FileAge(Filename);
  if Age <> - 1 then
    Result := FileDateToDateTime(Age)
  else
    Result := 0;
end;

initialization
  if AppDir = '' then //