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