[Back to OOP SWAG index] [Back to Main SWAG index] [Original]
{************************************************}
{ }
{ Turbo Pascal 6.0 }
{ Turbo Vision Utilities }
{ Written (w) 1993 by Andres Cvitkovich }
{ }
{ Public Domain }
{ }
{************************************************}
Unit TVUtis;
{$F+,O+,S-,D-,B-}
Interface
Uses Dos, Objects, Views, App;
Type
PProgressBar = ^TProgressBar;
TProgressBar = Object (TView)
empty, filled: Char;
total: LongInt;
percent: Word;
Constructor Init (Var Bounds: TRect; ch_empty,
ch_filled: Char; totalwork: LongInt);
Procedure Draw; virtual;
Procedure SetTotal (newtotal: LongInt);
Procedure Update (nowdone: LongInt); virtual;
Procedure UpdatePercent (newpercent: Integer); virtual;
end;
PFileCopy = ^TFileCopy;
TFileCopy = Object
bufsize: Word;
buffer: Pointer;
ConstRUCTOR Init (BufferSize: Word);
Destructor Done; VIRTUAL;
Function SetBufferSize (newsize: Word): Word; VIRTUAL;
Function CopyFile (File1, File2: PathStr): Integer; VIRTUAL;
Procedure Progress (Bytesdone, Bytestotal: LongInt;
percent: Integer); VIRTUAL;
Function Error (code: Word): Integer; VIRTUAL;
end;
Implementation
Uses drivers;
Constructor TProgressBar.Init (Var Bounds: TRect; ch_empty, ch_filled: Char;
totalwork: LongInt);
begin
TView.Init (Bounds);
total := totalwork;
empty := ch_empty;
filled := ch_filled;
percent := 0;
end;
Procedure TProgressBar.Draw;
Var
S: String;
B: TDrawBuffer;
C: Byte;
y: Byte;
newbar: Word;
begin
if (Size.X * Size.Y) = 0 then Exit; { Exit if no extent }
C := GetColor (6);
MoveChar (B, empty, C, Size.X);
MoveChar (B, filled, C, Size.X * percent div 100);
WriteLine (0, 0, Size.X, Size.Y, B);
end;
Procedure TProgressBar.SetTotal (newtotal: LongInt);
begin
total := newtotal
end;
Procedure TProgressBar.Update (nowdone: LongInt);
Var newpercent: Word;
begin
if total=0 then Exit;
newpercent := 100 * nowdone div total;
if newpercent > 100 then newpercent := 100;
if percent <> newpercent then begin
percent := newpercent;
DrawView
end;
end;
Procedure TProgressBar.UpdatePercent (newpercent: Integer);
begin
if newpercent > 100 then newpercent := 100;
if percent <> newpercent then begin
percent := newpercent;
DrawView
end;
end;
{
TFileCopy.Init
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
initializes the Object and allocates memory
BufferSize size of buffer in Bytes to be allocated For disk i/o
}
ConstRUCTOR TFileCopy.Init (BufferSize: Word);
begin
If MaxAvail < BufferSize Then
bufsize := 0
Else
bufsize := BufferSize;
If bufsize > 0 Then GetMem (buffer, bufsize);
end;
{
TFileCopy.Done
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Destructor, free up buffer memory
}
Destructor TFileCopy.Done;
begin
If bufsize > 0 Then FreeMem (buffer, bufsize);
{ bufsize := 0; } { man weiá ja nie... }
end;
{
TFileCopy.SetBufferSize
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
change buffer size
NewSize = new size of disk i/o buffer in Bytes
}
Function TFileCopy.SetBufferSize (newsize: Word): Word;
begin
If MaxAvail >= newsize Then begin
If bufsize > 0 Then FreeMem (buffer, bufsize);
bufsize := newsize;
If bufsize > 0 Then GetMem (buffer, bufsize);
end;
SetBufferSize := bufsize
end;
{
TFileCopy.CopyFile
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
copy a File onto another; no wildcards allowed
calls Progress and Error
File1 source File
File2 target File
Error code returned:
1 low on buffer memory
2 error opening source File
3 error creating destination File
4 error reading from source File
5 error writing to destination File
6 error writing File date/time and/or attributes
}
Function TFileCopy.CopyFile (File1, File2: PathStr): Integer;
Var fsrc, fdest: File;
fsize, ftime, cnt, cnt1: LongInt;
fattr, rd, wr, iores: Word;
begin
{$I-}
If bufsize = 0 then begin CopyFile := 1; Exit end;
Assign (fsrc, File1);
Repeat
Reset (fsrc, 1);
iores := IOResult;
If iores <> 0 Then
If Error (iores) = 1 Then begin
CopyFile := 2;
Exit
end;
Until iores = 0;
Assign (fdest, File2);
Repeat
ReWrite (fdest, 1);
iores := IOResult;
If iores <> 0 Then
If Error (iores) = 1 Then begin
Close (fsrc);
CopyFile := 3;
Exit
end;
Until iores = 0;
fsize := FileSize (fsrc);
GetFTime (fsrc, ftime);
GetFAttr (fsrc, fattr);
Repeat
Repeat
cnt := FilePos (fsrc);
BlockRead (fsrc, buffer^, bufsize, rd);
iores := IOResult;
If iores <> 0 Then begin
If Error (iores) = 1 Then begin {abort?}
Close (fsrc); {* }
Close (fdest); {* hier k�nnte man auch}
Erase (fdest); {* Error aufrufen, naja...}
CopyFile := 4;
Exit;
end;
Seek (fsrc, cnt); {step back on retry!}
end;
Until iores = 0;
if rd > 0 then
Repeat
cnt1 := FilePos (fdest);
BlockWrite (fdest, buffer^, rd, wr);
iores := IOResult;
If (rd <> wr) or (iores <> 0) Then begin
If Error (iores) = 1 Then begin {abort?}
Close (fsrc); {* }
Close (fdest); {* hier k�nnte man auch}
Erase (fdest); {* Error aufrufen, naja...}
CopyFile := 5;
Exit;
end;
Seek (fdest, cnt1); {step back on retry!}
end;
Until (rd = wr) and (iores = 0);
Progress (cnt, fsize, cnt * 100 div fsize);
Until (rd = 0) or (rd <> wr);
Close (fsrc);
Repeat
Close (fdest); {close&flush}
iores := IOResult;
If iores <> 0 Then If Error (iores) = 1 Then Exit;
Until iores = 0;
Reset (fdest);
If IOResult <> 0 Then begin CopyFile := 6; Exit end;
SetFTime (fdest, ftime);
SetFAttr (fdest, fattr);
If IOResult <> 0 Then begin Close (fdest); CopyFile := 6; Exit end;
Close (fdest);
end;
{
TFileCopy.Progress
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
is called by CopyFile to allow displaying a progress bar or s.e.
Bytesdone Bytes read in and written
Bytestotal Bytes to read&Write total (that is, File size)
percent amount done in percent
}
Procedure TFileCopy.Progress (Bytesdone, Bytestotal: LongInt; percent:
Integer);
begin
{abstract - inherit For use!}
end;
{
TFileCopy.Error
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
is called by CopyFile if an error occured during the copy process
code the IOResult code <> 0
should return an Integer value:
0 Repeat action
1 abort
Note: TurboVision installs it's own Dos critical error handler, so you
don't need to overWrite Error (only called if Abort is chosen from
the TV Error Msg) if you use CopyFile in a TV Program.
}
Function TFileCopy.Error (code: Word): Integer;
begin
Error := 1;
end;
end.
{
> Unit TVUtis;
>
> Wow...never seen so much code just to copy a File! =)
well, it's a quite extendable Object, and there's a lot of error-checking,
too. just see below... :-)
> I haven't tried OOP yet, and probably was lucky to
> Anyways, I see you left out a progress display in
> TFileCopy.Progress, but the Unit also has an a progress bar
> Object. Any way to marry the two?
of course, that's why I put them together!
but I didn't want to have the progress bar (and along With this Turbo Vision)
being an essential part of the FileCopy Object, since some guys might want to
Write their own ProgressBars or use the whole Object in a non-TV Program.
> I implemented your TCopyFile like so...
>
> Uses Dos, TVUtis;
> Var
> DoCopy: TFileCopy;
> F1, F2: PathStr;
> R: Integer;
> begin
> F1 := 'C:\tp\copyf.pas';
> F2 := 'C:\copyf.pas';
> DoCopy.Init(4096);
> R := DoCopy.CopyFile(F1, F2);
> DoCopy.Done;
> Writeln(R);
> end.
Absolutely correct, no doubt. But poor Graphics... ;-)
> How would one modify that and TFileCopy.Progress to use
> TProgressBar? From what I can surmise, you'd init
> TProgressBar and then TFilecopy.Progress would
> call it somehow, like TProgressBar.Update?
> I don't see what I should put For the totalwork of
> TProgressBar.Init; the size of the File? Then that
> means I must cal TProgress.Init from inside
> TFileCopy.CopyFile (after we have the size of the
> File.) And TFileCopy.Progress would call
> TProgressBar.Update.
first of all: The TProgressBar Object is written For Turbo Vision, you can't
use it within a non-TV Program. Next, you have to derive your own Object from
TFileCopy and overWrite the method Progress that calls TProgressBar. Take the
following as an example:
}
Type
PXFileCopy = ^TXFileCopy;
TXFileCopy = Object (TFileCopy)
AProgressBar: PProgressBar;
ConstRUCTOR Init (BufferSize: Word; ProgBar: PProgressBar);
Procedure Progress (Bytesdone, Bytestotal: LongInt;
percent: Integer); VIRTUAL;
end;
ConstRUCTOR TXFileCopy.Init (BufferSize: Word; ProgBar: PProgressBar);
begin
inherited Init (BufferSize); { or TFileCopy.Init For TP 6 }
AProgressBar := ProgBar;
end;
Procedure TXFileCopy.Progress (Bytesdone, Bytestotal: LongInt;
percent: Integer);
begin
if AProgressBar <> NIL then
AProgressBar^.UpdatePercent (percent);
end;
{
You then would use this Object (in a Turbo Vision Program) as follows:
}
Function TMyApp.CopyFile (source, dest: PathStr): Integer;
Var
Dlg: TDialog;
MyBar: PProgressBar;
R: TRect;
DoCopy: TXFileCopy;
begin
R.Assign (0,0,40,8);
Dlg.Init (R, 'Copying File...');
Dlg.Options := Dlg.Options or ofCentered;
Dlg.Flags := Dlg.Flags and not wfClose;
R.Assign (2,2,38,4);
Dlg.Insert (New (PStaticText, Init (R, ^C'copying '+source+#13+
^C'to '+dest+', please wait...')));
R.Assign (2,5,38,6);
Dlg.Insert (New (PStaticText, Init (R,
'0% 50% 100%')));
R.Move (0, 1);
MyBar := New (PProgressBar, Init (R, '°', '²', 0));
Dlg.Insert (MyBar);
Desktop^.Insert (@Dlg);
DoCopy.Init (4096, MyBar);
ErrorCode := DoCopy.CopyFile (source, dest);
DoCopy.Done;
Dlg.Done;
if ErrorCode <> 0 then
MessageBox ('Error copying File!', NIL, mfError+mfOkButton);
end;
{
If you don't want to have any progress bar at all, just pass NIL instead of
MyBar to DoCopy.Init. And maybe you want to add this Functionality directly to
TFileCopy rather than deriving a new Object.
}
[Back to OOP SWAG index] [Back to Main SWAG index] [Original]