Does anyone know a function that will allow you to copy one file to another location?

CopyFile(File, File2);

Thanks.

--Nugax
The ByteXchange BBS
TBX Software

... Error 3032 - Recursion error. See error 3032.

--- Mystic BBS v1.12 A48 2022/07/15 (Linux/64)
* Origin: The ByteXchange BBS | bbs.thebytexchange.com (1:19/37)

On 02 Sep 2022, Chad Adams said the following...

Does anyone know a function that will allow you to copy one file to another location?
CopyFile(File, File2);

documentation for blockread/blockwrite usually has an example implementatiom of that function

freepascal:

https://www.freepascal.org/docs-html/current/rtl/system/blockread.html

virual pascal's built in help includes almost the same i think, but i can't double check from my phone..

note that the example works but leaves out a lot of checks you might want to do (does the file already exist at destination? did errors occur? etc) but if it's for something simple it might not matter..

... Error, no Keyboard - Press F1 to Continue.

--- Mystic BBS v1.12 A47 2021/12/25 (Windows/32)
* Origin: cold fusion - cfbbs.net - grand rapids, mi (1:120/616)

On 02 Sep 22 21:22:49, Chad Adams said the following to All:

Does anyone know a function that will allow you to copy one file to another location?

CopyFile(File, File2);

procedure SAFECOPY (fromFile, toFile : string);
type bufferType = array [1..64] of char;
type bufferTypePtr = ^bufferType; { Use the heap }
var bufferPtr : bufferTypePtr; { for the buffer }
f1, f2 : file;
bufferSize, readCount, writeCount : word;
fmSave : byte; { To store the filemode }
begin
bufferSize := SizeOf(bufferType);
New (bufferPtr); { Create the buffer, on the heap }
fmSave := FileMode; { Store the filemode }
FileMode := 0; { To read also read-only files }
Assign (f1, fromFile);
{$I-} Reset (f1, 1); { Note the record size 1, important! }
if IOResult <> 0 then exit; { Does the file exist? }
Assign (f2, toFile);
{$I-} Rewrite (f2, 1); { Open the target }
if IOResult <> 0 then exit;
repeat { Do the copying }
BlockRead (f1, bufferPtr^, bufferSize, readCount);
{$I-} BlockWrite (f2, bufferPtr^, readCount, writeCount);
if IOResult <> 0 then begin close (f1); exit; end;
until (readCount = 0) or (writeCount <> readCount);
close (f1); close (f2);
FileMode := fmSave; { Restore the original filemode }
Dispose (bufferPtr); { Release the buffer from the heap }
end; (* safecopy *)

Nick

--- Renegade vY2Ka2
* Origin: Joey, do you like movies about gladiators? (1:229/426)

On 03 Sep 2022, Nick Andre said the following...

procedure SAFECOPY (fromFile, toFile : string);

this only copies 64 bytes at a time (should be something closer to the filesystem block size, or if it's unknown the best guess is 4096). i.e: this function likely reads the disk 64 times per 4096 bytes instead of 1x

with a 5GB file this went from a 1min 48second copy to a 8 second one (and significantly less cpu usage)

it sets {$I-} for the entire rest of the program (missing matching {$I+})

any point in the function 'exit' is called causes a memory leak (dispose isn't called on bufferPtr before the exit)

--- Mystic BBS v1.12 A47 2021/12/25 (Windows/32)
* Origin: cold fusion - cfbbs.net - grand rapids, mi (1:120/616)

On 04 Sep 2022, Alexander Grotewohl said the following...

this function likely reads the disk 64 times per 4096 bytes instead of 1x

ack, what i mean is it reads 4096 bytes, 64 times, per 4096 bytes! thats 262144 bytes read per 4096 written! :)

... Error 3032 - Recursion error. See error 3032.

--- Mystic BBS v1.12 A47 2021/12/25 (Windows/32)
* Origin: cold fusion - cfbbs.net - grand rapids, mi (1:120/616)

On 04 Sep 22 17:14:27, Alexander Grotewohl said the following to Nick Andre:

procedure SAFECOPY (fromFile, toFile : string);

this only copies 64 bytes at a time (should be something closer to the filesystem block size, or if it's unknown the best guess is 4096). i.e: thi function likely reads the disk 64 times per 4096 bytes instead of 1x

I'm sure the whole thing can be improved, it was an example from a collection of code dating back to... TP 5.5 I think.

Nick

--- Renegade vY2Ka2
* Origin: Joey, do you like movies about gladiators? (1:229/426)

Thanks Nick. I actually wrote this program, almost exactly as you did.
Yours is a little more complex, but i wrote a copy file program.

I needed something to install (copy) a lib I am writing for my BBS programs for shared code.


Thanks!



On 03 Sep 2022, Nick Andre said the following...

On 02 Sep 22 21:22:49, Chad Adams said the following to All:

Does anyone know a function that will allow you to copy one file to an location?

CopyFile(File, File2);

procedure SAFECOPY (fromFile, toFile : string);
type bufferType = array [1..64] of char;
type bufferTypePtr = ^bufferType; { Use the heap }
var bufferPtr : bufferTypePtr; { for the buffer }
f1, f2 : file;
bufferSize, readCount, writeCount : word;
fmSave : byte; { To store the filemode }
begin
bufferSize := SizeOf(bufferType);
New (bufferPtr); { Create the buffer, on the heap }
fmSave := FileMode; { Store the filemode }
FileMode := 0; { To read also read-only files }
Assign (f1, fromFile);
{$I-} Reset (f1, 1); { Note the record size 1, important! }
if IOResult <> 0 then exit; { Does the file exist? }
Assign (f2, toFile);
{$I-} Rewrite (f2, 1); { Open the target }
if IOResult <> 0 then exit;
repeat { Do the copying }
BlockRead (f1, bufferPtr^, bufferSize, readCount);
{$I-} BlockWrite (f2, bufferPtr^, readCount, writeCount);
if IOResult <> 0 then begin close (f1); exit; end;
until (readCount = 0) or (writeCount <> readCount);
close (f1); close (f2);
FileMode := fmSave; { Restore the original filemode }
Dispose (bufferPtr); { Release the buffer from the heap }
end; (* safecopy *)

Nick

--- Renegade vY2Ka2
* Origin: Joey, do you like movies about gladiators? (1:229/426)

--Nugax
The ByteXchange BBS
TBX Software

--- Mystic BBS v1.12 A48 2022/07/15 (Linux/64)
* Origin: The ByteXchange BBS | bbs.thebytexchange.com (1:19/37)

I'm sure the whole thing can be improved, it was an example from a collect of code dating back to... TP 5.5 I think.

TP 5.5 ... that's CRAZY talk. <G>

... Cthulhu in '96: why settle for the LESSER evil?

--- Renegade v1.31/Exp
* Origin: The Titantic BBS Telnet - ttb.rgbbs.info (1:129/305)