home *** CD-ROM | disk | FTP | other *** search
- Unit MfmCopy;
- {========================================================================}
- Interface
- Uses
- Dos;
- Procedure DoFileCopy(FromFileName, ToFileName : PathStr);
- {========================================================================}
- Implementation
- Type
- BufPtrType = ^BufRecordType;
- BufRecordType = Record
- Next : BufPtrType;
- Buffer : Array[1..$7FFF] Of Byte;
- NumRead : Word;
- End;
- Var
- InFile, OutFile : File;
- NumRead, NumWritten : Word;
- FromFileName, ToFileName : PathStr;
- Current, First, Old : BufPtrType;
- TimeTransfer : LongInt;
- {========================================================================}
- Procedure DoFileCopy(FromFileName, ToFileName : PathStr);
- Begin
- If MaxAvail > SizeOf(Current^.Buffer) Then
- Begin
- Assign(InFile, FromFileName);
- Reset(InFile, 1);
- Assign(OutFile, ToFileName);
- Rewrite(OutFile, 1);
- Repeat
- First := NIL;
- Repeat
- If MaxAvail > SizeOf(Current^.Buffer) Then
- Begin
- Old := Current;
- New(Current);
- If First = NIL Then First := Current Else Old^.Next := Current;
- BlockRead(InFile,Current^.Buffer,SizeOf(Current^.Buffer),NumRead);
- End;
- Current^.NumRead := NumRead;
- Until (NumRead = 0) Or (SizeOf(Current^.Buffer) <> NumRead) Or (MaxAvail < SizeOf(Current^.Buffer));
- Current^.Next := NIL;
- Current := First;
- Repeat
- BlockWrite(OutFile,Current^.Buffer,Current^.NumRead,NumWritten);
- Old := Current;
- NumRead := Current^.NumRead;
- Current := Current^.Next;
- If Old <> NIL Then Dispose(Old);
- Until Current = NIL;
- Until (NumRead < SizeOf(Current^.Buffer)) Or (NumWritten <> NumRead);
- GetFTime(InFile,TimeTransfer); SetFTime(OutFile,TimeTransfer);
- Close(InFile);
- Close(OutFile);
- End;
- End;
- {========================================================================}
- Begin
- End.
- {========================================================================}
-