Program SrchAlrm;

uses dos, portfolio;

VAR
   file_in : text;
   infile_name : string;
   linex : array [1..40] of string;
   number_of_lines : char;
   Search_String : string[40];
   dummy : char;
   Sound_Switch : boolean;
   m, d, y, dow : word;
   year : string[2];
   mon  : string[2];
   day  : string[3];
   First_Time : boolean;
   hold_line : string;
   End_Flag : boolean;

Procedure Search_For_Today;
begin
   GetDate(y,m,d,dow);
   y := y - 1900;
   str(y,year);
   str(m,mon);
   if length(mon) = 1 then
      begin
      mon[2] := mon[1];
      mon[1] := '0';
      mon[0] := chr(2);
      end;
   str(d,day);
   if length(day) = 1 then
      begin
      day[2] := day[1];
      day[1] := ' ';
      day[0] := chr(2);
      end;
  Search_String := day+'/'+mon+'/'+year;
end;

Procedure Open_Files;
begin
{   Assign (File_In, 'c:\tp\tpu\diary.dry'); }
   Assign (File_In, 'a:\diary.dry');
   Reset(File_In);
end;

Procedure Pause_Display;
begin
     Write('Press A Key To Continue...');
     If Sound_Switch then
        PortBeep;
     dummy := ReadKey;
     if dummy = chr(27) then
        End_Flag := True;
     writeln;
end;

Procedure Display_Record(no_lines:integer);
Var
   i, k : integer;

begin
       i := no_lines;
       ClrScr;
       Writeln('   DD/MM/YY');
       for k := 1 to i do
           begin
           writeln(linex[k]);
           if (k mod 5) = 0 then
              Pause_Display;
           end;
       If (no_lines mod 5) <> 0 then
          begin
          Write('Press A Key To Continue...ESC to End');
          If Sound_Switch then
             PortBeep;
          Dummy := ReadKey;
          end;

end;


Procedure Search_Record(no_lines:integer);
Var
   i, k, x : integer;
   found_flag : boolean;
begin
    i := no_lines;
    found_flag := false;
    for k := 1 to i do
        begin
        x := pos(Search_String,linex[k]);
        if x > 0 then
           found_flag := true;
        end;
    if found_flag then
       Display_Record(i);
end;

Procedure Process_Records;
VAR
   i, j : integer;
begin
   While (not eof (File_In)) and (not End_Flag) do
         begin
              if First_Time then
                 begin
                 i := 1;
                 readln(file_in,linex[1]);
                 First_Time := False;
                 end
                 else
                 begin
                 i := 1;
                 linex[1] := hold_line;
                 end;
              repeat
                    i := i + 1;
                    readln(file_in,linex[i]);
              until linex[i,6] = '/';
              hold_line := linex[i];
              i := i - 1;

         Search_Record(i);
         end;

end;

Procedure Close_Files;
begin
    Close(File_In);
    ClrScr;
end;

Begin
   End_Flag := False;
   First_Time := True;
   Open_Files;
   If ParamCount > 0 then
      Search_String := ParamStr(1)
      else
      Search_For_Today;
   If ParamCount > 1 then
      Sound_Switch := True
      else
      Sound_Switch := False;
   Process_Records;
   Close_Files;
end.