home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
db_dbug2.zip
/
LISTING.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-12-05
|
4KB
|
124 lines
type datetype= string[8];
regtype = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer
end;
fname = string[66];
var ch, ch1 : char;
st, pst, dst : string[255];
name, outfile : string[12];
rtd, gtd : string[66];
up_date : string[8];
i, atop, count, cnt_line : integer;
a : array[1..400] of string[66];
filein, fileout : text;
gonogo : boolean;
const blanks = ' ';
nul = ^@; seekattrib = $10;
function time: datetype;
var reg: regtype;
h,m,s,w: datetype;
i: integer;
begin
reg.ax:=$2c00;
intr($21,reg);
str(hi(reg.cx):2,h);
str(lo(reg.cx):2,m);
str(hi(reg.dx):2,s);
w:=h+':'+m+':'+s;
for i:=1 to length(w) do if w[i]=' ' then w[i]:='0';
time:=w;
end;
function date: datetype;
var reg: regtype;
y,m,d,w: datetype;
i: integer;
begin
reg.ax:=$2a00;
intr($21,reg);
str(reg.cx:4,y);
delete(y,1,2);
str(hi(reg.dx):2,m);
str(lo(reg.dx):2,d);
w:=m+'/'+d+'/'+y;
for i:=1 to length(w) do if w[i]=' ' then w[i]:='0';
date:=w;
end;
function exist(filename: fname): boolean;
var xfile: text;
begin
assign(xfile, filename);
{$I-}
reset(xfile);
{$I+}
exist:=(ioresult=0); {$I-} close(xfile); {I+}
end;
procedure startup;
begin
clrscr; gotoxy(16,5); writeln('Listing started ',time,' with ',atop:3,' files in queue.');
gotoxy(23,7); writeln('Press [SPACE BAR] to abort printing');
outfile:='prn'; assign(fileout,outfile); rewrite(fileout);
end;
begin
st:=''; for i:=1 to paramcount do st:=st+paramstr(i); gonogo:=true;
atop:=0; for i:=1 to 400 do a[i]:=''; getdir(0,rtd);
if (length(st)>0) and exist(st) then begin
atop:=1; a[1]:=st;
end else
if (length(st)=0) and exist('listing.dat') then begin
close(fileout);
assign(filein,'listing.dat'); reset(filein);
while not eof(filein) do begin
readln(filein,gtd); atop:=atop+1; a[atop]:=gtd;
end;
close(filein);
end;
if atop>0 then begin
startup;
for i:=1 to atop do begin
if not exist(a[i]) then
writeln('ERROR --- ',a[i],' does not exist in this directory. Skipping this file.')
else begin
gotoxy(23,12); write('Working on file #',i:3,' (',a[i],')');
assign(filein,a[i]); reset(filein); count:=1;
while (gonogo and (not eof(filein))) and (count<3) do begin
case count of
1: dst:='File '+a[i]+' in directory '+rtd;
2: dst:='Run at '+time+' on '+date;
end;
readln(filein,st); count:=count+1;
writeln(fileout,st,copy(blanks,1,80-length(st)),dst);
end;
while gonogo and not eof(filein) do begin
ch:=chr(0); if keypressed then read(kbd,ch); if ch=' ' then begin
writeln;
write('Do you really wish to abort printing? '); read(ch);
if ch in ['Y','y'] then gonogo:=false;
end else begin
readln(filein,pst); writeln(fileout,pst);
end;
end;
if gonogo then writeln(fileout,chr(12));
close(filein);
end;
end;
close(fileout);
end else begin
if length(st)>0 then writeln(st,' does not exist.');
if not exist('listing.dat') then begin
writeln; writeln('The syntax for this program is LISTING [filename], where filename');
writeln('is optional. If you do not add a filename, then LISTING looks for a file');
writeln('called LISTING.DAT in the current directory. LISTING.DAT should have only the');
writeln('files you want printed, including extentions.');
end;
end;
end.