SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00018 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 SWAG SUPPORT TEAM 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 SWAG SUPPORT TEAM 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 ▐S { 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.π
