home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / handson / archive / Issue153 / delphi / Diskbrowser / MyFmxutils.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-03-18  |  4.5 KB  |  136 lines
  1. unit MyFmxutils;
  2.  
  3. (* Note: This is a slightly alterede version of the FMXUtils unit provided
  4.    with Borland's sample FileManEx sample program. My alterations
  5.    are marked by comments beginning with the characters:
  6.        //!!
  7.    Huw Collingbourne
  8. *)
  9.  
  10. interface
  11.  
  12. uses Windows, Classes, Consts, SysUtils;
  13.  
  14. type
  15.   EInvalidDest = class(EStreamError);
  16.   EFCantMove = class(EStreamError);
  17.  
  18. procedure CopyFile(const FileName, DestName: string);
  19. procedure MoveFile(const FileName, DestName: string);
  20. function GetFileSize(const FileName: string): LongInt;
  21. function FileDateTime(const FileName: string): TDateTime;
  22. function HasAttr(const FileName: string; Attr: Word): Boolean;
  23. function ExecuteFile(const FileName, Params, DefaultDir: string;
  24.   ShowCmd: Integer): THandle;
  25.  
  26. implementation
  27.  
  28. uses Forms, ShellAPI;
  29.  
  30. const
  31.   SInvalidDest = 'Destination %s does not exist';
  32.   SFCantMove = 'Cannot move file %s';
  33.  
  34. procedure CopyFile(const FileName, DestName: TFileName);
  35. var
  36.   CopyBuffer: Pointer; { buffer for copying }
  37.   TimeStamp, BytesCopied: Longint;
  38.   Source, Dest: Integer; { handles }
  39.   Destination: TFileName; { holder for expanded destination name }
  40. const
  41.   ChunkSize: Longint = 8192; { copy in 8K chunks }
  42. begin
  43.   //!! This line added
  44.  Destination := DestName;
  45.  //!! This commented out since my code passes a fully qualified path name anyhow
  46. (* Destination := ExpandFileName(DestName); { expand the destination path }
  47.   if (HasAttr(Destination, faDirectory)) then { if destination is a directory... }
  48.     Destination := Destination + '\' +  ExtractFileName(FileName); { ...clone file name }   *)
  49.   TimeStamp := FileAge(FileName); { get source's time stamp }
  50.   GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  51.   try
  52.     Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
  53.     if Source < 0 then raise EFOpenError.Create(FmtLoadStr(SFOpenError, [FileName]));
  54.     try
  55.       Dest := FileCreate(Destination); { create output file; overwrite existing }
  56.       if Dest < 0 then raise EFCreateError.Create(FmtLoadStr(SFCreateError, [Destination]));
  57.       try
  58.         repeat
  59.           BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
  60.           if BytesCopied > 0 then { if we read anything... }
  61.             FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
  62.         until BytesCopied < ChunkSize; { until we run out of chunks }
  63.       finally
  64.         FileClose(Dest); { close the destination file }
  65.       end;
  66.     finally
  67.       FileClose(Source); { close the source file }
  68.     end;
  69.   finally
  70.     FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  71.   end;
  72. end;
  73.  
  74.  
  75. { MoveFile procedure }
  76. {
  77.   Moves the file passed in FileName to the directory specified in DestDir.
  78.   Tries to just rename the file.  If that fails, try to copy the file and
  79.   delete the original.
  80.  
  81.   Raises an exception if the source file is read-only, and therefore cannot
  82.   be deleted/moved.
  83. }
  84.  
  85. procedure MoveFile(const FileName, DestName: string);
  86. var
  87.   Destination: string;
  88. begin
  89.  Destination := ExpandFileName(DestName); { expand the destination path }
  90.   if not RenameFile(FileName, Destination) then { try just renaming }
  91.   begin
  92.     if HasAttr(FileName, faReadOnly) then  { if it's read-only... }
  93.       raise EFCantMove.Create(Format(SFCantMove, [FileName])); { we wouldn't be able to delete it }
  94.       CopyFile(FileName, Destination); { copy it over to destination...}
  95.          //!! Uncommented DeleteFile(FileName);
  96.       DeleteFile(FileName); { ...and delete the original }
  97.   end;
  98. end;
  99.  
  100. { GetFileSize function }
  101. {
  102.   Returns the size of the named file without opening the file.  If the file
  103.   doesn't exist, returns -1.
  104. }
  105.  
  106. function GetFileSize(const FileName: string): LongInt;
  107. var
  108.   SearchRec: TSearchRec;
  109. begin
  110.   if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
  111.     Result := SearchRec.Size
  112.   else Result := -1;
  113. end;
  114.  
  115. function FileDateTime(const FileName: string): System.TDateTime;
  116. begin
  117.   Result := FileDateToDateTime(FileAge(FileName));
  118. end;
  119.  
  120. function HasAttr(const FileName: string; Attr: Word): Boolean;
  121. begin
  122.   Result := (FileGetAttr(FileName) and Attr) = Attr;
  123. end;
  124.  
  125. function ExecuteFile(const FileName, Params, DefaultDir: string;
  126.   ShowCmd: Integer): THandle;
  127. var
  128.   zFileName, zParams, zDir: array[0..79] of Char;
  129. begin
  130.   Result := ShellExecute(Application.MainForm.Handle, nil,
  131.     StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
  132.     StrPCopy(zDir, DefaultDir), ShowCmd);
  133. end;
  134.  
  135. end.
  136.