home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Jason Aller Floppy Collection
/
270.img
/
FORUM25C.ZIP
/
DO_TODAY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-02-01
|
4KB
|
130 lines
Procedure Do_today;
VAR Day,Month,Year,DayOfWeek : WORD;
Ext : String3;
Today_File : String14;
Data_file : TEXT;
No_more : BOOLEAN;
Found : BOOLEAN;
Was_born : BOOLEAN;
Dat : String80;
CONST MonthStr : ARRAY[1..12] OF String3 = ('Jan','Feb','Mar','Apr','May',
'Jun','Jul','Aug','Sep','Oct',
'Nov','Dec');
Function Get_born : String80;
VAR Data : String80;
Begin
Found := FALSE;
No_More := FALSE;
REPEAT
Readln(Data_File,Data);
If Data[1] = '*' THEN
Begin
Get_born := '';
No_More := TRUE
End
ELSE
Begin
If Copy(Data,1,5) = 'B'+ZeroStr(Month,2)+ZeroStr(Day,2) THEN
Begin
Get_Born := Data;
Found := TRUE;
End
ELSE
Begin
Found := FALSE;
Get_born := '';
End;
End;
UNTIL (No_more) Or (Found);
End;
Function Get_Special : String80;
VAR Data : String80;
Begin
Found := FALSE;
No_More := FALSE;
REPEAT
Readln(Data_File,Data);
If Data[1] = '*' THEN
Begin
Get_special := '';
No_More := TRUE
End
ELSE
Begin
If Copy(Data,1,5) = 'S'+ZeroStr(Month,2)+ZeroStr(Day,2) THEN
Begin
Get_special := Data;
Found := TRUE;
End
ELSE
Begin
Found := FALSE;
Get_special := '';
End;
End;
If EOF(Data_file) THEN No_more := TRUE;
UNTIL (No_more) Or (Found);
End;
CONST Full_month : ARRAY[1..12] OF String10 = ('January','February','March',
'April','May','June','July',
'August','September','October',
'November','December');
CONST Week_day : ARRAY[0..6] OF String10 = ('Sunday','Monday','Tuesday',
'Wednesday','Thrusday','Friday',
'Saturday');
Begin
GetDate(Year,Month,Day,DayOfWeek);
Ext := MonthStr[Month];
Today_file := ext+'.DAT';
Assign(Data_file,Today_file);
{$I-}
Reset(Data_file);
{$I+}
If IOREsult <> 0 THEN
Begin
Exit;
End;
Was_Born := FALSE;
Readln(Data_File,Dat);
Readln(Data_file,Dat);
Writeln;
WriteStr('It''s '+Week_day[DayOfWeek]+', '+Full_month[Month]+' '+
Strr(Day)+', '+Strr(year)+'.');
Writeln;
Writeln('Birthdays today: ');
Writeln;
REPEAT
Dat := Get_born;
If Dat <> '' THEN
Begin
Tab(' ',3);
Tab('In '+Copy(Dat,6,4),9);
Writeln(Copy(Dat,11,80));
End;
UNTIL No_more;
Readln(data_file,Dat);
Writeln;
Writeln('Other events: ');
Writeln;
REPEAT
Dat := Get_special;
If Dat <> '' THEN
Begin
If Dat[10] = 'C' THEN
Begin
Tab(' ',12);
Writeln(Copy(Dat,11,80));
End
ELSE
Begin
Tab(' ',3);
Tab('In '+Copy(Dat,6,5),9);
Writeln(Copy(Dat,11,80));
End;
End;
UNTIL No_more;
End;
{=============================================================================}