SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00020 FILE COPY/MOVE ROUTINES 1 05-28-9313:35ALL SWAG SUPPORT TEAM Copy File #1 IMPORT 6 ▐S¿¥ Program Copy;ππVar InFile, OutFile : File;π Buffer : Array[ 1..512 ] Of Char;π NumberRead,π NumberWritten : Word;ππbeginπ If ParamCount <> 2 Then Halt( 1 );π Assign( InFile, ParamStr( 1 ) );π Reset ( InFile, 1 ); {This is Reset For unTyped Files}π Assign ( OutFile, ParamStr( 2 ) );π ReWrite ( OutFile, 1 ); {This is ReWrite For unTyped Files}π Repeatπ BlockRead ( InFile, Buffer, Sizeof( Buffer ), NumberRead );π BlockWrite( OutFile, Buffer, NumberRead, NumberWritten );π Until (NumberRead = 0) or (NumberRead <> NumberWritten);π Close( InFile );π Close( OutFile );πend.π 2 05-28-9313:35ALL SWAG SUPPORT TEAM Copy File #2 IMPORT 30 ▐S╘ä {I've been trying to figure out how to do a fairly fast copyπ in pascal. It doesn't have to be faster then Dos copy, butπ I definatly DON'T want to shell out to Dos to do it!π I've got the following working... in the IDE of Turbo 6.0!π If I compile it, it wont work at all. ALSO... If you COMPπ the Files to check For errors, They are there. (UGH!)π (ie, it isn't a perfect copy!)π The thing is I want to get as much as I can in each pass!π (But turbo has limits!)π Heres my code... Just rough, so no Real comments.π}ππProgram Copy (InFile, OutFile);ππUses Dos;ππVarπ I, Count, BytesGot : Integer;π BP : Pointer;π InFile,OutFile:File;ππ FI,FO : Word;ππ Path,π FileName : String[80];ππ DirInfo : SearchRec;π BaseRec, RecSize : longInt;ππbeginπ FileName := ParamStr(1); {Set the SOURCE as the first ParamSTR}π Path := ParamStr(2); {Set the Dest. as the 2nd paramSTR}ππ If paramCount = 0 Thenπ beginπ Writeln('FastCopy (C) 1993 - Steven Shimatzki');π Writeln('Version : 3.0 Usage: FastCopy <Source> <Destination>');π Halt(1);π end;ππ FindFirst(FileName,Archive,DirInfo);ππ If DirInfo.Name <> '' Thenπ beginππ RecSize := MaxAvail - 1024; {Get the most memory but leave some}π BaseRec := RecSize;ππ If RecSize > DirInfo.Size Then {If a "SMALL" File, gobble it up}π RecSize := DirInfo.Size; {In one pass! Size = Recordsize}ππ Count := DirInfo.Size Div RecSize; {Find out how many Passes!}ππ GetMem (Bp, RecSize); {Allocate memory to the dynamic Variable}ππ Assign (InFile,FileName); {Assign the File}π Assign (OutFile,Path); {Assign the File}ππ Filemode := 0; {Open the INFile as READONLY}ππ Reset(InFile,RecSize); {open the input}π ReWrite(OutFile,RecSize); {make the output}πππ For I := 1 to Count do {Do it For COUNT passes!}π beginππ {$I-}π Blockread(InFile,BP^,1,BytesGot); {Read 1 BLOCK}π {$I+}ππ BlockWrite(outFile,BP^,1,BytesGot); {Write 1 BLOCK}ππ If BytesGot <> 1 Thenπ Writeln('Error! Disk Full!');ππ end;ππ{If not all read in, then I have to get the rest seperatly! partial Record!}ππ If Not ((Count * RecSize) = DirInfo.Size) Thenπ beginπ RecSize := (DirInfo.Size - (Count * RecSize)) ;π {^^^ How much is left to read? get it in one pass!}πππ FreeMem(Bp, BaseRec); {Dump the mem back}π GetMem(Bp, RecSize); {Get the new memory}ππ FileMode := 0; {Set input For readonly}ππ Reset (InFile,1);ππ Filemode := 2; {Set output For Read/Write}ππ Reset (OutFile,1);ππ Seek(InFile, (Count * BaseRec)); {Move to old location}π Seek(OutFile, (Count * BaseRec));{ same }ππ FI := FilePos(InFile); {Just used to see where I am in the File}π FO := FilePos(OutFile); {Under the Watch Window... Remove later}ππ {$I-}π BlockRead(InFile,Bp^,RecSize,BytesGot); {REad the File}π {$I+}ππ BlockWrite(OutFile,Bp^,RecSize,BytesGot); {Write the File}ππ end;ππ Close(OutFile);π Close(InFile);ππ FreeMem (Bp,RecSize);ππ end;ππend.ππ{πYou don't close the input- and output File when your finished With theπfirst count passes. Maybe your last block will not be written to disk,πwhen you reopen the outputFile For writing. I can't see another problemπright now. 3 05-28-9313:35ALL SWAG SUPPORT TEAM Copy File #3 IMPORT 10 ▐S²┤ {π> Or can someone put up some Procedure that will copy Files.π}ππ{$O+}ππUsesπ Dos;ππFunction CopyFile(SourceFile, TargetFile : String): Byte;π{ Return codes: 0 successfulπ 1 source and target the sameπ 2 cannot open sourceπ 3 unable to create targetπ 4 error during copyπ}πVarπ Source,π Target : File;π BRead,π BWrite : Word;π FileBuf : Array[1..2048] of Char;πbeginπ If SourceFile = TargetFile thenπ beginπ CopyFile := 1;π Exit;π end;π Assign(Source,SourceFile);π {$I-}π Reset(Source,1);π {$I+}π If IOResult <> 0 thenπ beginπ CopyFile := 2;π Exit;π end;π Assign(Target,TargetFile);π {$I-}π ReWrite(Target,1);π {$I+}π If IOResult <> 0 thenπ beginπ CopyFile := 3;π Exit;π end;π Repeatπ BlockRead(Source,FileBuf,SizeOf(FileBuf),BRead);π BlockWrite(Target,FileBuf,Bread,BWrite);π Until (Bread = 0) or (Bread <> BWrite);π Close(Source);π Close(Target);π If Bread <> BWrite thenπ CopyFile := 4π elseπ CopyFile := 0;πend; {of func CopyFile}ππ 4 05-28-9313:35ALL SWAG SUPPORT TEAM Copy File #4 IMPORT 20 ▐SEo {I am having a bit of a problem in Pascal. I am writing a routine toπcopy Files. The Program is to be used in an area where anything atπall can happen, so it has to be totally bullet-proof. All is well,πexcept one little thing. Should the Program encounter a major diskπerror (for example, the user removes the disk While the copy is takingπplace), the Program breaks into Dos after an 'Abort, Retry, Fail'πprompt. Now comes the weird part. This crash to Dos only occurs onlyπonce the Program terminates. It processes the error perfectly, and onlyπgives the error once my entire Program is at an end! Following is theπsource code in question:π}πProgram FileTest;ππUsesπ Dos;ππProcedure FileCopy(SrcPath, DstPath, FSpec : String; Var ExStat : Integer);πVarπ DirInfo : SearchRec;π Done : Boolean;ππProcedure Process(X : String);πVarπ Source,π Dest : File;π Buffer : Array[1..4096] of Byte;π ReadCnt,π WriteCnt : Word;ππbeginπ {$I-}π ExStat:=0;π Assign(Source,SrcPath+X);π Reset(Source,1);π If IOResult <> 0 thenπ ExStat := 1;π If ExStat = 0 thenπ beginπ Assign(Dest,DstPath+X);π ReWrite(Dest,1);π If IOResult <> 0 thenπ ExStat := 2;π If ExStat = 0 thenπ beginπ Repeatπ BlockRead(Source,Buffer,Sizeof(Buffer),ReadCnt);π BlockWrite(Dest,Buffer,ReadCnt,WriteCnt);π If IOResult <> 0 thenπ ExStat := 3;π Until (ReadCnt = 0) or (WriteCnt <> ReadCnt) or (ExStat <> 0);π Close(Dest);π end;π Close(Source);π end;π {$I+}πend;ππbeginπ {$I-}π ExStat := 0;π FindFirst(SrcPath + FSpec, Archive, DirInfo);π Done := False;π While Not Done doπ beginπ Write('Copying ',DirInfo.Name,' ');π Process(DirInfo.Name);π If (ExStat = 0) thenπ beginπ FindNext(DirInfo);π If (DosError<>0) thenπ Done := True;π endπ elseπ Done := True;π end;π {$I+}πend;ππProcedure Main;πVarπ ExC : Integer;πbeginπ FileCopy('C:\Dos\','A:\','*.BAS',ExC);π Writeln('Exit Code:',ExC);πend;ππbeginπ Main;π Writeln('Program is Complete');πend.π{πThat's it. All errors get logged normally, and right after 'Program isπComplete', I get an 'Abort, Retry, Fail'. It must be a File left open,πand TP tries to close it once the Program terminates, but I can'tπimagine which File it might be!π} 5 05-28-9313:35ALL SWAG SUPPORT TEAM Copy File #5 IMPORT 16 ▐SPQ { copy Files With certain extentions to a specific directory (Bothπ parameters specified at the command line or in a Text File).. I cannotπ seem to find a command withing TP 6.0 to copy Files.. I have lookedπ several times through the manuals but still no luck.. I even asked theπ teacher in Charge and he did not even know! Ok all you Programmers outπ there.. Show your stuff.. If you Really want to be kind, help me outπ on this..I am just starting in TP and this is all new to me!π}ππ{$R-,I+} {Set range checking off, IOChecking on}π{$M $400, $2000, $10000} {Make sure enough heap space}π{ 1k Stack, 8k MinHeap, 64k MaxHeap }πTypeπ Buf = Array[0..65527] of Byte;πVarπ FileFrom, FileTo : File;π Buffer : ^Buf;π BytesToRead, BytesRead : Word;π MoreToCopy, IoStatus : Boolean;ππbeginπ {Determine largest possible buffer useable}π If MaxAvail < 65528 thenπ BytesToRead := MaxAvailπ elseπ BytesToRead := 65528;π Writeln('Program is using ', BytesToRead , ' Bytes of buffer');π GetMem(Buffer, BytesToRead); {Grab heap memory For buffer}π Assign(FileFrom, 'File_1');π Assign(FileTo, 'File_2');π Reset(FileFrom, 1); {Open File With 1Byte Record size}π ReWrite(FileTo, 1);π IoStatus := (IoResult = 0);π MoreToCopy := True;π While IoStatus and MoreToCopy do beginπ {$I-}π blockread(FileFrom, Buffer^, BytesToRead, BytesRead);π blockWrite(FileTo, Buffer^, BytesRead);π {$I+}π MoreToCopy := (BytesRead = BytesToRead);π IoStatus := (IoResult=0);π end;π Close(FileTO);π Close(FileFrom);π FreeMem(Buffer, BytesToRead); {Release Heap memory}π If (not IoStatus) thenπ Writeln('Error copying File!!!');πend.π 6 05-28-9313:35ALL SWAG SUPPORT TEAM Copy File #6 IMPORT 33 ▐S»
{$A+,B-,D-,E+,F-,I+,L-,N-,O-,R+,S+,V-}π{$M 16384,65536,655360}ππProgram scopy;ππUsesπ Dos,π tpDos,π sundry,π Strings;ππTypeπ buffer_Type = Array[0..65519] of Byte;π buffptr = ^buffer_Type;ππVarπ f1,f2 : File;π fname1,π fname2,π NewFName,π OldDir : PathStr;π SRec : SearchRec;π errorcode : Integer;π buffer : buffptr;πConstπ MakeNewName : Boolean = False;π FilesCopied : Word = 0;π MaxHeapSize = 65520;ππFunction IOCheck(stop : Boolean; msg : String): Boolean;π Varπ error : Integer;π beginπ error := Ioresult;π IOCheck := (error = 0);π if error <> 0 then beginπ Writeln(msg);π if stop then beginπ ChDir(OldDir);π halt(error);π end;π end;π end;ππProcedure Initialise;π Varπ temp : String;π dir : DirStr;π name : NameStr;π ext : ExtStr;π beginπ if MaxAvail < MaxHeapSize then beginπ Writeln('Insufficient memory');π halt;π endπ elseπ new(buffer);π {I-} GetDir(0,OldDir); {$I+} if IOCheck(True,'') then;π Case ParamCount ofπ 0: beginπ Writeln('No parameters provided');π halt;π end;π 1: beginπ TempStr := ParamStr(1);π if not ParsePath(TempStr,fname1,fname2) then beginπ Writeln('Invalid parameter');π halt;π end;π {$I-} ChDir(fname2); {$I+} if IOCheck(True,'') then;π end;π 2: beginπ TempStr := ParamStr(1);π if not ParsePath(TempStr,fname1,fname2) then beginπ Writeln('Invalid parameter');π halt;π endπ elseπ {$I-} ChDir(fname2); {$I+} if IOCheck(True,'') then;ππ TempStr := ParamStr(2);π if not ParsePath(TempStr,fname2,temp) then beginπ Writeln('Invalid parameter');π halt;π end;π FSplit(fname2,dir,name,ext);π if length(name) <> 0 thenπ MakeNewName := True;π end;π else beginπ Writeln('too many parameters');π halt;π end;π end; { Case }π end; { Initialise }ππProcedure CopyFiles;π Varπ result : Word;ππ Function MakeNewFileName(fn : String): String;π Varπ temp : String;π dir : DirStr;π name : NameStr;π ext : ExtStr;π numb : Word;π beginπ numb := 0;π FSplit(fn,dir,name,ext);π Repeatπ inc(numb);π if numb > 255 then beginπ Writeln('Invalid File name');π halt(255);π end;π ext := copy(Numb2Hex(numb),2,3);π temp := dir + name + ext;π Writeln(temp);π Until not ExistFile(temp);π MakeNewFileName := temp;π end; { MakeNewFileName }πππ beginπ FindFirst(fname1,AnyFile,Srec);π While Doserror = 0 do beginπ if (SRec.attr and $19) = 0 then beginπ if MakeNewName thenπ NewFName := fname2π elseπ NewFName := SRec.name;π if ExistFile(NewFName) thenπ NewFName := MakeNewFileName(NewFName);π {$I-}π Writeln('Copying ',SRec.name,' > ',NewFName);π assign(f1,SRec.name);π reset(f1,1);π if { =1= } IOCheck(False,'1. Cannot copy '+fname1) then beginπ assign(f2,fname2);π reWrite(f2,1);π if IOCheck(False,'2. Cannot copy '+SRec.name) thenπ Repeatπ BlockRead(f1,buffer^,MaxHeapSize);π if IOCheck(False,'3. Cannot copy '+SRec.name) thenπ result := 0π else beginπ BlockWrite(f2,buffer^,result);π if IOCheck(False,'4. Cannot copy '+NewFName) thenπ result := 0;π end;π Until result < MaxHeapSize;π close(f1); close(f2);π if IOCheck(False,'Error While copying '+SRec.name) then;π end; { =1= }π end; { if SRec.attr }π FindNext(Srec);π end; { While Doserror = 0 }π end; { CopyFiles }ππbeginπ Initialise;π CopyFiles;π ChDir(OldDir);πend.ππ 7 05-28-9313:35ALL FLOOR A.C. NAAIJKENS Copy File with Display IMPORT 15 ▐S!┴ Hello Matthew!ππAnswering a msg of <Monday April 12 1993>, from Matthew Staikos to All:ππThe Norton-like bar along with the copying won't compile,πbut you get the idea, no?ππ {$I-}π function __copyfil(π show: boolean; x1,x2,y,f,b: byte; fs: longint; src, targ: stringπ ): byte;π {π return codes:π 0 successfulπ 1 source and target the sameπ 2 cannot open sourceπ 3 unable to create targetπ 4 error during copyπ 5 cannot allocate bufferπ }π constπ bufsize = 16384;ππ typeπ fbuf = array[1..bufsize] of char;π fbf = ^fbuf;ππ varπ source,π target : file;π bread,π bwrite : word;π filebuf : ^fbf;π tr : longint;π nr : real;ππ beginπ if memavail > bufsize then new(filebuf) else beginπ __copyfil := 5; exitπ end;π if src = targ then begin __copyfil := 1; exit end;π assign(source, src); reset(source,1);π if ioresult <> 0 then begin __copyfil := 2; exit end;π assign(target, targ); rewrite(target,1);π if ioresult <> 0 then begin __copyfil := 3; exit end;π if show then __write(x1+2,y,f,b,__rep(x2-x1-3,'░')); tr := 0;π repeatπ blockread(source,filebuf^,bufsize,bread);π tr := tr + bread; nr := tr/fs;π nr := nr * (x2-x1-3);π if show then __write(x1+2,y,f,b,__rep(trunc(nr), '█'));π blockwrite(target,filebuf^,bread,bwrite);π until (bread = 0) or (bread <> bwrite);π if show then __write(x1+2,y,f,b,__rep((x2-x1-3),'█'));π close(source); close(target);π if bread <> bwrite then __copyfil := 4 else __copyfil := 0;π end;π {$I-}πππππFloorππ--- GoldED 2.40π * Origin: UltiHouse/2 5 Years! V32b/HST/16k8: x31,13,638709 (2:512/195)π 8 05-28-9313:35ALL FLOOR A.C. NAAIJKENS Copy File from ECO-LIB IMPORT 14 ▐S.u {πNote : Functions beginning with "__" come from the ECO Library - Kerry.ππFLOOR A.C. NAAIJKENSππThe Norton-like bar along with the copying won't compileππ{$I-}πfunction __copyfil(show : boolean; x1, x2, y, f, b : byte;π fs : longint; src, targ : string) : byte;π{π return codes:π 0 successfulπ 1 source and target the sameπ 2 cannot open sourceπ 3 unable to create targetπ 4 error during copyπ 5 cannot allocate bufferπ}πconstπ bufsize = 16384;ππtypeπ fbuf = array[1..bufsize] of char;π fbf = ^fbuf;ππvarπ source,π target : file;π bread,π bwrite : word;π filebuf : ^fbf;π tr : longint;π nr : real;ππbeginπ if memavail > bufsize thenπ new(filebuf)π elseπ beginπ __copyfil := 5;π exitπ end;π if src = targ thenπ beginπ __copyfil := 1;π exitπ end;π assign(source, src);π reset(source,1);π if ioresult <> 0 thenπ beginπ __copyfil := 2;π exitπ end;π assign(target, targ);π rewrite(target,1);π if ioresult <> 0 thenπ beginπ __copyfil := 3;π exitπ end;π if show thenπ __write(x1 + 2 , y, f, b, __rep(x2 - x1 - 3, '░'));π tr := 0;π repeatπ blockread(source, filebuf^, bufsize, bread);π tr := tr + bread;π nr := tr / fs;π nr := nr * (x2 - x1 - 3);π if show thenπ __write(x1 + 2, y, f, b, __rep(trunc(nr), '█'));π blockwrite(target, filebuf^, bread, bwrite);π until (bread = 0) or (bread <> bwrite);π if show thenπ __write(x1 + 2, y, f, b, __rep((x2 - x1 - 3), '█'));π close(source);π close(target);π if bread <> bwrite thenπ __copyfil := 4π elseπ __copyfil := 0;πend;π{$I-}ππ 9 05-28-9313:35ALL SWAG SUPPORT TEAM FAST Copy File IMPORT 5 ▐Sç≡ {│o│ I want to make my buffer For the BlockRead command as │o║π│o│ large as possible. When I make it above 11k, I get an │o║π│o│ error telling me "too many Variables." │o║πUse dynamic memory, as in thanks a heap.π}πππif memavail > maxint { up to 65520 }πthen bufsize := maxintπelse bufsize := memavail;πif i<128πthen Exitmsg('No memory')πelse getmem(buf,bufsize);πππ 10 05-28-9313:35ALL SWAG SUPPORT TEAM Move File #1 IMPORT 49 ▐S─∞ {πI found a source * COPY.PAS * (don't know where anymore or who posted it) andπtried to Write my own move_Files Program based on it.ππThe simple idea is to move the Files specified in paramstr(1) to a destinationπdirectory specified in paramstr(2) and create the directories that do not yetπexist.ππOn a first look it seems just to work out ok. But yet it does not.ππto help me find the failure set paramstr(1) to any path you want (For exampleπD:\test\*.txt or whatever) and set paramstr(2) to a non existing path which isπC:\A\B\C\D\E\F\G\H\..\Z\A\B\C\D\E\F\ππThe directories C:\A through C:\A\B\C\D\F\..\Q\R\S will be created and than theπProgram hangs.ππWho can help me find what the mistake is?ππI Really will be grateful For any kind of help.ππThe code is:π}ππ{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,R+,S-,V+,X-}πProgram aMOVE;ππUsesπ Crt, Dos;πConstπ BufSize = 32768;πVarπ ioCode : Byte;π SrcFile, DstFile : File;π FileNameA,π FileNameB : String;π Buffer : Array[1..BufSize] of Byte;π RecsRead : Integer;π DiskFull : Boolean;π CurrDir : DirStr; {Aktuelles Verzeichnis speichern}π HelpList : Boolean; {Hilfe uber mogliche Parameter?}π i,π n : Integer;π str : String[1];ππ SDStr : DirStr; {Quellverzeichnis}π SNStr : NameStr; {Quelldateiname}π SEStr : ExtStr; {Quelldateierweiterung}ππ DDStr : DirStr; {Zielverzeichnis}π DNStr : NameStr; {Zieldateiname}π DEStr : ExtStr; {Zieldateierweiterung}ππ SrcInfo : SearchRec; {Liste der Quelldateien}π SubDirStr : Array [0..32] of DirStr;π key : Char;πππ Procedure SrcFileError(ioCode : Byte);π beginπ Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);π Case ioCode ofπ $01 : WriteLn(' Source File not found.');π $F3 : WriteLn(' too many Files open.');π else WriteLn(' "Reset" unknown I/O error.');π end;π end;ππ Procedure DstFileError(ioCode : Byte);π beginπ Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);π Case ioCode ofπ $F0 : WriteLn(' Disk data area full.');π $F1 : WriteLn(' Disk directory full.');π $F3 : WriteLn(' too many Files open.');π else WriteLn(' "ReWrite" unknown I/O error.');π end;π end;ππππProcedure EXPAR; {externe Parameter abfragen} beginπ GetDir(0,CurrDir); {Aktuelles Verzeichnis speichern}π if DDStr='' then DDStr:= CurrDir; {Wenn keine Zialangabe, dann insπ aktuelle Verzeichnis verschieben}π FSplit(paramstr(1), SDStr, SNStr, SEStr);πend;ππProcedure Copy2Dest;πbeginπ if FileNameB <> FileNameA thenπ beginπ Assign(SrcFile, FileNameA);π Assign(DstFile, FileNameB);π {* note second parameter in "reset" and "reWrite" of UNTyped Files. *}π {$I-} Reset(SrcFile, 1); {$I+}π ioCode := Ioresult;π if (ioCode <> 0) then SrcFileError(ioCode)π elseπ beginπ {$I-} ReWrite(DstFile, 1); {$I+}π ioCode := Ioresult;π if (ioCode <> 0) then DstFileError(ioCode)π elseπ beginπ DiskFull := False;π While (not EoF(SrcFile)) and (not DiskFull) doπ beginπ {* note fourth parameter in "blockread". *}π {$I-}π BlockRead(SrcFile, Buffer, BufSize, RecsRead);π {$I+}π ioCode := Ioresult;π if ioCode <> 0 thenπ beginπ SrcFileError(ioCode);π DiskFull := Trueπ endπ elseπ beginπ {$I-}π BlockWrite(DstFile, Buffer, RecsRead);π {$I+}π ioCode := Ioresult;π if ioCode <> 0 thenπ beginπ DstFileError(ioCode);π DiskFull := Trueπ endπ endπ end;π if not DiskFull then WriteLn(FileNameB)π end;π Close(DstFile)π end;π Close(SrcFile)π endπ else WriteLn(#7, 'File can not be copied onto itself.')πend;ππProcedure ProofDest;πbeginπ if length(paramstr(2)) > 67 then beginπ Writeln;π Writeln(#7,'Invalid destination directory specified.');π Writeln('Program aborted.');π Halt(1);π end;π FSplit(paramstr(2), DDStr, DNStr, DEStr);π if copy(DNStr,length(DNStr),1)<>'.' then beginπ insert(DNStr,DDStr,length(DDStr)+1);π DNStr:='';π end;π if copy(DDStr,length(DDStr),1)<>'\' thenπ insert('\',DDSTR,length(DDStr)+1);π SubDirStr[0]:= DDStr;π For i:= 1 to 20 do beginπ SubDirStr[i]:=copy(DDStr,1,pos('\',DDStr));π Delete(DDStr,1,pos('\',DDStr));π end;π For i:= 32 doWNto 1 do beginπ if SubDirStr[i]= '' then n:= i-1;π end;ππ DDStr:= SubDirStr[0];π SubDirStr[0]:='';ππ For i:= 1 to n do beginπ SubDirStr[0]:= SubDirStr[0]+SubDirStr[i];ππ if copy(SubDirStr[0],length(SubDirStr[0]),1)='\' thenπ delete(SubDirStr[0],length(SubDirStr[0]),1);ππ beginπ {$I-}π MkDir(SubDirStr[0]);π {$I+}π if Ioresult = 0 thenπ WriteLn('New directory created: ', SubDirStr[0]);π end;ππ if copy(SubDirStr[0],length(SubDirStr[0]),1)<>'\' thenπ insert('\',SubDirStr[0],length(SubDirStr[0])+1);π end;πend;ππProcedure HandleMove;πbeginπ FileNameA:= SDStr+SrcInfo.Name;π FileNameB:= DDStr+SrcInfo.Name;π Copy2Dest;π Erase(SrcFile);πend;ππProcedure ExeMove;πbeginπ ProofDest;π FindFirst(paramstr(1), AnyFile, SrcInfo);π While DosError = 0 do beginπ HandleMove;π FindNext(SrcInfo);π end;πend;ππππbeginπ SDStr:= '';π SNStr:= '';π SEStr:= '';π DDStr:= '';π DNStr:= '';π DEStr:= '';π For i:=0 to 32 do SubDirStr[i]:='';π ExPar;π ExeMove;πend.π 11 05-28-9313:35ALL SWAG SUPPORT TEAM Move File #2 IMPORT 7 ▐Så{ {π> How would I move a File from within my Program.ππif the File is to moved from & to the same partition,πall you have to do is:ππ Assign(F,OldPath);π Rename(F,NewPath);ππOn the other hand, if the File is to be moved to a differentπpartition, you will have to copy / erase the File.πExample:π}πProgram MoveFile;ππVarπ fin,fout : File;π p : Pointer;π w : Word;ππbeginπ GetMem(p,64000);π Assign(fin,ParamStr(1)); { Assumes command line parameter. }π Assign(fout,ParamStr(2));π Reset(fin);π ReWrite(fout);π While not Eof(fin) doπ beginπ BlockRead(fin,p^,64000,w);π BlockWrite(fout,p^,w);π end;π Close(fin);π Close(fout);π Erase(fin);π FreeMem(p,64000);πend.ππ{πThis Program has NO error control.π} 12 05-28-9313:35ALL SWAG SUPPORT TEAM Move File FAST IMPORT 13 ▐SÇ {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π {Allow overlays}π {$F+,O-,X+,A-}π{$ENDIF}ππUNIT MoveFile;ππINTERFACEππUSES Dos;ππFUNCTION MoveFiles ( VAR OldFullPath : PathStr;π VAR NewFullPath : PathStr) : BOOLEAN;ππIMPLEMENTATIONπππFUNCTION MoveFiles ( VAR OldFullPath : PathStr;π VAR NewFullPath : PathStr) : BOOLEAN;ππVARπ regs : REGISTERS;π Error_Return,π N : BYTE;ππ PROCEDURE MoveToNewPath;π { On same disk drive }π BEGINπ OldFullPath [LENGTH (OldFullPath) + 1] := CHR (0);π NewFullPath [LENGTH (NewFullPath) + 1] := CHR (0);π WITH regs DOπ BEGINπ DS := SEG (OldFullPath);π DX := OFS (OldFullPath) + 1; {the very first byte is the length}π ES := SEG (NewFullPath);π DI := OFS (NewFullPath) + 1;π AX := $56 SHL 8; { ERRORS are }π INTR ($21, regs); { 2 : file not found }π IF Flags AND 1 = 1 THEN { 3 : path not found }π error_return := AX { 5 : access denied }π ELSE { 17 : not same device }π error_return := 0;π END; {with}π END;ππBEGINπ Error_Return := 0;π IF OldFullPath [1] = '\' THEN OldFullPath := FExpand (OldFullPath);π IF NewFullPath [1] = '\' THEN NewFullPath := FExpand (NewFullPath);π IF UPCASE (OldFullPath [1]) = UPCASE (NewFullPath [1]) THEN MoveToNewPathπ ELSE Error_Return := 17;ππMoveFiles := (Error_Return = 0);πEND;ππEND. 13 05-28-9313:35ALL SWAG SUPPORT TEAM Rename File #1 IMPORT 6 ▐S╡╪ {π> Does anybody know how to do a "fast" move of a File?π> ie: not copying it but just moving the FAT Recordππ Yup. In Pascal you can do it With the Rename command. The Format is:ππ Rename (Var F; NewName : String)ππwhere F is a File Variable of any Type.ππto move a File Really fast, and to avoid having to copy it somewhere first andπthen deleting the original, do this:π}ππProcedure MoveIt; {No error checking done}πVarπ F : File;π FName : String;π NName : String;πbeginπ Assign (F, FName);π NName:= {new directory / File name}π Rename (F, NName);πEnd. 14 05-28-9313:35ALL SWAG SUPPORT TEAM Rename File #2 IMPORT 14 ▐S>ò {π>I am interested in the source in Assembler or TP to move a File from oneπ>directory to another by means of the FAT table. I have seen severalπ>small utilities to do this but I was unable to understand them afterπ>reverse engineering/disassembly. (Don't worry, they were PD). <G>π>Anyway, any help would be appreciated. Thanks.ππYou don't Really need to do much. Dos Interrupt (21h), Function 56h, willπrename a File, and in essence move it if the source and destinationπdirectories are not the same. That's all there is to it. I know Functionπ56h is available in Dos 3.3 and above. I am not sure about priorπversions.ππOn entry: AH 56Hπ DS:DX Pointer to an ASCIIZ String containing the drive, path,π and Filename of the File to be renamed.π ES:DI Pointer to an ASCIIZ String containing the new path andπ FilenameπOn return AX Error codes if carry flag set, NONE if carry flag not setππBelow is some crude TP code I Typed on the fly. It may not be exactly rightπbut you get the idea.π}ππUsesπ Dos;πVarπ Regs : Registers;π Source,π Destination : PathStr;ππbeginπ { Add an ASCII 0 at the end of the Strings to male them ASCIIZπ Strings, without actually affecting their actual lengths }π Source[ord(Source[0])] := #0;π Destination[ord(Destination[0])] := #0;ππ { Set the Registers }π Regs.AH := $56;π Regs.DS := Seg(Source[1]);π Regs.DX := ofs(Source[1]);π Regs.ES := Seg(Destination[1]);π Regs.DI := ofs(Destination[1]);ππ { Do the Interrupt }π Intr($21,Regs);πend.π 15 05-28-9313:35ALL SWAG SUPPORT TEAM Move File with Rename IMPORT 8 ▐S'╠ {π│ I am interested in the source in Asm or TP to move a File from oneπ│ directory to another by means of the FAT table.ππAll you have to do is use the Rename Procedure. It isn't done via theπFAT table, but via Dos Function 56h. The only restrictions are (1)πyou must be running on Dos 2.0 or greater, and (2) the original andπtarget directories must be on the same drive. The code might lookπsomething like this:π}ππFunction MoveFile( FileName, NewDir: Dos.PathStr ): Boolean;πVarπ f: File;π OldDir: Dos.DirStr;π Nam: Dos.NameStr;π Ext: Dos.ExtStr;πbeginπ Dos.FSplit( FileName, OldDir, Nam, Ext );π if NewDir[ Length(NewDir) ] <> '\' thenπ NewDir := NewDir + '\';π {$I-}π Assign( f, FileName );π FileName := NewDir + Nam + Ext;π Rename( f, FileName );π MoveFile := (Ioresult=0);π {$I+}πend; { MoveFile }π 16 06-22-9307:50ALL SWAG SUPPORT TEAM Copy/Move Files Anywhere IMPORT 49 ▐Sö▌ {$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}π{$M 16384,0,655360}ππUSES DOS,Crt;ππ TYPEππ { Define action type MOVE or COPY }π cTYPE = (cMOVE,cCOPY);ππ { Define the special structure of a DOS Disk Transfer Area (DTA) }π DTARec = RECORDπ Filler : ARRAY [1..21] OF BYTE;π Attr : BYTE;π Time : WORD;π Date : WORD;π Size : LONGINT;π Name : STRING [12];π END {DtaRec};ππVARπ OK : Integer;π IP,OP : PathStr; { input,output file names }ππ FUNCTION Copier (cWhat : cTYPE; VAR orig: STRING;VAR nName: STRING) : Integer;ππ { Copy or Move file through DOS if not on same disk. Retain original date,π time and size and delete the original on Move. The beauty here is thatπ we can move files across different drives. Also, we can rename file ifπ we choose. If error, function returns error number }πππ CONST bufsize = $C000; { About 48 KB - 49152 }ππ TYPEπ fileBuffer = ARRAY [1..bufsize] OF BYTE;ππ VAR Regs: registers;π src,dst: INTEGER;π bsize,osize: LONGINT;π buffer : ^fileBuffer;π DTABlk : DTARec;π fError : BOOLEAN;ππ FUNCTION CheckError(err : Integer) : BOOLEAN;π BEGINπ CheckError := (Err <> 0);π fError := (Err <> 0);π Copier := err;π END;ππ PROCEDURE delfile (VAR fName: STRING);ππ VAR Regs: registers;ππ BEGINπ WITH Regs do BEGINπ ah := $43; { Make file R/W for delete }π al := 1;π cx := 0; { Normal file }π ds := Seg(fName[1]); { fName is the fully qualified }π dx := Ofs(fName[1]); { pathname of file, 0 terminated }π MsDos (Regs);π IF CheckError(Flags AND 1) THEN EXITπ ELSE BEGINπ ah := $41; { Delete file through fName }π { ds:dx stil valid from set-attributes }π MsDos (Regs);π IF CheckError(Flags AND 1) THEN EXIT;π ENDπ ENDπ END;ππ BEGINππ Copier := 0; { Assume Success }π FindFirst(Orig,Anyfile,SearchRec(DTABlk));π IF CheckError(DosError) THEN EXIT;ππ WITH Regs DO BEGINπ ah := $3D; { Open existing file }π al := 0; { Read-only }π ds := Seg(orig[1]); { Original filename (from) }π dx := Ofs(orig[1]);π MsDos (Regs);π IF CheckError(Flags AND 1) THEN Exitπ ELSE BEGINπ src := ax; { Handle of the file }ππ ah := $3C; { Create a new file }π cx := 0; { Start as normal file }π ds := Seg(nName[1]); { Pathname to move TO }π dx := Ofs(nName[1]);π MsDos (Regs);π IF CheckError(Flags AND 1) THEN Exitπ ELSEπ dst := axπ ENDπ END;ππ osize := DTABlk.size; { Size of file, from "findfirst" }π WHILE (osize > 0) AND NOT ferror DO BEGINππ IF osize > bufsize THENπ bsize := bufsize { Too big for buffer, use buffer size }π ELSEπ bsize := osize;ππ IF BSize > MAXAVAIL THEN BSize := MAXAVAIL;ππ GETMEM (buffer, BSize); { Grap some HEAP memory }ππ WITH Regs DO BEGINπ ah := $3F; { Read block from file }π bx := src;π cx := bsize;π ds := Seg(buffer^);π dx := Ofs(buffer^);π MsDos (Regs);π IF CheckError(Flags AND 1) THEN {}π ELSE BEGINπ ah := $40; { Write block to file }π bx := dst;π { cx and ds:dx still valid from Read }π MsDos (Regs);π IF CheckError(Flags AND 1) THEN {}π ELSE IF ax < bsize THENπ BEGINπ CheckError(98); { disk full }π ENDπ ELSEπ osize := osize - bsizeπ END;π END;ππ FREEMEM (buffer, BSize); { Give back the memory }π END;ππ IF NOT ferror AND (cWHAT = cMOVE) THENπ WITH Regs DOπ BEGINπ ah := $57; { Adjust date and time of file }π al := 1; { Set date }π bx := dst;π cx := DTABlk.time; { Out of the "find" }π dx := DTABlk.date;π MsDos (Regs);π CheckError(Flags AND 1);π END;ππ WITH Regs DOπ BEGINπ ah := $3E; { Close all files, even with errors! }π bx := src;π MsDos (Regs);π ferror := ferror OR ((flags AND 1) <> 0);π ah := $3E;π bx := dst;π MsDos (Regs);π ferror := ferror OR ((flags AND 1) <> 0)π END;ππ IF ferror THEN EXIT { we had an error somewhere }π ELSE WITH Regs DOπ BEGINπ ah := $43; { Set correct attributes to new file }π al := 1; { Change attributes }π cx := DTABlk.attr; { Attribute out of "find" }π ds := Seg(nName[1]);π dx := Ofs(nName[1]);π MsDos (Regs);π IF CheckError(Flags AND 1) THEN EXITπ ELSEπ If (cWHAT = cMOVE) THEN DelFile (orig) { Now delete the original }π END { if we are moving file }π END;ππBEGINπclrscr;πIP := 'queen1.PAS';πOP := 'd:\temp\queen1.pas';πOK := Copier(cCOPY,IP,OP);πWriteLn(OK);πEND. 17 08-17-9308:42ALL SWAG SUPPORT TEAM An OOP FILECOPY IMPORT 13 ▐SÇ( PROGRAM FileCopyDemo; { FILECOPY.PAS }ππUSES Crt;ππTYPEπ Action = (Input, Output);π DataBlk = array[1..512] of byte;π FileObj = OBJECTπ fp : FILE;π CONSTRUCTOR OpenFile(FileName: string;π FileAction: Action);π PROCEDURE ReadBlock(VAR fb: DataBlk;π VAR Size: integer);π PROCEDURE WriteBlock(fb: DataBlk;π size: integer);π DESTRUCTOR CloseFile;π END;ππCONSTRUCTOR FileObj.OpenFile;πBEGINπ Assign(fp, FileName);π CASE FileAction ofπ Input: BEGINπ Reset(fp, 1);π IF IOResult <> 0 THENπ BEGINπ WriteLn(FileName, ' not found!');π Halt(1);π END;π WriteLn(FileName,' opened for read ... ');π END;π Output: BEGINπ Rewrite(fp, 1);π WriteLn(FileName,' opened for write ... ');π END;π END; {CASE}πEND;ππDESTRUCTOR FileObj.CloseFile;πBEGINπ Close(fp);π WriteLn('File closed ...');πEND;ππPROCEDURE FileObj.ReadBlock;πBEGINπ BlockRead(fp, fb, SizeOf(fb), Size);π WriteLn('Reading ', Size, ' bytes ... ');πEND;ππPROCEDURE FileObj.WriteBlock;πBEGINπ BlockWrite(fp, fb, Size);π WriteLn('Writing ', Size, ' bytes ... ');πEND;ππVARπ InFile, OutFile : FileObj;π Data: DataBlk;π Size: integer;ππBEGINπ ClrScr;π InFile.OpenFile('FILECOPY.PAS', Input);π OutFile.OpenFile('FILECOPY.CPY', Output);π REPEATπ InFile.ReadBlock(Data, Size);π OutFile.WriteBlock(Data, Size);π UNTIL Size <> SizeOf(DataBlk);π InFile.CloseFile;π OutFile.CloseFile;π Write('Press Enter to quit ... ');π ReadLn;πEND.π 18 08-27-9320:52ALL MARK LEWIS Copy file in EMS IMPORT 21 ▐SB| { MARK LEWIS }ππPROGRAM EMSCopy;ππUSESπ Objects; {The Object unit is need to access TStream}ππVARπ InFile,π OutFile : PStream; {Pointer to InPut/OutPut Files}π EmsStream : PStream; {Pointer to EMS Memory Block}π InPos : LongInt; {Where are we in the Stream}ππBEGINπ Writeln;π Writeln(' EMSCopy v1.00');π Writeln;π Writeln('{ Mangled together from code in the FIDO PASCAL Echo }');π Writeln('{ Assembled by Mark Lewis }');π Writeln('{ Some ideas and code taken from examples by }');π Writeln('{ DJ Murdoch and Todd Holmes }');π Writeln('{ Released in the Public Domain }');π Writeln;π If ParamCount < 2 Thenπ Beginπ Writeln('Usage: EMSCopy <Source_File> <Destination_File>');π Halt(1);π End;ππ Infile := New(PBufStream, init(paramstr(1), stOpenRead, 4096));π If (InFile^.Status <> stOK) Thenπ Beginπ Writeln(#7, 'Error! Source File Not Found!');π InFile^.Reset;π Dispose(InFile, Done);π Halt(2);π End;ππ Outfile := New(PBufStream, init(paramstr(2), stCreate, 4096));π If (OutFile^.Status <> stOK) Thenπ Beginπ Writeln(#7,'Error! Destination File Creation Error!');π OutFile^.Reset;π Dispose(OutFile, Done);π Halt(3);π End;ππ EmsStream := New(PEmsStream, Init (16000, InFile^.GetSize));π If (EmsStream^.Status <> stOK) Thenπ Beginπ Writeln(#7, 'Error! EMS Allocation Error!');π Writeln('At Least One Page of EMS Required :(');π EmsStream^.Reset;π Dispose(EmsStream, Done);π Halt(4);π End;ππ Writeln('InPut File Size : ', InFile^.Getsize : 10, ' Bytes');π InPos := EmsStream^.GetSize;π Repeatπ Write('Filling EMS Buffer... ');π EmsStream^.CopyFrom(InFile^, InFile^.GetSize - InPos);π if (EmsStream^.Status <> stOK) thenπ EmsStream^.Reset;ππ InPos := InPos + EmsStream^.GetSize;π Write(EmsStream^.GetSize : 10, ' Bytes ');π EmsStream^.Seek(0);π Write('Writing DOS File... ');π OutFile^.CopyFrom(EmsStream^, EmsStream^.GetSize);π Writeln(OutFile^.Getsize : 10, ' Bytes');π If (InFile^.Status <> stOK) Thenπ InFile^.Reset;π If (OutFile^.GetSize < InFile^.GetSize) Thenπ Beginπ EmsStream^.Seek(0);π EmsStream^.Truncate;π InFile^.Seek(InPos);π End;π Until (OutFile^.GetSize = InFile^.GetSize);π Writeln('Done!');π DISPOSE(InFile, Done);π DISPOSE(OutFile, Done);π DISPOSE(EmsStream, Done);πEND.π 19 10-28-9311:33ALL GUY MCLOUGHLIN File Copy Routine IMPORT 114 ▐S╖> π (* Compiler directives. *)π {$A+,B-,D-,E-,F-,I+,N-,O-,R-,S-,V+}ππ (* STACK, HEAP memory directives. *)π {$M 1024, 0, 0}ππ (* Public domain file-copy program. *)π (* Guy McLoughlin - August 23, 1992. *)πprogram MCopy;ππuses (* We need this unit for the paramcount, paramstr, *)π Dos; (* fsearch, fexpand, fsplit routines. *)ππconstπ (* Carridge-return + Line-feed constant. *)π coCrLf = #13#10;ππ (* Size of the buffer we're going to use. *)π coBuffSize = 61440;ππtypeπ (* User defined file read/write buffer. *)π arBuffSize = array[1..coBuffSize] of byte;ππvarπ (* Path display width. *)π byDispWidth : byte;ππ (* Variable to record the number of files copied. *)π woCopyCount,π (* Variable to record the number of bytes read. *)π woBytesRead,π (* Variable to record the number of bytes written. *)π woBytesWritten : word;ππ (* Variable to record the size in bytes of IN-file. *)π loInSize,π (* Variable to record the number of bytes copied. *)π loByteProc : longint;ππ (* Variables for TP "Fsplit" routine. *)π stName : namestr;π stExt : extstr;ππ (* Directory-string variables. *)π stDirTo,π stDirFrom : dirstr;ππ (* Path-string variables. *)π stPathTo,π stPathFrom,π stPathTemp : pathstr;ππ (* Array used to buffer file reads/writes. *)π arBuffer : arBuffSize;ππ (* Directory search-record. *)π rcSearchTemp : searchrec;ππ (* IN file-variable. *)π fiIN,π (* OUT file-variable. *)π fiOUT : file;πππ (***** Handle file errors. *)π procedure ErrorHandler( byErrorNum : byte);π beginπ case byErrorNum ofππ 1 : beginπ writeln(coCrLf, ' (SYNTAX) MCOPY <path1><filespec1>' +π ' <path2><filename2>');π writeln(coCrLf, ' (USAGE) MCOPY c:\utils\*.doc' +π ' c:\temp\master.doc');π writeln(' MCOPY \utils\*.doc ' +π '\temp\master.doc');π writeln(coCrLf, ' (Copies all files with the ''.doc''' +π ' extension from ''c:\utils'')');π writeln(' (directory, to ''master.doc'' in the ' +π '''c:\temp'' directory. )');π writeln(coCrLf, ' ( Public-domain utility by Guy ' +π 'McLoughlin \ August 1992 )')π end;ππ 2 : writeln(coCrLf,π ' Error : <path1><filespec1> = <path2><filename2>');ππ 3 : writeln(coCrLf, ' Directory not found ---> ', stDirFrom);ππ 4 : writeln(coCrLf, ' Directory not found ---> ', stDirTo);ππ 5 : writeln(coCrLf, ' Error opening ---> ', stPathTo);ππ 6 : writeln(coCrLf, ' File copy aborted');ππ 7 : writeln(coCrLf, ' Error creating ---> ', stPathTo);ππ 8 : writeln(coCrLf, ' Error opening ---> ', stPathTemp);ππ 9 : writeln(coCrLf, ' Error with disk I/O ')ππ end; (* case byErrorNum. *)ππ haltπ end; (* ErrorHandler. *)πππ (***** Determine if a file exists. *)π function FileExist(FileName : pathstr) : boolean;π beginπ FileExist := (FSearch(FileName, '') <> '')π end; (* FileExist. *)πππ (***** Determine if a directory exists. *)π function DirExist(stDir : dirstr) : boolean;π varπ woFattr : word;π fiTemp : file;π beginπ assign(fiTemp, (stDir + '.'));π getfattr(fiTemp, woFattr);π if (doserror <> 0) thenπ DirExist := falseπ elseπ DirExist := ((woFattr and directory) <> 0)π end; (* DirExist. *)πππ (***** Clear the keyboard-buffer. *)π procedure ClearKeyBuff; assembler;π asmπ @1: mov ah, 01hπ int 16hπ jz @2π mov ah, 00hπ int 16hπ jmp @1π @2:π end; (* ClearKeyBuff *)πππ (***** Read a key-press. *)π function ReadKeyChar : char; assembler;π asmπ mov ah, 00hπ int 16hπ end; (* ReadKeyChar. *)πππ (***** Obtain user's choice. *)π function UserChoice : char;π varπ Key : char;π beginπ ClearKeyBuff;π repeatπ Key := upcase(ReadKeyChar)π until (Key in ['A', 'O', 'Q']);π writeln(Key);π UserChoice := Keyπ end; (* UserChoice. *)πππ (***** Returns all valid wildcard names for a specific directory.*)π (* When the last file is found, the next call will return an *)π (* empty string. *)π (* *)π (* NOTE: Standard TP DOS unit must be listed in your program's *)π (* "uses" directive, for this routine to compile. *)ππ function WildCardNames({ input} stPath : pathstr;π woAttr : word;π {update} var stDir : dirstr;π var rcSearch : searchrec)π {output} : pathstr;π varπ (* Fsplit variables. *)π stName : namestr;π stExt : extstr;π beginπ (* If the search-record "name" field is empty, then *)π (* initialize it with the first matching file found. *)π if (rcSearch.name = '') thenπ beginπ (* Obtain directory-string from passed path-string. *)π fsplit(stPath, stDir, stName, stExt);ππ (* Find first match of path-string. *)π findfirst(stPath, woAttr, rcSearch);ππ (* If a matching file was found, then return full *)π (* path-name. *)π if (doserror = 0) and (rcSearch.name <> '') thenπ WildCardNames := (stDir + rcSearch.name)π elseπ (* No match found, return empty string. *)π WildCardNames := ''π endπ elseπ (* Search-record "name" field is not empty, so *)π (* continue searching for matches. *)π beginπ findnext(rcSearch);ππ (* If no error occurred, then match was found... *)π if (doserror = 0) thenπ WildCardNames := (stDir + rcSearch.name)π elseπ (* No match found. Re-set search-record "name" field, *)π (* and return empty path-string. *)π beginπ rcSearch.name := '';π WildCardNames := ''π endπ endπ end;πππ (***** Pad a string with extras spaces on the right. *)π function PadR(stIn : string; bySize : byte) : string;π beginπ fillchar(stIn[succ(length(stIn))], (bySize - length(stIn)) ,' ');π inc(stIn[0], (bySize - length(stIn)));π PadR := stInπ end; (* PadR. *)πππ (* Main program execution block. *)πBEGINπ (* If too many or too few parameters, display syntax. *)π if (paramcount <> 2) thenπ ErrorHandler(1);ππ (* Assign program parameters to string variables. *)π stPathFrom := paramstr(1);π stPathTo := paramstr(2);ππ (* Make sure full path-string is used. *)π stPathFrom := fexpand(stPathFrom);π stPathTo := fexpand(stPathTo);π stPathTemp := stPathFrom;ππ (* Check if IN-Filename is the same as OUT-Filename. *)π if (stPathFrom = stPathTo) thenπ ErrorHandler(2);ππ (* Seperate directory-strings from path-strings. *)π fsplit(stPathFrom, stDirFrom, stName, stExt);π fsplit(stPathTo, stDirTo, stName, stExt);ππ (* Make sure that "From" directory exists. *)π if NOT DirExist(stDirFrom) thenπ ErrorHandler(3);ππ (* Make sure that "To" directory exists. *)π if NOT DirExist(stDirTo) thenπ ErrorHandler(4);ππ (* Determine the full path display width. *)π if (stDirFrom[0] > stDirTo[0]) thenπ byDispWidth := length(stDirFrom) + 12π elseπ byDispWidth := length(stDirTo) + 12;ππ (* Check if the OUT-File does exist, then... *)π if FileExist(stPathTo) thenπ beginπ (* Ask if user wants to append/overwrite file or quit.*)π writeln(coCrLf, ' File exists ---> ', stPathTo);π write(coCrLf, ' Append / Overwrite / Quit [A,O,Q]? ');ππ (* Obtain user's response. *)π case UserChoice ofπ 'A' : beginπ (* Open the OUT-file to write to it. *)π assign(fiOUT, stPathTo);π {$I-}π reset(fiOUT, 1);π {$I+}ππ (* If there is an error opening the OUT-file, inform *)π (* the user of it, and halt the program. *)π if (ioresult <> 0) thenπ ErrorHandler(5);ππ (* Seek to end of file, so that data can be appended. *)π seek(fiOUT, filesize(fiOUT))π end;ππ 'O' : beginπ (* Open the OUT-file to write to it. *)π assign(fiOUT, stPathTo);π {$I-}π rewrite(fiOUT, 1);π {$I+}ππ (* If there is an error opening the OUT-file, inform *)π (* the user of it, and halt the program. *)π if (ioresult <> 0) thenπ ErrorHandler(5)π end;ππ 'Q' : ErrorHandler(6)ππ end (* case UserChoice. *)ππ endππ else (* OUT-file does not exist. *)ππ beginπ (* Create the OUT-file to write to. *)π assign(fiOUT, stPathTo);π {$I-}π rewrite(fiOUT, 1);π {$I+}ππ (* If there is an error creating the OUT-file, inform *)π (* the user of it, and halt the program. *)π if (ioresult <> 0) thenπ ErrorHandler(7)π end;ππ (* Clear the search-record, before begining. *)π fillchar(rcSearchTemp, sizeof(rcSearchTemp), 0);ππ (* Initialize copy-counter. *)π woCopyCount := 0;ππ (* Set current file-mode to "read-only". *)π filemode := 0;ππ writeln;ππ (* Repeat... ...Until (stPathTemp = ''). *)π repeatπ (* Search for vaild filenames. *)π stPathTemp := WildCardNames(stPathTemp, archive, stDirFrom,π rcSearchTemp);ππ (* If file search was successful, then... *)π if (stPathTemp <> '') thenπ beginπ (* Open the IN-file to read it. *)π assign(fiIN, stPathTemp);π {$I-}π reset(fiIN, 1);π {$I+}ππ (* If there is an error opening the IN-file, inform *)π (* the user of it, and halt the program. *)π if (ioresult <> 0) thenπ beginπ close(fiOUT);π erase(fiOUT);π ErrorHandler(8)π end;ππ (* Determine the size of the IN-file. *)π loInSize := filesize(fiIN);ππ (* Set the number of bytes processed to 0. *)π loByteProc := 0;ππ (* Repeat... ...Until the IN-file has been completely *)π (* copied. *)π repeatππ (* Read the IN-file into the file-buffer. *)π blockread(fiIN, arBuffer, coBuffSize, woBytesRead);ππ (* Write the file-buffer to the OUT-file. *)π blockwrite(fiOUT, arBuffer, woBytesRead, woBytesWritten);ππ (* If there is a problem writing the bytes to the *)π (* OUT-file, let the user know, and halt the program. *)π if (woBytesWritten <> woBytesRead) thenπ beginπ close(fiIN);π close(fiOUT);π erase(fiOut);π ErrorHandler(9)π endπ elseπ (* Advance the bytes-processed variable by the *)π (* number of bytes written to the OUT-file. *)π inc(loByteProc, woBytesWritten)ππ (* Repeat... ...Until the complete IN-file has been *)π (* processed. *)π until (loByteProc = loInSize);ππ (* Close the IN-file that has been copied. *)π close(fiIN);ππ (* Increment copy-counter by 1. *)π inc(woCopyCount);ππ (* Let the user know that we've finished copying file.*)π writeln(' ', PadR(stPathTemp, byDispWidth),' COPIED TO ---> ',π stPathTo);ππ end (* If (stPathTemp <> '') then... *)ππ (* Repeat... ...Until no more files are found. *)π until (stPathTemp = '');ππ (* Close the OUT-file. *)π close(fiOUT);ππ (* Display the number of files copied. *)π if (woCopyCount = 0) thenπ beginπ erase(fiOut);π writeln(coCrLf, ' No matching files found ---> ', stPathFrom)π endπ elseπ writeln(coCrLf, ' ', woCopyCount, ' Files copied')πEND.πππ 20 11-02-9317:51ALL IAN LIN Simple File Copy IMPORT 10 ▐Sæ {πFrom: IAN LINπTo just copy files, use buffers on the heap. Just make an array type that'sπalmost 64k in size. Use as many of these as needed that can fit in RAM andπblockread the data in. After you blockread all you can, close the file ifπit's been fully read in. If it hasn't then don't close the input file yet.πNext you open the output file and dump everything in each buffer withπblockwrite. If you're done now, close both files, otherwise keep readingπall you can at once from the input file and blockwriting it to the outputπfile. }ππtypeπ pbuf=^buf;π buf=recordπ n:pbuf;π b:array [1..65530] of byte;π end;πvarπ buffer,bufp:pbuf;π bufc:byte;π outf,f:file;πbeginπ bufp:=new(buffer);π assign(f,'IT');π reset(f,1);π blockread(f,bufp^,sizeof(bufp^);π assign(outf,'OTHER');π rewrite(outf,1);π blockwrite(outf,bufp^,sizeof(bufp^);π close(f);π close(outf);πend.ππThis is just an example so don't expect it to be very useful. :)ππFor text files, if you want to modify them, you may want to use linkedπlists which point to a line at a time. Remove unwanted lines from the list,πand then write it to the output file.π
