home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
ZDISK.ZIP
/
ZDISK.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-04-18
|
4KB
|
153 lines
{$I-}
program zdisk;
uses dos,crt,strnglib;
label
finish;
const
debug = false;
bufsize = 32768;
smblk = 512;
titleline = 2;
blkszline = 3;
statsline = 4;
msgline = 5;
finishline= 10;
version = '3.1';
type
strng80 = string[80];
var
buffer : array[1..bufsize] of byte;
file0,
file1 : file;
blktitle : string[20];
fname : strng80;
status : byte;
function checkio(errmsg : strng80) : boolean;
var
iores : integer;
begin { checkio }
iores := ioresult;
if iores <> 0
then begin
writeln('IO Err # ',iores,'. ',errmsg);
checkio := true;
end
else begin
if debug
then begin
writeln(errmsg,' -- OK.');
end;
checkio := false;
end;
end; { checkio }
function zerofile(var outfile : file; fn : strng80; bufsizeused : word)
: boolean;
var
can,
done : boolean;
blockno : longint;
blockswritten : integer;
ch : char;
signature : strng80;
i : integer;
begin { zerofile }
gotoxy(1,blkszline);
clreol;
writeln('Writing in blocks of ',bufsizeused,' bytes to file ',fn);
gotoxy(1,statsline);
clreol;
write(blktitle);
zerofile := false; { not cancelled by operator }
{ Create buffer to write to disk }
signature := 'ZDisk '+ version + ' was here.';
fillchar(buffer,sizeof(buffer),0);
for i := 1 to length(signature) do
buffer[i] := ord(signature[i]);
{ open temporary output file }
assign(outfile,fn);
if checkio('assigning '+fn+' to temporary output file.')
then begin
zerofile := true;
exit;
end;
rewrite(outfile,bufsizeused);
if checkio('opening '+fn+'.')
then begin
zerofile := true;
exit;
end;
done := false;
blockno := 0;
ch := 'N'; { indicate no operator cancel }
repeat
blockwrite(outfile,buffer,1,blockswritten);
blockno := blockno + blockswritten;
if keypressed
then begin
{ get rid of key which caused interruption }
ch := readkey;
if ch = #0
then ch := readkey;
gotoxy(1,msgline);
clreol;
write('Cancel ZDisk ? ');
ch := upcase(readkey);
write(ch);
gotoxy(1,msgline);
clreol;
done := ch = 'Y';
if done
then write('ZDisk cancelled by operator.')
else begin
write('Press any key to cancel.');
ch := 'N';
end;
zerofile := done;
end
else done := blockswritten = 0;
gotoxy(1+length(blktitle),statsline);
write(blockno:7);
until (done);
close(outfile);
end; { zerofile }
begin { zdisk }
if ParamCount > 0
then begin
fname := upcas(trim(Paramstr(1)));
if fname[1] in ['A'..'Z']
then fname := fname + ':\$Z$E$R$0.TMP'
else begin
writeln('ZDisk Version ',version,
' Error -- Illegal Drive Parameter.');
halt(3);
end;
end
else fname := FExpand('\$Z$E$R$0.TMP');
blktitle := 'Block No.: ';
status := 0; { Normal Termination }
clrscr;
gotoxy(1,titleline);
writeln('ZDisk ',version,
' -- Overwrite unused sectors with binary zeroes.');
gotoxy(1,msgline);
clreol;
writeln('Press any key to cancel');
if zerofile(file0,fname,bufsize)
then begin
status := 1;
goto finish;
end;
fname[length(fname)-4] := '1';
if zerofile(file1,fname,smblk)
then status := 2;
finish:
gotoxy(1,finishline);
clreol;
erase(file0);
erase(file1);
halt(status);
end. { zdisk }