Yurttas/PL/IL/Ada-95/F/05/02/00/find p.adb

From ZCubes Wiki
Jump to navigation Jump to search
 1--
 2-- Copyright(C) 1998
 3-- All Rights Reserved. Salih Yurttas, ZCubes, BitsOfCode Software Systems, Inc..
 4--
 5-- Permission to use, copy, modify, and distribute this
 6-- software and its documentation for EDUCATIONAL purposes
 7-- and without fee is hereby granted provided that this
 8-- copyright notice appears in all copies.
 9--
10 
11-- date   : December 4, 1989.
12-- author : Michael Nobles.
13
14-- find_p.adb
15
16
17package body Find_P is
18
19  function StrCmp(StrOne,
20                  StrTwo  : in String) return Integer is
21  begin
22    if StrOne<StrTwo then
23      return -1;
24    elsif StrOne = StrTwo then
25      return 0;
26    else
27      return 1;
28    end if;
29  end StrCmp;
30
31  procedure Find_Rec(DataN : in Pointer_String;
32                     Size: in Integer) is
33    L        : Integer;
34    Rec_Num  : Integer := 1;
35    Result   : Integer := 1;
36    Status   : Integer := 1;
37    Lastname : String(1..20) := "                    ";
38    Dummy    : String(1..20);
39    Temp_Rec : Data_Rec;
40    Found    : Boolean := False;
41  begin
42    Get_Line(Dummy,L);
43    Fix_Cursor(12,5);
44    Put("Enter the Last Name : ");
45    Get_Line(lastname,L);
46
47    while not found and Result /= 0
48    loop
49      Randomize('r',
50                DataN,
51                Rec_Num,
52                Temp_Rec,
53                Size,
54                Status);
55      case Status is
56        when 1 => Result := StrCmp(Lastname, Temp_Rec.last);
57                  if Result = 0 then
58                    found := True;
59                  else
60                    Rec_Num := Rec_Num + 1;
61                  end if;
62        when 0 => Fix_Cursor(14,5);
63                  Put("Sorry, that Last Name was not found...");
64                  Result := 0;
65        when others => 
66                  Fix_Cursor(14,5);
67                  Put("*** Error when Reading the File...");
68                  Result := 0;
69      end case;
70    end loop;
71
72    if found then
73      Show_Rec(Temp_Rec, Rec_Num);
74    end if;
75    Fix_Cursor(21,5);
76    Put("->Enter any letter to continue...");
77    Get_Line(Dummy,L);
78    Clear_Bottom(10);
79  end Find_Rec;
80
81end Find_P;