Category : Pascal Source Code
Archive   : FCOPY4.ZIP
Filename : FILECOPY.PAS

 
Output of file : FILECOPY.PAS contained in archive : FCOPY4.ZIP
{****************************************************************

FileCopy - A unit to copy one file into another
Version 1.1 4/20/88
by Richard S. Sadowsky
CIS 74017,1670

Released as is to the public domain, use at your own risk!

Uploaded because "how do I copy a file" is a relatively common
question in BPROGA. This unit takes full advantage of the DOS
unit, using GetFTime and SetFTime to set the destination
file's time/date stamp to be the same as that of the source.

Mods:
date | ver | by | modifications
=============================================
4/20/88 1.1 RSS fixed final Reset which neglected to clear
IOResult. Also will not try to set time/date
Attribute of dest file if error occurred in copy.

****************************************************************}

{$I-,V-,S-,R-} { It is required to turn off abort on I/O error with $I- }
Unit FileCopy;

interface

uses DOS;


type
Path = String[70]; { to store filespecs }

function File_Copy_Buf(Source,Dest : Path;
BufPtr : Pointer; BufferSize : Word) : Word;
{
Copies file specified by Source into file specified by Dest using a
buffer BufferSize bytes in size and pointed to by BufPtr. The function
result is the error code. If the error code is zero, then the file was
successfully copied. The filenames may optionally include drive and/or
pathnames. If the destination file already exists, it will be
overwritten. If ErrorCode nonzero, then it is the IOResult value
that signaled the error. A special value of $FFFF indicates
that the destination disk filled before the entire file was copied.
I would suggest that you delete the destination file if an error
occurs and the destination file was created (like a read/write
or disk full error) since this routine will not do that for you.
}

function File_Copy(Source,Dest : Path; BufferSize : Word) : Word;
{
Same as File_Copy_Buf except automatically allocates a buffer of
BufferSize bytes on the heap, so no pointer need be passed.
}

implementation

function File_Copy_Buf(Source,Dest : Path;
BufPtr : Pointer; BufferSize : Word) : Word;

var
InF,OutF : File; { the input and output files }
ErrorCode,Num,N : Word; { a few words }
Time : LongInt; { to hold time/date stamp }

begin
Assign(InF,Source);
Reset(InF,1); { open the source file }
ErrorCode := IOResult;
GetFTime(InF,Time); { get time/date stamp from source file }
if ErrorCode = 0 then begin
Assign(OutF,Dest);
Rewrite(OutF,1); { Create destination file }
ErrorCode := IOResult;
{ copy loop }
while (not EOF(InF)) and (ErrorCode = 0) do begin
BlockRead(InF,BufPtr^,BufferSize,Num); { read a buffer full from source }
ErrorCode := IOResult;
if ErrorCode = 0 then begin
BlockWrite(OutF,BufPtr^,Num,N); { write it to destintion }
ErrorCode := IOResult;
if N < Num then
ErrorCode := $FFFF; { disk probably full }
end;
end;
end;

{ error detection and reporting could be alot better, }
{ but what do ya want for nothin? }

{ try to close the files no matter what to make sure handles are freed }
Close(OutF); { Close destination file }
if IOresult <> 0 then ; { clear IOResult }
Close(InF); { close source file }
if IOresult <> 0 then ; { clear IOResult }
if ErrorCode = 0 then begin
Assign(OutF,Dest);
Reset(OutF);
if IOResult <> 0 then ; { clear IOResult }
SetFTime(OutF,Time); { Set time/date stamp of dest to that of source }
Close(OutF);
if IOresult <> 0 then ; { clear IOResult }
end;
File_Copy_Buf := ErrorCode;
end;

function File_Copy(Source,Dest : Path; BufferSize : Word) : Word;
{ shell around File_Copy_Buf to automatically allocate a buffer of }
{ BufferSize on the heap }
var
Buf : Pointer;

begin
if BufferSize > 65521 then
BufferSize := 65521; { user specified buffer bigger than possible }
{ so scale it down }
GetMem(Buf,BufferSize); { allocate memory for the buffer }
File_Copy := File_Copy_Buf(Source,Dest,Buf,BufferSize);
FreeMem(Buf,BufferSize); { deallocate heap space for buffer }
end;

end.


  3 Responses to “Category : Pascal Source Code
Archive   : FCOPY4.ZIP
Filename : FILECOPY.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/