home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FORUM25C.ZIP / DO_TODAY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-01  |  3.4 KB  |  130 lines
  1. Procedure Do_today;
  2. VAR Day,Month,Year,DayOfWeek : WORD;
  3.     Ext                      : String3;
  4.     Today_File               : String14;
  5.     Data_file                : TEXT;
  6.     No_more                  : BOOLEAN;
  7.     Found                    : BOOLEAN;
  8.     Was_born                 : BOOLEAN;
  9.     Dat                      : String80;
  10. CONST MonthStr : ARRAY[1..12] OF String3 = ('Jan','Feb','Mar','Apr','May',
  11.                                             'Jun','Jul','Aug','Sep','Oct',
  12.                                             'Nov','Dec');
  13. Function Get_born : String80;
  14. VAR Data : String80;
  15. Begin
  16.   Found := FALSE;
  17.   No_More := FALSE;
  18.   REPEAT
  19.     Readln(Data_File,Data);
  20.     If Data[1] = '*' THEN
  21.      Begin
  22.       Get_born := '';
  23.       No_More := TRUE
  24.      End
  25.     ELSE
  26.       Begin
  27.         If Copy(Data,1,5) = 'B'+ZeroStr(Month,2)+ZeroStr(Day,2) THEN
  28.           Begin
  29.             Get_Born := Data;
  30.             Found := TRUE;
  31.           End
  32.         ELSE
  33.           Begin
  34.             Found := FALSE;
  35.             Get_born := '';
  36.           End;
  37.       End;
  38.   UNTIL (No_more) Or (Found);
  39. End;
  40.  
  41. Function Get_Special : String80;
  42. VAR Data : String80;
  43. Begin
  44.   Found := FALSE;
  45.   No_More := FALSE;
  46.   REPEAT
  47.     Readln(Data_File,Data);
  48.     If Data[1] = '*' THEN
  49.      Begin
  50.       Get_special := '';
  51.       No_More := TRUE
  52.      End
  53.     ELSE
  54.       Begin
  55.         If Copy(Data,1,5) = 'S'+ZeroStr(Month,2)+ZeroStr(Day,2) THEN
  56.           Begin
  57.             Get_special := Data;
  58.             Found := TRUE;
  59.           End
  60.         ELSE
  61.           Begin
  62.             Found := FALSE;
  63.             Get_special := '';
  64.           End;
  65.       End;
  66.   If EOF(Data_file) THEN No_more := TRUE;
  67.   UNTIL (No_more) Or (Found);
  68. End;
  69.  
  70. CONST Full_month : ARRAY[1..12] OF String10 = ('January','February','March',
  71.                                                'April','May','June','July',
  72.                                                'August','September','October',
  73.                                                'November','December');
  74. CONST Week_day : ARRAY[0..6] OF String10 = ('Sunday','Monday','Tuesday',
  75.                                             'Wednesday','Thrusday','Friday',
  76.                                             'Saturday');
  77. Begin
  78.   GetDate(Year,Month,Day,DayOfWeek);
  79.   Ext := MonthStr[Month];
  80.   Today_file := ext+'.DAT';
  81.   Assign(Data_file,Today_file);
  82.   {$I-}
  83.     Reset(Data_file);
  84.   {$I+}
  85.   If IOREsult <> 0 THEN
  86.     Begin
  87.       Exit;
  88.     End;
  89.   Was_Born := FALSE;
  90.   Readln(Data_File,Dat);
  91.   Readln(Data_file,Dat);
  92.   Writeln;
  93.   WriteStr('It''s '+Week_day[DayOfWeek]+', '+Full_month[Month]+' '+
  94.             Strr(Day)+', '+Strr(year)+'.');
  95.   Writeln;
  96.   Writeln('Birthdays today: ');
  97.   Writeln;
  98.   REPEAT
  99.     Dat := Get_born;
  100.     If Dat <> '' THEN
  101.       Begin
  102.         Tab(' ',3);
  103.         Tab('In '+Copy(Dat,6,4),9);
  104.         Writeln(Copy(Dat,11,80));
  105.       End;
  106.   UNTIL No_more;
  107.   Readln(data_file,Dat);
  108.   Writeln;
  109.   Writeln('Other events: ');
  110.   Writeln;
  111.   REPEAT
  112.     Dat := Get_special;
  113.     If Dat <> '' THEN
  114.       Begin
  115.         If Dat[10] = 'C' THEN
  116.           Begin
  117.             Tab(' ',12);
  118.             Writeln(Copy(Dat,11,80));
  119.           End
  120.         ELSE
  121.           Begin
  122.             Tab(' ',3);
  123.             Tab('In '+Copy(Dat,6,5),9);
  124.             Writeln(Copy(Dat,11,80));
  125.           End;
  126.       End;
  127.   UNTIL No_more;
  128. End;
  129.  
  130. {=============================================================================}