program txttobb; {convert text file to blakbook form}

  (****************************************************************)
  (*                                                              *)
  (*                     LITTLE BLACK BOOK                        *)
  (*                                                              *)
  (*             Text File to BLKBOOK.DAT conversion              *)
  (*                                                              *)
  (*                Copyright (C) 1985, 1986 by                   *)
  (*                     MARTIN C. BEATTIE                        *)
  (*                                                              *)
  (*                Last Update : February 28, 1986               *)
  (*                                                              *)
  (****************************************************************)

  {$v-}

  CONST
    (*  data record Size definition *)
    Recordsize = 142;                   (* customer record Size *)

    (*  TURBO-access constants *)
    Maxdatarecsize = Recordsize;        (* max record Size *)
    Maxkeylen = 25;                     (* max key Size *)
    Pagesize = 16;                      (* page Size *)
    Order = 8;                          (* half page Size *)
    Pagestacksize = 5;                  (* page buffer Size *)
    Maxheight = 5;                      (* max B-tree height *)

  VAR
    Noofrecs: Integer;

    (*  Note -- the following include files are proprietary and are available
                from Borland, Int in their Turbo ToolBox Package *)

    (*$I \turbo\access\ACCESS.BOX*)
    (*$I \turbo\access\ADDKEY.BOX*)
    (*$I \turbo\access\GETKEY.BOX*)

  TYPE
    Str10 = STRING [10];
    Str14 = STRING [14];
    Str15 = STRING [15];
    Str25 = STRING [25];
    Str80 = STRING [80];
    Buffer = STRING [255];
    Dummy = ARRAY [1..136] OF Char;     {used to calculate text file length}
    Rectype = (B, T);
    Bbrectype =
      RECORD
        Recstatus: Integer;             (* Record Status *)
        CASE Rectype OF
       B:
            ( LastName   : string[20];    (*  last name *)
              FirstName  : string[15];    (*  first name *)
              address1   : string[30];    (*  Address 1 *)
              address2   : string[30];    (*  Address 2 *)
              Phone      : string[14];    (*  Phone number *)
              Note       : string[25]     (*  remarks 1 *));
       T:
            ( lnlen    :byte;
              Lname  :array[1..20] of char;
              fnlen    :byte;
              fname  :array[1..15] of char;
              a1len    :byte;
              a1     :array[1..30] of char;
              a2len    :byte;
              a2     :array[1..30] of char;
              phlen    :byte;
              ph     :array[1..14] of char;
              nlen     :byte;
              nt     :array[1..25] of char);
            end;

  VAR
    (*  global variables *)
    Ch: Char;
    X, Y: Integer;
    Infile: Text;
    Infilelen: FILE OF Dummy;
    Returnfile: FILE;
    Infilename: STRING [14];
    Outfilename: STRING [14];
    Person: Bbrectype;
    Lastrec: Integer;
    Lowbyte, Highbyte: Byte;
    Goodrecord: Boolean;
    Datf: Datafile;
    Nameindexfile: Indexfile;
    Bufstr: Buffer;

    {The following procedure is borrowed, though I don't know the author}


  PROCEDURE Directry(Mmask: Str14);

    TYPE
      Char12arr = ARRAY [1..12] OF Char;
      String20 = STRING [20];
      Regrec =
        RECORD
          Ax, Bx, Cx, Dx, Bp, Si, Di, Ds, Es, Flags: Integer;
        END;

    VAR
      Regs: Regrec;
      Dta: ARRAY [1..43] OF Byte;
      Mask: Char12arr;
      Namr: String20;
      Error, I: Integer;


    PROCEDURE Showname(Namr: String20);
      BEGIN
        WHILE Length(Namr) < 14 DO
          IF Pos('.', Namr) > 0 THEN Insert(' ', Namr, Pos('.', Namr))
          ELSE Namr := Namr + ' ';
        Write(Namr);
        IF Wherex > 65 THEN Writeln;
      END;

    BEGIN { main body of program DirList }

      Fillchar(Dta, Sizeof(Dta), 0); { Initialize the DTA buffer }
      Fillchar(Mask, Sizeof(Mask), 0); { Initialize the mask }
      Fillchar(Namr, Sizeof(Namr), 0); { Initialize the file name }

      Regs.Ax := $1A00; { Function used to set the DTA }
      Regs.Ds := Seg(Dta); { store the parameter segment in DS }
      Regs.Dx := Ofs(Dta); { " " " offset in DX }
      Msdos(Regs); { Set DTA location }
      Error := 0;
      FOR I := 1 TO Length(Mmask) DO Mask[I] := Mmask[I];
      Regs.Ax := $4E00; { Get first directory entry }
      Regs.Ds := Seg(Mask); { Point to the file Mask }
      Regs.Dx := Ofs(Mask);
      Regs.Cx := 22; { Store the option }
      Msdos(Regs); { Execute MSDos call }
      Error := Regs.Ax AND $FF; { Get Error return }
      I := 1; { initialize 'I' to the first element }
      IF (Error = 0) THEN
        REPEAT
          Namr[I] := Chr(Mem[Seg(Dta): Ofs(Dta) + 29 + I]);
          I := I + 1;
        UNTIL NOT (Namr[I - 1] IN [' '..'~']) OR (I > 20);

      Namr[0] := Chr(I - 1); { set string length because assigning }
      Showname(Namr); { by element does not set length }
      WHILE (Error = 0) DO
        BEGIN
        Error := 0;
        Regs.Ax := $4F00; { Function used to get the next }
        { directory entry }
        Regs.Cx := 22; { Set the file option }
        Msdos(Regs); { Call MSDos }
        Error := Regs.Ax AND $FF; { get the Error return }
        I := 1;
        REPEAT
          Namr[I] := Chr(Mem[Seg(Dta): Ofs(Dta) + 29 + I]);
          I := I + 1;
        UNTIL NOT (Namr[I - 1] IN [' '..'~']) OR (I > 20);
        Namr[0] := Chr(I - 1);
        IF (Error = 0) THEN Showname(Namr);
        END;
      Writeln;
      Writeln;
    END; { of Directry }

(* UpCaseStr results in a string of upper case characters to guarantee
   consistant keywords *)


  FUNCTION Upcasestr(S: Str80): Str80;

    VAR
      P: Integer;
    BEGIN
      FOR P := 1 TO Length(S) DO S[P] := Upcase(S[P]);
      Upcasestr := S;
    END;

  (* From Turbo-ToolBox, creates a keyword from the last and first names *)


  FUNCTION Makekey(Lastnm: Str15;
                   Firstnm: Str10): Str25;

    CONST
      Blanks = '               ';
    BEGIN
      Makekey := Upcasestr(Lastnm) + Copy(Blanks, 1,
                 15 - Length(Lastnm)) + Upcasestr(Firstnm);
    END;


  PROCEDURE Strip(VAR S: Str80;
                  N: Integer);

    VAR
      I: Integer;
    BEGIN
      I := N + 1;
      REPEAT
        I := I - 1
      UNTIL (S[I] <> ' ') OR (I = 0);
      S[0] := Chr(I);
    END;


  PROCEDURE Getfile;

    VAR
      D, Rlen, Reccount: Integer;
      Keyn: Str25;

    BEGIN
      Reccount := 0;
      Write('Processing Record: ');
      X := Wherex;
      Y := Wherey;
      REPEAT
        WITH Person DO
          BEGIN
          Fillchar(Person, Sizeof(Person), 0);
          Readln(Infile, Lname, Fname, A1, A2, Ph, Nt);
          Strip(Lastname, 20);
          Strip(Firstname, 15);
          Strip(Address1, 30);
          Strip(Address2, 30);
          Strip(Phone, 14);
          Strip(Note, 25);
          Reccount := Reccount + 1;
          Keyn := Makekey(Lastname, Firstname);
          IF (Keyn[1] IN ['A'..'Z', 'a'..'z']) THEN Goodrecord := True
          ELSE Goodrecord := False;
          Gotoxy(X, Y);
          Clreol;
          Writeln(Reccount, ' ', Lastname, ' ', Firstname);
          IF NOT Goodrecord THEN Write(#7, ' Bad LastName...not added')
          ELSE Addrec(Datf, D, Person);
          END;

      UNTIL Eof(Infile);
    END;


  PROCEDURE Makebbindex;
   {Make an new index file for the database}

    VAR
      Person: Bbrectype;
      I, J, K, D, X, Y: Integer;
      Keyn: STRING [25];

    BEGIN
      Initindex;
      Openfile(Datf, 'BlkBook.DAT', Recordsize);
      IF Ok THEN
        BEGIN
        Writeln;
        Writeln('Creating new index file: BLKBOOK.IXN');
        BEGIN
        Makeindex(Nameindexfile, 'BlkBook.IXN', 25, 0);
        END
        END;
      Write('Indexing..');
      X := Wherex;
      Y := Wherey;
      D := 1;
      WHILE D < Filelen(Datf) DO
        BEGIN
        Getrec(Datf, D, Person);
        WITH Person DO
          BEGIN
          IF Recstatus = 0 THEN
            BEGIN
            Keyn := Makekey(Lastname, Firstname);
            IF NOT (Keyn[1] IN ['A'..'Z', 'a'..'z']) THEN Ok := False
            ELSE
              BEGIN
              Gotoxy(X, Y);
              Clreol;
              Write(Lastname, ', ', Firstname);
              Addkey(Nameindexfile, D, Keyn);
              END;
            IF NOT Ok THEN
              BEGIN
              Gotoxy(10, 20);
              Clreol;
              Write('Duplicate Record for ', Lastname, ', ', Firstname);
              Writeln('. . .Deleted!');
              Deleterec(Datf, D);
              END;
            END;
          END;

        D := D + 1;
        END;
      Closefile(Datf);
      Closeindex(Nameindexfile);
    END;

  BEGIN
    Clrscr;
    Writeln('Available Files:');
    Directry('*.*');
    Writeln('This routine will create an indexed, Blaque Book format data file');
    Writeln('from a text file which has been created with the following format');
    Writeln;
    Writeln('Each line will contain the following information, the data elements');
    Writeln('should not be separated by any spaces, and the line should be');
    Writeln('termitated by a carriage return/line feed: ');
    Writeln;
    Writeln('     Last Name   20 spaces');
    Writeln('     First Name  15 spaces');
    Writeln('     Address 1   30 spaces');
    Writeln('     Address 2   30 spaces');
    Writeln('     Phone       14 spaces');
    Writeln('     Note        25 spaces');
    Writeln;
    Writeln('  The line must be 134 characters in length to load properly');
    Writeln;
    Write('Type in name of text file to load > ');
    Readln(Infilename);
    Outfilename := 'blkbook.dat';
    Assign(Infilelen, Infilename);
    {$i-}
    Reset(Infilelen);
    {$i+}
    IF (Ioresult = 0) THEN
      BEGIN
      Clrscr;
      Lastrec := Sizeof(Infilelen);
      Close(Infilelen);
      Assign(Infile, Infilename);
      Reset(Infile);
      Makefile(Datf, 'BLKBOOK.dat', Recordsize);
      IF Ok THEN
        BEGIN
        Writeln('Creating new data file: BLKBOOK.DAT');
        Getfile;
        Close(Infile);
        Closefile(Datf);
        Makebbindex;
        Writeln;
        Writeln('You may now run BLAKBOOK using the new database.');
        END
      ELSE Write(#7, 'Error in Creating BLKBOOK.DAT');
      END
    ELSE Writeln(#7, 'Input file not found.');
    Writeln;
    Writeln('Type "Q" to quit, any other key will return to utility menu.');
    Read(Kbd, Ch);
    Assign(Returnfile, 'BBUTIL.COM');
    IF Upcase(Ch) <> 'Q' THEN Execute(Returnfile);
  END.
