home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
blkbk31.zip
/
TXTTOBB.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1986-03-04
|
11KB
|
357 lines
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.