home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / zkuste / delphi / WhiteAnts / CMPNAMES.ZIP / FILEUTIL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-20  |  4.4 KB  |  147 lines
  1. unit FileUtil;
  2.  
  3. interface
  4.  
  5. const
  6.   DEFSIZE_FILETRUNC: Byte = 32;
  7.  
  8. function TruncFileNameAt(const FileName: String; MaxLen: Byte): String;
  9.   { Truncates filename by omitting subdirectories }
  10.  
  11. function TruncFileNameDef(const FileName: String): String;
  12.   { Truncates filename, calls TruncFileNameAt with MaxLen = sizeFileTrunc }
  13.  
  14. function JustFileName(const FileName: String): string;
  15.   { Splits Filename in DirStr + NameStr + ExtStr. Returns NameStr only }
  16.  
  17. function CopyFile(const SourceName, TargetName: String): Boolean;
  18.   { Copies Source filename to Target file name, returns true if OK }
  19.  
  20. function RenameToBackup(const FileName, BackupExt: String): Boolean;
  21.   { Returns True if file exists, and could be renamed into a new filename using the
  22.     ChangeFileExt function. BackupExt should include the '.' character }
  23.  
  24. function CopyToBackup(const FileName, BackupExt: String): Boolean;
  25.   { Returns True if file exists, and could be renamed into a new filename using the
  26.     ChangeFileExt function. BackupExt should include the '.' character }
  27.  
  28. function CommandPath: String;
  29.   { full Returns executable path }
  30.  
  31. function SafeRenameFile(const SourceName, TargetName: String): Boolean;
  32.   { First copies Source to target, and if OK, deletes source. This works even OK when
  33.     Source and Target are plcaed on different drives }
  34.  
  35. implementation
  36.  
  37. uses WinTypes, WinProcs, SysUtils, Classes, NumUtils;
  38.  
  39. function TruncFileNameAt(const FileName: String; MaxLen: Byte): String;
  40. var Path: String;
  41. begin
  42.   Result := FileName;
  43.   if Length(Result) > MaxLen then
  44.   begin
  45.     Result := ExtractFileName(FileName);
  46.     if Length(Result) < MaxLen then
  47.     begin
  48.       Path := ExtractFilePath(ExpandFileName(FileName));
  49.       case MaxLen - Length(Result) of
  50.         1 : Result := '\' + Result;
  51.         2..5 : Result := Copy(Path, 1, 2) + Result;
  52.       else
  53.         Result := Copy(Path, 1, 3) + '..\' + Result;
  54.       end;
  55.     end;
  56.   end;
  57. end;
  58.  
  59. function TruncFileNameDef(const FileName: String): String;
  60. begin
  61.   Result := TruncFileNameAt(FileName, DEFSIZE_FILETRUNC);
  62. end;
  63.  
  64. function JustFileName(const FileName: String): String;
  65. var I: Integer;
  66. begin
  67.   Result := ExtractFileName(FileName);
  68.   I := Pos('.', Result);
  69.   if I > 0 then
  70.     Result := Copy(Result, 1, I - 1)
  71. end;
  72.  
  73. function CommandPath: String;
  74. var Path: TFileName;
  75. begin
  76.   Path := ParamStr(0);
  77.   Result := ExtractFilePath(Path);
  78.   if Result[Length(Result)] <> '\' then Result := Result + '\';
  79. end;
  80.  
  81. function SafeRenameFile(const SourceName, TargetName: String): Boolean;
  82. begin
  83.   { if drives are equal then rename else copy }
  84.   if ExpandFileName(SourceName)[1] = ExpandFileName(TargetName)[1] then
  85.     Result := RenameFile(SourceName, TargetName)
  86.   else
  87.     Result := CopyFile(SourceName, TargetName) and DeleteFile(SourceName);
  88. end;
  89.  
  90. function CopyFile(const SourceName, TargetName: String): Boolean;
  91. const sizeBlock = 1024;
  92. var Source, Target: TFileStream;
  93.     Buf: array[0..Pred(sizeBlock)] of Byte;
  94.     M, Rest: LongInt;
  95. begin
  96.   Result := False;
  97.   if FileExists(SourceName) then
  98.   begin
  99.     Source := TFileStream.Create(SourceName, fmOpenRead);
  100.     try
  101.       Target := TFileStream.Create(TargetName, fmCreate);
  102.       try
  103.         Rest := Source.Size;
  104.         while Rest > 0 do
  105.         begin
  106.           M := MinLong(sizeBlock, Rest);
  107.           Source.Read(Buf, M);
  108.           Target.Write(Buf, M);
  109.           Dec(Rest, M);
  110.         end;
  111.         Result := True;
  112.       finally
  113.         Target.Destroy;
  114.       end;
  115.     finally
  116.       Source.Destroy;
  117.     end;
  118.   end;
  119. end;
  120.  
  121. function RenameToBackup(const FileName, BackupExt: String): Boolean;
  122. var BackupName: String;
  123. begin
  124.   Result := False;
  125.   if FileExists(FileName) and (CompareText(ExtractFileExt(FileName), BackupExt) <> 0) then
  126.   begin
  127.     BackupName := ChangeFileExt(FileName, BackupExt);
  128.     if FileExists(BackupName) then Result := DeleteFile(BackUpName) else Result := True;
  129.     Result := Result and RenameFile(FileName, BackupName);
  130.   end;
  131. end;
  132.  
  133. function CopyToBackup(const FileName, BackupExt: String): Boolean;
  134. var BackupName: String;
  135. begin
  136.   Result := False;
  137.   if FileExists(FileName) and (CompareText(ExtractFileExt(FileName), BackupExt) <> 0) then
  138.   begin
  139.     BackupName := ChangeFileExt(FileName, BackupExt);
  140.     if FileExists(BackupName) then Result := DeleteFile(BackUpName) else Result := True;
  141.     Result := Result and CopyFile(FileName, BackupName);
  142.   end;
  143. end;
  144.  
  145.  
  146. end.
  147.