home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug027.arc
/
START.INC
< prev
next >
Wrap
Text File
|
1979-12-31
|
4KB
|
139 lines
FUNCTION Exist(Filename: str14): BOOLEAN;
VAR
fil: FILE;
BEGIN
assign(fil,filename);
{$I-}
reset(fil) {$I+};
IF IOresult <>0
THEN exist := FALSE
ELSE exist := TRUE;
END;
overlay PROCEDURE start(Var Todays_date : str11);
const
Term : CharSet = [#27,^M];
var
ok : boolean;
procedure Load_PCG;
begin
{#128}
mem[-2048]:=255;mem[-2047]:=0;mem[-2046]:=0;mem[-2045]:=0;
mem[-2044]:=0;mem[-2043]:=0;mem[-2042]:=0;mem[-2041]:=0;
mem[-2040]:=0;mem[-2039]:=0;mem[-2038]:=0;
{#129}
mem[-2032]:=0;mem[-2031]:=0;mem[-2030]:=0;mem[-2029]:=0;
mem[-2028]:=0;mem[-2027]:=0;mem[-2026]:=0;mem[-2025]:=0;
mem[-2024]:=0;mem[-2023]:=0;mem[-2022]:=255;
end;
PROCEDURE getfilenames;
VAR
i : integer;
BEGIN { getfilenames }
infilename := ParamSTR(1);
IF (not exist(infilename + '.DAT'))
THEN
REPEAT
infilename := 'A:ANIMAL1';
gotoxy(1,8);
write('Name of Input file > __________.DAT');
InputStr(InfileName,10,22,7,term,ch);
if infilename = '' then infilename := 'Animal';
infilename := UpCaseStr(infilename);
assign(infile,infilename + '.DAT');
IF NOT (exist(infilename + '.DAT')) THEN
BEGIN
gotoxy(1,9);
write('File ',infilename,'.DAT does not exist on current drive.');
select(1,22,' Create new file | Y | N |',['Y','N'],ch);
IF ch ='Y' THEN
begin
REWRITE(infile);
gotoxy(1,9);
clreol;
end;
end
else
reset(infile);
UNTIL exist(infilename + '.DAT') or (ch = 'N');
gotoxy(1,8);
clreol;
END; { getfilenames }
BEGIN
Load_PCG;
Load_Months;
ClrScr ;
assign(Q,'CON:');
rewrite(Q);
FOR i := 1 TO 6 DO
Initialize(Animal_table[i]);
For i := 1 to 12 do
Initialize(List_Table[i]);
Line(1);
Line(21);
getfilenames;
IF ch <> 'N' THEN
BEGIN
if filesize(infile) = 0 then
begin
Initialize(Animal);
with Animal do
begin
Rec_No := 0;
Name := 'Last Update ->';
Ear_No := '!!!!!'; {This will always sort to the first record in the file}
Date_Died := '15 SEP 1986'; {The date this was written};
write(infile,Animal);
end;
Initialize(Animal);
with Animal do
begin
Rec_No := 1;
Name := 'Un Known Female';
Ear_No := '!000F';
sex := 'F';
sire := '!000M';
Dam := '!000F';
write(infile,Animal);
end;
Initialize(Animal);
with Animal do
begin
Rec_No := 2;
Name := 'Un Known Male';
Ear_No := '!000M';
sex := 'F';
sire := '!000M';
Dam := '!000F';
write(infile,Animal);
end;
end;
seek(infile,0);
read(infile,Animal);
dis(1,2,' Database. ');
dis(1,2,infilename);
GotoXY(60,2);
Display_Recs_Used;
Animal.Date_Born := Animal.Date_Died;
Todays_Date := Animal.Date_Born;
ok := false;
dis(1,22,' | ^Z = ABORT | <ESC> = FINISHED |');
repeat
gotoxy(9,12);
write('Todays Date : ',Todays_Date);
getdate(todays_date,11);
verify_date(Todays_date,ok);
gotoxy(1,12);
clreol;
until ok;
Animal.Date_Died := Todays_Date;
seek(infile,0);
write(infile,Animal);
end;
END;