home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / zip / portfoli / srch.lzh / SRCHALRM.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-21  |  3KB  |  152 lines
  1. Program SrchAlrm;
  2.  
  3. uses dos, portfolio;
  4.  
  5. VAR
  6.    file_in : text;
  7.    infile_name : string;
  8.    linex : array [1..40] of string;
  9.    number_of_lines : char;
  10.    Search_String : string[40];
  11.    dummy : char;
  12.    Sound_Switch : boolean;
  13.    m, d, y, dow : word;
  14.    year : string[2];
  15.    mon  : string[2];
  16.    day  : string[3];
  17.    First_Time : boolean;
  18.    hold_line : string;
  19.    End_Flag : boolean;
  20.  
  21. Procedure Search_For_Today;
  22. begin
  23.    GetDate(y,m,d,dow);
  24.    y := y - 1900;
  25.    str(y,year);
  26.    str(m,mon);
  27.    if length(mon) = 1 then
  28.       begin
  29.       mon[2] := mon[1];
  30.       mon[1] := '0';
  31.       mon[0] := chr(2);
  32.       end;
  33.    str(d,day);
  34.    if length(day) = 1 then
  35.       begin
  36.       day[2] := day[1];
  37.       day[1] := ' ';
  38.       day[0] := chr(2);
  39.       end;
  40.   Search_String := day+'/'+mon+'/'+year;
  41. end;
  42.  
  43. Procedure Open_Files;
  44. begin
  45. {   Assign (File_In, 'c:\tp\tpu\diary.dry'); }
  46.    Assign (File_In, 'a:\diary.dry');
  47.    Reset(File_In);
  48. end;
  49.  
  50. Procedure Pause_Display;
  51. begin
  52.      Write('Press A Key To Continue...');
  53.      If Sound_Switch then
  54.         PortBeep;
  55.      dummy := ReadKey;
  56.      if dummy = chr(27) then
  57.         End_Flag := True;
  58.      writeln;
  59. end;
  60.  
  61. Procedure Display_Record(no_lines:integer);
  62. Var
  63.    i, k : integer;
  64.  
  65. begin
  66.        i := no_lines;
  67.        ClrScr;
  68.        Writeln('   DD/MM/YY');
  69.        for k := 1 to i do
  70.            begin
  71.            writeln(linex[k]);
  72.            if (k mod 5) = 0 then
  73.               Pause_Display;
  74.            end;
  75.        If (no_lines mod 5) <> 0 then
  76.           begin
  77.           Write('Press A Key To Continue...ESC to End');
  78.           If Sound_Switch then
  79.              PortBeep;
  80.           Dummy := ReadKey;
  81.           end;
  82.  
  83. end;
  84.  
  85.  
  86. Procedure Search_Record(no_lines:integer);
  87. Var
  88.    i, k, x : integer;
  89.    found_flag : boolean;
  90. begin
  91.     i := no_lines;
  92.     found_flag := false;
  93.     for k := 1 to i do
  94.         begin
  95.         x := pos(Search_String,linex[k]);
  96.         if x > 0 then
  97.            found_flag := true;
  98.         end;
  99.     if found_flag then
  100.        Display_Record(i);
  101. end;
  102.  
  103. Procedure Process_Records;
  104. VAR
  105.    i, j : integer;
  106. begin
  107.    While (not eof (File_In)) and (not End_Flag) do
  108.          begin
  109.               if First_Time then
  110.                  begin
  111.                  i := 1;
  112.                  readln(file_in,linex[1]);
  113.                  First_Time := False;
  114.                  end
  115.                  else
  116.                  begin
  117.                  i := 1;
  118.                  linex[1] := hold_line;
  119.                  end;
  120.               repeat
  121.                     i := i + 1;
  122.                     readln(file_in,linex[i]);
  123.               until linex[i,6] = '/';
  124.               hold_line := linex[i];
  125.               i := i - 1;
  126.  
  127.          Search_Record(i);
  128.          end;
  129.  
  130. end;
  131.  
  132. Procedure Close_Files;
  133. begin
  134.     Close(File_In);
  135.     ClrScr;
  136. end;
  137.  
  138. Begin
  139.    End_Flag := False;
  140.    First_Time := True;
  141.    Open_Files;
  142.    If ParamCount > 0 then
  143.       Search_String := ParamStr(1)
  144.       else
  145.       Search_For_Today;
  146.    If ParamCount > 1 then
  147.       Sound_Switch := True
  148.       else
  149.       Sound_Switch := False;
  150.    Process_Records;
  151.    Close_Files;
  152. end.ə