home *** CD-ROM | disk | FTP | other *** search
/ The CIA World Factbook 1992 / k3bimage.iso / sel / 12 / 0090 / txttobb.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-12-02  |  10.9 KB  |  357 lines
  1. program txttobb; {convert text file to blakbook form}
  2.  
  3.   (****************************************************************)
  4.   (*                                                              *)
  5.   (*                     LITTLE BLACK BOOK                        *)
  6.   (*                                                              *)
  7.   (*             Text File to BLKBOOK.DAT conversion              *)
  8.   (*                                                              *)
  9.   (*                Copyright (C) 1985, 1986 by                   *)
  10.   (*                     MARTIN C. BEATTIE                        *)
  11.   (*                                                              *)
  12.   (*                Last Update : February 28, 1986               *)
  13.   (*                                                              *)
  14.   (****************************************************************)
  15.  
  16.   {$v-}
  17.  
  18.   CONST
  19.     (*  data record Size definition *)
  20.     Recordsize = 142;                   (* customer record Size *)
  21.  
  22.     (*  TURBO-access constants *)
  23.     Maxdatarecsize = Recordsize;        (* max record Size *)
  24.     Maxkeylen = 25;                     (* max key Size *)
  25.     Pagesize = 16;                      (* page Size *)
  26.     Order = 8;                          (* half page Size *)
  27.     Pagestacksize = 5;                  (* page buffer Size *)
  28.     Maxheight = 5;                      (* max B-tree height *)
  29.  
  30.   VAR
  31.     Noofrecs: Integer;
  32.  
  33.     (*  Note -- the following include files are proprietary and are available
  34.                 from Borland, Int in their Turbo ToolBox Package *)
  35.  
  36.     (*$I \turbo\access\ACCESS.BOX*)
  37.     (*$I \turbo\access\ADDKEY.BOX*)
  38.     (*$I \turbo\access\GETKEY.BOX*)
  39.  
  40.   TYPE
  41.     Str10 = STRING [10];
  42.     Str14 = STRING [14];
  43.     Str15 = STRING [15];
  44.     Str25 = STRING [25];
  45.     Str80 = STRING [80];
  46.     Buffer = STRING [255];
  47.     Dummy = ARRAY [1..136] OF Char;     {used to calculate text file length}
  48.     Rectype = (B, T);
  49.     Bbrectype =
  50.       RECORD
  51.         Recstatus: Integer;             (* Record Status *)
  52.         CASE Rectype OF
  53.        B:
  54.             ( LastName   : string[20];    (*  last name *)
  55.               FirstName  : string[15];    (*  first name *)
  56.               address1   : string[30];    (*  Address 1 *)
  57.               address2   : string[30];    (*  Address 2 *)
  58.               Phone      : string[14];    (*  Phone number *)
  59.               Note       : string[25]     (*  remarks 1 *));
  60.        T:
  61.             ( lnlen    :byte;
  62.               Lname  :array[1..20] of char;
  63.               fnlen    :byte;
  64.               fname  :array[1..15] of char;
  65.               a1len    :byte;
  66.               a1     :array[1..30] of char;
  67.               a2len    :byte;
  68.               a2     :array[1..30] of char;
  69.               phlen    :byte;
  70.               ph     :array[1..14] of char;
  71.               nlen     :byte;
  72.               nt     :array[1..25] of char);
  73.             end;
  74.  
  75.   VAR
  76.     (*  global variables *)
  77.     Ch: Char;
  78.     X, Y: Integer;
  79.     Infile: Text;
  80.     Infilelen: FILE OF Dummy;
  81.     Returnfile: FILE;
  82.     Infilename: STRING [14];
  83.     Outfilename: STRING [14];
  84.     Person: Bbrectype;
  85.     Lastrec: Integer;
  86.     Lowbyte, Highbyte: Byte;
  87.     Goodrecord: Boolean;
  88.     Datf: Datafile;
  89.     Nameindexfile: Indexfile;
  90.     Bufstr: Buffer;
  91.  
  92.     {The following procedure is borrowed, though I don't know the author}
  93.  
  94.  
  95.   PROCEDURE Directry(Mmask: Str14);
  96.  
  97.     TYPE
  98.       Char12arr = ARRAY [1..12] OF Char;
  99.       String20 = STRING [20];
  100.       Regrec =
  101.         RECORD
  102.           Ax, Bx, Cx, Dx, Bp, Si, Di, Ds, Es, Flags: Integer;
  103.         END;
  104.  
  105.     VAR
  106.       Regs: Regrec;
  107.       Dta: ARRAY [1..43] OF Byte;
  108.       Mask: Char12arr;
  109.       Namr: String20;
  110.       Error, I: Integer;
  111.  
  112.  
  113.     PROCEDURE Showname(Namr: String20);
  114.       BEGIN
  115.         WHILE Length(Namr) < 14 DO
  116.           IF Pos('.', Namr) > 0 THEN Insert(' ', Namr, Pos('.', Namr))
  117.           ELSE Namr := Namr + ' ';
  118.         Write(Namr);
  119.         IF Wherex > 65 THEN Writeln;
  120.       END;
  121.  
  122.     BEGIN { main body of program DirList }
  123.  
  124.       Fillchar(Dta, Sizeof(Dta), 0); { Initialize the DTA buffer }
  125.       Fillchar(Mask, Sizeof(Mask), 0); { Initialize the mask }
  126.       Fillchar(Namr, Sizeof(Namr), 0); { Initialize the file name }
  127.  
  128.       Regs.Ax := $1A00; { Function used to set the DTA }
  129.       Regs.Ds := Seg(Dta); { store the parameter segment in DS }
  130.       Regs.Dx := Ofs(Dta); { " " " offset in DX }
  131.       Msdos(Regs); { Set DTA location }
  132.       Error := 0;
  133.       FOR I := 1 TO Length(Mmask) DO Mask[I] := Mmask[I];
  134.       Regs.Ax := $4E00; { Get first directory entry }
  135.       Regs.Ds := Seg(Mask); { Point to the file Mask }
  136.       Regs.Dx := Ofs(Mask);
  137.       Regs.Cx := 22; { Store the option }
  138.       Msdos(Regs); { Execute MSDos call }
  139.       Error := Regs.Ax AND $FF; { Get Error return }
  140.       I := 1; { initialize 'I' to the first element }
  141.       IF (Error = 0) THEN
  142.         REPEAT
  143.           Namr[I] := Chr(Mem[Seg(Dta): Ofs(Dta) + 29 + I]);
  144.           I := I + 1;
  145.         UNTIL NOT (Namr[I - 1] IN [' '..'~']) OR (I > 20);
  146.  
  147.       Namr[0] := Chr(I - 1); { set string length because assigning }
  148.       Showname(Namr); { by element does not set length }
  149.       WHILE (Error = 0) DO
  150.         BEGIN
  151.         Error := 0;
  152.         Regs.Ax := $4F00; { Function used to get the next }
  153.         { directory entry }
  154.         Regs.Cx := 22; { Set the file option }
  155.         Msdos(Regs); { Call MSDos }
  156.         Error := Regs.Ax AND $FF; { get the Error return }
  157.         I := 1;
  158.         REPEAT
  159.           Namr[I] := Chr(Mem[Seg(Dta): Ofs(Dta) + 29 + I]);
  160.           I := I + 1;
  161.         UNTIL NOT (Namr[I - 1] IN [' '..'~']) OR (I > 20);
  162.         Namr[0] := Chr(I - 1);
  163.         IF (Error = 0) THEN Showname(Namr);
  164.         END;
  165.       Writeln;
  166.       Writeln;
  167.     END; { of Directry }
  168.  
  169. (* UpCaseStr results in a string of upper case characters to guarantee
  170.    consistant keywords *)
  171.  
  172.  
  173.   FUNCTION Upcasestr(S: Str80): Str80;
  174.  
  175.     VAR
  176.       P: Integer;
  177.     BEGIN
  178.       FOR P := 1 TO Length(S) DO S[P] := Upcase(S[P]);
  179.       Upcasestr := S;
  180.     END;
  181.  
  182.   (* From Turbo-ToolBox, creates a keyword from the last and first names *)
  183.  
  184.  
  185.   FUNCTION Makekey(Lastnm: Str15;
  186.                    Firstnm: Str10): Str25;
  187.  
  188.     CONST
  189.       Blanks = '               ';
  190.     BEGIN
  191.       Makekey := Upcasestr(Lastnm) + Copy(Blanks, 1,
  192.                  15 - Length(Lastnm)) + Upcasestr(Firstnm);
  193.     END;
  194.  
  195.  
  196.   PROCEDURE Strip(VAR S: Str80;
  197.                   N: Integer);
  198.  
  199.     VAR
  200.       I: Integer;
  201.     BEGIN
  202.       I := N + 1;
  203.       REPEAT
  204.         I := I - 1
  205.       UNTIL (S[I] <> ' ') OR (I = 0);
  206.       S[0] := Chr(I);
  207.     END;
  208.  
  209.  
  210.   PROCEDURE Getfile;
  211.  
  212.     VAR
  213.       D, Rlen, Reccount: Integer;
  214.       Keyn: Str25;
  215.  
  216.     BEGIN
  217.       Reccount := 0;
  218.       Write('Processing Record: ');
  219.       X := Wherex;
  220.       Y := Wherey;
  221.       REPEAT
  222.         WITH Person DO
  223.           BEGIN
  224.           Fillchar(Person, Sizeof(Person), 0);
  225.           Readln(Infile, Lname, Fname, A1, A2, Ph, Nt);
  226.           Strip(Lastname, 20);
  227.           Strip(Firstname, 15);
  228.           Strip(Address1, 30);
  229.           Strip(Address2, 30);
  230.           Strip(Phone, 14);
  231.           Strip(Note, 25);
  232.           Reccount := Reccount + 1;
  233.           Keyn := Makekey(Lastname, Firstname);
  234.           IF (Keyn[1] IN ['A'..'Z', 'a'..'z']) THEN Goodrecord := True
  235.           ELSE Goodrecord := False;
  236.           Gotoxy(X, Y);
  237.           Clreol;
  238.           Writeln(Reccount, ' ', Lastname, ' ', Firstname);
  239.           IF NOT Goodrecord THEN Write(#7, ' Bad LastName...not added')
  240.           ELSE Addrec(Datf, D, Person);
  241.           END;
  242.  
  243.       UNTIL Eof(Infile);
  244.     END;
  245.  
  246.  
  247.   PROCEDURE Makebbindex;
  248.    {Make an new index file for the database}
  249.  
  250.     VAR
  251.       Person: Bbrectype;
  252.       I, J, K, D, X, Y: Integer;
  253.       Keyn: STRING [25];
  254.  
  255.     BEGIN
  256.       Initindex;
  257.       Openfile(Datf, 'BlkBook.DAT', Recordsize);
  258.       IF Ok THEN
  259.         BEGIN
  260.         Writeln;
  261.         Writeln('Creating new index file: BLKBOOK.IXN');
  262.         BEGIN
  263.         Makeindex(Nameindexfile, 'BlkBook.IXN', 25, 0);
  264.         END
  265.         END;
  266.       Write('Indexing..');
  267.       X := Wherex;
  268.       Y := Wherey;
  269.       D := 1;
  270.       WHILE D < Filelen(Datf) DO
  271.         BEGIN
  272.         Getrec(Datf, D, Person);
  273.         WITH Person DO
  274.           BEGIN
  275.           IF Recstatus = 0 THEN
  276.             BEGIN
  277.             Keyn := Makekey(Lastname, Firstname);
  278.             IF NOT (Keyn[1] IN ['A'..'Z', 'a'..'z']) THEN Ok := False
  279.             ELSE
  280.               BEGIN
  281.               Gotoxy(X, Y);
  282.               Clreol;
  283.               Write(Lastname, ', ', Firstname);
  284.               Addkey(Nameindexfile, D, Keyn);
  285.               END;
  286.             IF NOT Ok THEN
  287.               BEGIN
  288.               Gotoxy(10, 20);
  289.               Clreol;
  290.               Write('Duplicate Record for ', Lastname, ', ', Firstname);
  291.               Writeln('. . .Deleted!');
  292.               Deleterec(Datf, D);
  293.               END;
  294.             END;
  295.           END;
  296.  
  297.         D := D + 1;
  298.         END;
  299.       Closefile(Datf);
  300.       Closeindex(Nameindexfile);
  301.     END;
  302.  
  303.   BEGIN
  304.     Clrscr;
  305.     Writeln('Available Files:');
  306.     Directry('*.*');
  307.     Writeln('This routine will create an indexed, Blaque Book format data file');
  308.     Writeln('from a text file which has been created with the following format');
  309.     Writeln;
  310.     Writeln('Each line will contain the following information, the data elements');
  311.     Writeln('should not be separated by any spaces, and the line should be');
  312.     Writeln('termitated by a carriage return/line feed: ');
  313.     Writeln;
  314.     Writeln('     Last Name   20 spaces');
  315.     Writeln('     First Name  15 spaces');
  316.     Writeln('     Address 1   30 spaces');
  317.     Writeln('     Address 2   30 spaces');
  318.     Writeln('     Phone       14 spaces');
  319.     Writeln('     Note        25 spaces');
  320.     Writeln;
  321.     Writeln('  The line must be 134 characters in length to load properly');
  322.     Writeln;
  323.     Write('Type in name of text file to load > ');
  324.     Readln(Infilename);
  325.     Outfilename := 'blkbook.dat';
  326.     Assign(Infilelen, Infilename);
  327.     {$i-}
  328.     Reset(Infilelen);
  329.     {$i+}
  330.     IF (Ioresult = 0) THEN
  331.       BEGIN
  332.       Clrscr;
  333.       Lastrec := Sizeof(Infilelen);
  334.       Close(Infilelen);
  335.       Assign(Infile, Infilename);
  336.       Reset(Infile);
  337.       Makefile(Datf, 'BLKBOOK.dat', Recordsize);
  338.       IF Ok THEN
  339.         BEGIN
  340.         Writeln('Creating new data file: BLKBOOK.DAT');
  341.         Getfile;
  342.         Close(Infile);
  343.         Closefile(Datf);
  344.         Makebbindex;
  345.         Writeln;
  346.         Writeln('You may now run BLAKBOOK using the new database.');
  347.         END
  348.       ELSE Write(#7, 'Error in Creating BLKBOOK.DAT');
  349.       END
  350.     ELSE Writeln(#7, 'Input file not found.');
  351.     Writeln;
  352.     Writeln('Type "Q" to quit, any other key will return to utility menu.');
  353.     Read(Kbd, Ch);
  354.     Assign(Returnfile, 'BBUTIL.COM');
  355.     IF Upcase(Ch) <> 'Q' THEN Execute(Returnfile);
  356.   END.
  357.