xfiles.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

unit xFiles;

interface

uses SysUtils, Windows, ShellAPI, Forms,Filectrl;

type
  TDirEnumProc = procedure (sFileName: string; var bContinue: Boolean) ;//of object;
  TFileAcessMode = (famCreate,famModify,famAccess);
  
//------------------------------------------------------------------//
function AddSlash(const s: string): string;
function DelSlash(const s: string): string;
function GetSizeString(Value: Longint): String;

//------------------------------------------------------------------//
function IsFileInUse(fName : string ) : boolean;
function GetFileLastAccessTime(sFileName:string;Mode : TFileAcessMode = famModify):TDateTime;

function GetMainFilePath(const sFilePath: String): String;
function GetMainFileName(const sFilePath: String): String;

function FileLongName(const sFilePath: String): String;
function FileShortName(const sFilePath: String): String;
function FileTypeName(const sFilePath: String): String;

function FileSizeEx(const sFileName: string): DWORD;
function FileCopy(const SourceFile, TargetFile: String): Boolean;
function FileCopyEx(const SourceFile, TargetFile: String): Boolean;
function FileShredder(const sFilePath: String): Boolean;

//------------------------------------------------------------------//
function DirRelative(BasePath, FilePath: string): string;
function DirStripSpecifier(const Path: string): string;
function DirCompare(const Path1, Path2: string): Boolean;
function DirParent(Path: string): string;

//------------------------------------------------------------------//
procedure DirEnum(sDir, sMask: string; Attr: Integer; DirEnumProc: TDirEnumProc);
procedure DirClean(sDir: string);
procedure DirCopy(sDir, tDir: string; bRecursive: Boolean =True);

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

//------------------------------------------------------------------//
function GetSystemDir: string;
function GetWindowsDir: string;

//------------------------------------------------------------------//
function GetWindowsDirFile (const sFileName: string): string;
function GetSystemDirFile  (const sFileName: string): string;
function GetSystemDriveFile(const sFileName: string): string;

//------------------------------------------------------------------//
function GetUniqFile(const Path: string; sFileName: string): string;
function GetTempFile(sPrefix: string = 'TEMP'): string;

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

var
  AppDir: string;

implementation

//------------------------------------------------------------------//
//路径中，添加路径尾部的"\"
function AddSlash(const s: string): string;
begin
  Result := s;
  if (Length(Result) > 0) and (Result[Length(Result)] <> '\') then Result:=Result+'\';
end;

//------------------------------------------------------------------//
//路径中，删除路径尾部的"\"
function DelSlash(const s: string): string;
begin
  if (Length(s) > 0) and (s[Length(s)] = '\') then Result := Copy(s, 1, Length(s) - 1)
  else Result := s;
end;

//------------------------------------------------------------------//
//将文件或盘区大小转换为字符串。
function GetSizeString(Value: Longint): String;
const
	KBYTE = 1024;
	MBYTE = 1048576;
	GBYTE = 1073741824;
	
  function FltToStr(F: Extended): String;
  begin
    Result:=FloatToStrF(Round(F),ffNumber,6,0);
  end;

begin
  if Value > GBYTE then
    Result:=FltTostr(Value / GBYTE)+' GB'
  else if Value > MBYTE then
    Result:=FltToStr(Value / MBYTE)+' MB'
  else if Value > KBYTE then
    Result:=FltTostr(Value / KBYTE)+' KB'
  else
    Result:=FltTostr(Value) +' Byte';   
end;

//------------------------------------------------------------------//
//检测文件是否正在被使用。
function IsFileInUse(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;

//------------------------------------------------------------------//
//取得文件最近访问时间，可根据Mode，取得创建、修改、访问时间。
function GetFileLastAccessTime(sFileName:string;Mode : TFileAcessMode = famModify):TDateTime;
var
  oWFD:TWin32FindData;
  oFT:TFileTime;
  oHandle:THandle;
  nDate:DWord;
begin
  oHandle:=FindFirstFile(PChar(sFileName),oWFD);
  if oHandle<>INVALID_HANDLE_VALUE then
  begin
      case Mode of
          famCreate : FileTimeToLocalFileTime(oWFD.ftCreationTime,oFT);
          famModify : FileTimeToLocalFileTime(oWFD.ftLastWriteTime,oFT);
          famAccess : FileTimeToLocalFileTime(oWFD.ftLastAccessTime,oFT);
      else
        FileTimeToLocalFileTime(oWFD.ftLastAccessTime,oFT);
      end;
      FileTimeToDosDateTime(oFT,LongRec(nDate).Hi,LongRec(nDate).Lo);
      Result:=FileDateToDateTime(nDate);
      windows.FindClose(oHandle);
  end
  else
      Result:=0;
end;

//------------------------------------------------------------------//
//输入任意文件名，返回主文件路径
//如'c:\windows\calc.exe'，返回c:\windows\calc
function GetMainFilePath(const sFilePath: string): string;
begin
  Result := Copy(sFilePath, 1, Length(sFilePath) - Length(ExtractFileExt(sFilePath)));
end;

//------------------------------------------------------------------//
//输入任意文件名，返回主文件名
//如'c:\windows\calc.exe'，返回calc
function GetMainFileName(const sFilePath: String): String;
var
  aExt : String;
  aPos : Integer;
begin
  aExt:=ExtractFileExt(sFilePath);
  Result:=ExtractFileName(sFilePath);
  if aExt <> '' then
  begin
    aPos:=Pos(aExt,Result);
    if aPos>0 then
       Delete(Result,aPos,Length(aExt));
  end;
end;

//------------------------------------------------------------------//
//返回长文件名
function FileLongName(const sFilePath: String): String;
var
  aInfo: TSHFileInfo;
begin
  if SHGetFileInfo(PChar(sFilePath),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then
     Result:=StrPas(aInfo.szDisplayName)
  else
     Result:=sFilePath;
end;

//------------------------------------------------------------------//
//返回短文件名
function FileShortName(const sFilePath: String): String;
var
  aTmp: array[0..255] of char;
begin
  if GetShortPathName(PChar(sFilePath),aTmp,Sizeof(aTmp)-1)=0 then
     Result:=sFilePath
  else
     Result:=StrPas(aTmp);
end;

//------------------------------------------------------------------//
//返回文件类型名
function FileTypeName(const sFilePath: String): String;
var
  aInfo: TSHFileInfo;
begin
  if SHGetFileInfo(PChar(sFilePath),0,aInfo,Sizeof(aInfo),SHGFI_TYPENAME)<>0 then
     Result:=StrPas(aInfo.szTypeName)
  else begin
     Result:=ExtractFileExt(sFilePath);
     Delete(Result,1,1);
     Result:=UpperCase(Result);
  end;
end;

//------------------------------------------------------------------//
//取得文件大小
function FileSizeEx(const sFileName: string): DWORD;
var
  HFILE: THandle;
begin
  HFILE := CreateFile(PChar(sFileName), 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;

//------------------------------------------------------------------//
//文件复制，如目标存在，返回False
function FileCopy(const SourceFile, TargetFile : string):Boolean;
begin
    Result:=False;
    if AnsiCompareFileName(SourceFile, TargetFile) <> 0 then
       Result:=CopyFile(PChar(SourceFile), PChar(TargetFile), False);
end;

//------------------------------------------------------------------//
//文件复制，使用自定义函数。
function FileCopyEx(const SourceFile, TargetFile: String): Boolean;
const
  BlockSize = 1024 * 16;
var
  hSource,hTarget : Integer;
//nFileSize       : Integer;
  nRead,nWrite    : Integer;
  Buffer          : Pointer;
begin
  Result:=False;
  hSource:=FileOpen(SourceFile,fmOpenRead+fmShareDenyNone);  { Open Source }
  if hSource>=0 then
  try
//  nFileSize:=FileSeek(hSource, 0, soFromEnd);
    hTarget:=FileCreate(TargetFile);            { Open Target }
    try
      GetMem(Buffer,BlockSize);
      try
        FileSeek(hSource,0, 0); //soFromBeginning
        repeat
          nRead  := FileRead(hSource,Buffer^,BlockSize);
          nWrite := FileWrite(hTarget,Buffer^,nRead);
        until (nRead = 0) or (nRead <> nWrite);
        if nRead = nWrite then Result := True;
      finally
        FreeMem(Buffer,BlockSize);
      end;
      FileSetDate(hTarget, FileGetDate(hSource));
    finally
      FileClose(hTarget);
    end;
  finally
    FileClose(hSource);
  end;
end;


//------------------------------------------------------------------//
//文件碎纸机，将文件填入原字节大小的乱码，然后删除，使信息永远不能恢复。
function FileShredder(const sFilePath: String): Boolean;
var
  aFile : Integer;
  aSize : Integer;
  P     : Pointer;
begin
  aSize:=FileSizeEx(sFilePath);
  aFile:=FileOpen(sFilePath,fmOpenReadWrite);
  //Result:=False;
  try
    Getmem(P,aSize);
    fillchar(P^,aSize,'X');
    FileWrite(aFile,P^,aSize);
    Freemem(P,aSize);
    Result:=True;    
  finally
    FileClose(aFile);
    Sysutils.DeleteFile(sFilePath);
  end;
end;

//------------------------------------------------------------------//
//取得相对路径，即将FilePath中的BasePath部分去掉，如：
//'c:\winnt','c:\winnt\system32\kernel32.dll'
//返回'system32\kernel32.dll'
function DirRelative(BasePath, FilePath: string): string;
begin
  Result := FilePath;
  BasePath := AnsiUpperCaseFileName(AddSlash(BasePath));
  FilePath := AnsiUpperCaseFileName(FilePath);
  if Copy(FilePath, 1, Length(BasePath)) = BasePath then Delete(Result, 1, Length(BasePath));
end;

//------------------------------------------------------------------//
//析去路径中的%，如%Windows%Explorer.exe，返回Explorer.exe
function DirStripSpecifier(const Path: string): string;
var
  I1, I2: Integer;
begin
  Result := Path;

  I1 := AnsiPos('%', Path);
  I2 := AnsiPos('%', Copy(Path, I1 + 1, Length(Path)));