Power-Programmierung/CD1.mdf/pascal/library/dos/database/dialbook/ccom.pas

Pascal/Delphi Source File | 1990-09-28 | 19.2 KB | 542 lines

Unit CCOM;

{───────────────────────────────────────────────────────────────────────┐
This unit reads and writes to/from a The Complete PC's DIALBOOK.DIR
Phonebook file.  It also will read/write to Group files: These have the
extension .GRP.  It checks for the maximum number of entries allowed for
both types when allowing adding entries.  It will work with any version
of Turbo Pascal 4.0 or later.  The TPString Unit upon which it depends
is from Turbo Power's Turbo Professional Series. The only functions used
from it are Pad(),  Trim() and DefaultExtension().  The last is trivial
and may be dropped if so desired.  Pad and Trim are easy to reproduce. I
just used the Turbo Power unit because they did them in ASM and they are
fast.  DefaultExtension adds a default extension to the file names if
one doesn't already exist.
└───────────────────────────────────────────────────────────────────────}

{───────────────────────────────────────────────────────────────────────}
                              INTERFACE
{───────────────────────────────────────────────────────────────────────}

Uses TPString;

CONST
  NameLen  = 20;
  PhoneLen = 27;
  PollLen  = 8;

TYPE

  PhoneBook = File;       { The PhoneBook File: DIALBOOK.DIR }
  GroupFile = File;       { Count of Phonebook file records }
  PBRec = Record
        Name     : String[NameLen];
        CAMPhone : String[PhoneLen];
        FAXPhone : String[PhoneLen];
        PollPwd  : String[PhoneLen]
  End;
  GrpRec = Record
        Name     : String[NameLen];
        CAMPhone : String[PhoneLen];
        FAXPhone : String[PhoneLen];
        PollPwd  : String[PhoneLen]
  End;


VAR

  RecCount  : Word;       { Count of Phonebook records }
  GrpCount  : Word;       { Count of Group records }

{.PA}
{───────────────────────────────────────────────────────────────────────┐
                  PHONEBOOK FILE SUBROUTINE INTERFACE
└───────────────────────────────────────────────────────────────────────}
Function WritePBHdr( VAR PhoneBook : PhoneBook;
                         RecCount : Word ) : Boolean;

{───────────────────────────────────────────────────────────────────────┐
This function writes the record count into the header. It returns True
if it was successful and False if not.
└───────────────────────────────────────────────────────────────────────}

Function ReadPBHdr( VAR PhoneBook : PhoneBook)  : Word;
{───────────────────────────────────────────────────────────────────────┐
This function reads the record count into from the header.  It returns
True if it was successful and False if not.
└───────────────────────────────────────────────────────────────────────}

Procedure GetPBRec( VAR PhoneBook : PhoneBook;
                    VAR  PBRecord : PBRec     );
{───────────────────────────────────────────────────────────────────────┐
This Procedure reads a record from the phonebook file.  Note that the
phonebook file must already be open.
└───────────────────────────────────────────────────────────────────────}

Procedure PutPBRec( VAR PhoneBook : PhoneBook;
                        PBRecord  : PBRec     );
{───────────────────────────────────────────────────────────────────────┐
This procedure writes a PhoneBook Record.  There must be a valid phone
number in at least one of the fields.  Also, the Name field cannot be
blank.  The Phonebook must be open and the current RecCount must have
been written to the Phonebook.
└───────────────────────────────────────────────────────────────────────}

Function OpenPB(VAR PhoneBook : PhoneBook;
                    FName : String        ) : Integer;
{───────────────────────────────────────────────────────────────────────┐
This Function opens the phonebook file.  It returns True if ok.  The
name of the file will be extended to .DIR if none supplied.
└───────────────────────────────────────────────────────────────────────}

Procedure ClosePB( VAR PhoneBook : PhoneBook);
{───────────────────────────────────────────────────────────────────────┐
This procedure Closes the Phonebook.  It should be called before exiting
to DOS.
└───────────────────────────────────────────────────────────────────────}

{.PA}
{───────────────────────────────────────────────────────────────────────┐
                    GROUP FILE SUBROUTINE INTERFACE
└───────────────────────────────────────────────────────────────────────}
Function ReadGrpHdr(VAR GroupFile : GroupFile) : Word;
{───────────────────────────────────────────────────────────────────────┐
This function reads the record count into the header.  It return True if
it was successful and False if not.
└───────────────────────────────────────────────────────────────────────}

Function WriteGrpHdr( VAR GroupFile : GroupFile;
                          GroupCount : Word     ) : Boolean;
{───────────────────────────────────────────────────────────────────────┐
This function writes the record count into the header.  It returns True
if it was successful and False if not.
└───────────────────────────────────────────────────────────────────────}

Procedure GetGrpRec( VAR GroupFile : Groupfile;
                     VAR GrpRecord : GrpRec  );
{───────────────────────────────────────────────────────────────────────┐
This Procedure reads a record from the Group file.  Note that the
Group File must already be open.
└───────────────────────────────────────────────────────────────────────}

Procedure PutGrpRec( VAR GroupFile : GroupFile;
                         GrpRecord : GrpRec );
{───────────────────────────────────────────────────────────────────────┐
This procedure writes a GroupFile Record.  There must be a valid phone
number in at least one of the fields.  Also, the Name field cannot be
blank.  If either of these conditions occur then the procedure will exit
immediately.  The Resulting GroupRecord will contain both blank Name and
blank FAX phone numbers.  The GroupFile must be open and the current
GroupCount must have been written.
└───────────────────────────────────────────────────────────────────────}

Function OpenGrp(VAR GroupFile : GroupFile;
                     FName     : String    ) : Integer;
{───────────────────────────────────────────────────────────────────────┐
This Function opens the Group file.  It returns True if ok.  The name of
the file will be extended to .GRP if none supplied.
└───────────────────────────────────────────────────────────────────────}

Procedure CloseGrp(VAR GroupFile : GroupFile );
{───────────────────────────────────────────────────────────────────────┐
This procedure Closes the GroupFile.  It should be called before exiting
to DOS.
└───────────────────────────────────────────────────────────────────────}

{.PA}
{───────────────────────────────────────────────────────────────────────}
                             IMPLEMENTATION
{───────────────────────────────────────────────────────────────────────}

{═══════════════════════════════════════════════════════════════════════╗
                       Phonebook file functions.
╚═══════════════════════════════════════════════════════════════════════}

{.CP 27}
Function WritePBHdr( VAR PhoneBook : PhoneBook;
                     RecCount : Word ) : Boolean;
{───────────────────────────────────────────────────────────────────────┐
This function writes the record count into the header.  It must reverse
the order of the bytes in the write.  It return True if it was
successful and False if not.
└───────────────────────────────────────────────────────────────────────}
CONST
  Count : Word = 1;
  MaxCount = 999;

VAR
  CntByte : Byte;

BEGIN
  If RecCount > MaxCount
  then WritePBHdr := False
  else begin
    {$I-}
    CntByte := Lo(RecCount);
    BlockWrite(PhoneBook, CntByte, Count);
    CntByte := Hi(RecCount);
    BlockWrite(PhoneBook, CntByte, Count);
    {$I+}
    WritePBHdr := (IoResult = 0)
  end;
END;


{.CP 25}
Function ReadPBHdr( VAR PhoneBook : PhoneBook) : Word;
{───────────────────────────────────────────────────────────────────────┐
This function reads the record count into the header.  It must reverse
the order of the bytes in the read.  It return True if it was successful
and False if not.
└───────────────────────────────────────────────────────────────────────}
CONST
  Count : Word = 1;
  MaxCount = 999;

VAR
  LoByte, HiByte : Byte;
  i : Integer;

BEGIN
  {$I-}
  BlockRead(PhoneBook, LoByte, Count);
  BlockWrite(PhoneBook, HiByte, Count);
  {$I+}
  RecCount := HiByte;
  RecCount := HiByte Shl 8;
  RecCount := RecCount OR LoByte;
  ReadPBHdr := RecCount;
END;


{.CP 43}
Procedure GetPBRec( VAR PhoneBook : PhoneBook;
                    VAR PBRecord  : PBRec );
{───────────────────────────────────────────────────────────────────────┐
This Function reads a record from the phonebook file.  Note that the
phonebook file must already be open.  If it is a succesful read, then
the function will return True.
└───────────────────────────────────────────────────────────────────────}

CONST
  Count : Word = 1;           { How many bytes to Read    }

VAR
   i     : integer;
   Name, CAMPhone, FAXPhone, PollPWD  : String;
   Zero, Terminator  : Byte;


BEGIN
    For i := 1 to NameLen Do                          { Name     }
      BlockRead( PhoneBook, Name[i], count );
    PBRecord.Name := Trim(Name);
    BlockRead( PhoneBook, Zero, Count );
    For i := 1 to PhoneLen Do                         { CAMPhone }
      BlockRead( PhoneBook, CAMPhone[i], count );
    PBRecord.CAMPhone := Trim(CAMPhone);
    BlockRead( PhoneBook, Zero, Count );
    For i := 1 to PhoneLen Do                         { FAXPhone }
      BlockRead( PhoneBook, FAXPhone[i], count );
    PBRecord.FAXPhone := Trim(FAXPhone);
    BlockRead( PhoneBook, Zero, Count );
    For i := 1 to PollLen Do                          { PollPWD  }
      BlockRead( PhoneBook, PollPWD[i], count );
    PBRecord.PollPWD := Trim(PollPWD);
    BlockRead( PhoneBook, Zero, Count );
    BlockRead(PhoneBook, Terminator, Count);
    If Terminator > 1 then begin
       WriteLn( 'Error Reading Record.');
       Halt;
    end;
    BlockRead(PhoneBook, Zero, Count)
END;  { function GetPBRec  }


{.PA}
Procedure PutPBRec( VAR PhoneBook : PhoneBook;
                        PBRecord  : PBRec );
{───────────────────────────────────────────────────────────────────────┐
This function writes a PhoneBook Record.  It will return True if
successful and False if not.  It may return False if there is
insufficient information to write the record.  For instance, there must
be a valid phone number in at least one of the fields.  Also, the Name
field cannot be blank.  The Phonebook must be open and the current
RecCount must have been written to the Phonebook.
└───────────────────────────────────────────────────────────────────────}

CONST
  Terminator : Byte = 1;      { Last Byte of Each Record }
  Zero  : Byte = 0;
  Count : Word = 1;

VAR
   i     : integer;
   Name  : String[NameLen];
   CAMPhone : String[PhoneLen];
   FAXPhone : String[PhoneLen];
   PollPwd  : String[PollLen];

BEGIN
    Name     := PBRecord.Name;
    CAMPhone := PBRecord.CAMPhone;
    FAXPhone := PBRecord.FAXPhone;
    PollPWD  := PBRecord.PollPWD;
    If (Length(Name) = 0) or
       ( (Length(CAMPhone) = 0) and (Length(FAXPhone) = 0) ) Then  Exit;
    Name := Pad(Trim(Name), NameLen);
    For i := 1 to NameLen Do
      BlockWrite( PhoneBook, Name[i], count );
    BlockWrite( PhoneBook, Zero, Count );
    CAMPhone := Pad(Trim(CAMPhone), PhoneLen);
    For i := 1 to PhoneLen Do
      BlockWrite( PhoneBook, CAMPhone[i], count );
    BlockWrite( PhoneBook, Zero, Count );
    FAXPhone := Pad(Trim(FAXPhone), PhoneLen);
    For i := 1 to PhoneLen Do
      BlockWrite( PhoneBook, FAXPhone[i], count );
    BlockWrite( PhoneBook, Zero, Count );
    PollPWD := Pad(Trim(PollPWD), PollLen);
    For i := 1 to PollLen Do
      BlockWrite( PhoneBook, PollPWD[i], count );
    BlockWrite( PhoneBook, Zero, Count );
    BlockWrite(PhoneBook, Terminator, Count);
    BlockWrite(PhoneBook, Zero, Count)
END;

{.cp 20}
FUNCTION OpenPB( VAR PhoneBook : PhoneBook;
                     FName : String ) : Integer;
{───────────────────────────────────────────────────────────────────────┐
This Function opens the phonebook file.  It returns 0 if ok.  The
name of the file will be extended to .DIR if none supplied.
└───────────────────────────────────────────────────────────────────────}

VAR
  PBError : Integer;

BEGIN
  OpenPB := 110;
  RecCount := 0;
  {$I-}
  FName := DefaultExtension( FName, 'DIR');
  Assign(PhoneBook, FName);
  Rewrite(PhoneBook, 1);
  {$I+}
  OpenPB := IoResult;
END;

{.cp 9}
PROCEDURE ClosePB( VAR PhoneBook : PhoneBook);
{───────────────────────────────────────────────────────────────────────┐
This procedure Closes the Phonebook.  It MUST be called before exiting
to DOS.
└───────────────────────────────────────────────────────────────────────}

BEGIN
  Close(PhoneBook)
END;

{.PA}
{═══════════════════════════════════════════════════════════════════════╗
                         Group file functions.
╚═══════════════════════════════════════════════════════════════════════}

{.CP 17}
Function WriteGrpHdr( VAR GroupFile : GroupFile;
                          GroupCount : Word ) : Boolean;
{───────────────────────────────────────────────────────────────────────┐
This function writes the record count into the header.  It must do this
in reverse order.  The file must be open.
└───────────────────────────────────────────────────────────────────────}
CONST
  Count : Word = 1;
  MaxCount = 99;

VAR
  CntByte : Byte;

BEGIN
  If GroupCount > MaxCount then
    WriteGrpHdr := False
  else begin
    {$I-}
    CntByte := Lo(GroupCount);
    BlockWrite(GroupFile, CntByte, Count);
    CntByte := Hi(GroupCount);
    BlockWrite(GroupFile, CntByte, Count);
    {$I+}
    WriteGrpHdr := (IoResult = 0)
  end;
END;

{.CP 17}
Function ReadGrpHdr( VAR GroupFile : GroupFile ) : Word;
{───────────────────────────────────────────────────────────────────────┐
This function reads the record count of the header.  It must reverse
the order of the bytes in the read.  The GroupFile must be open.
└───────────────────────────────────────────────────────────────────────}
CONST
  Count : Word = 1;
  MaxCount = 99;

VAR
  LoByte, HiByte : Byte;
  i : Integer;
  GroupCount : Word;

BEGIN
  {$I-}
  BlockRead(GroupFile, LoByte, Count);
  BlockWrite(GroupFile, HiByte, Count);
  {$I+}
  GroupCount := HiByte;
  GroupCount := HiByte Shl 8;
  GroupCount := RecCount OR LoByte;
  ReadGrpHdr := GroupCount;
END;


{.CP 43}
Procedure GetGrpRec( VAR GroupFile : GroupFile;
                     VAR GrpRecord : GrpRec );
{───────────────────────────────────────────────────────────────────────┐
This Function reads a record from the Group file.  Note that the Group
file must already be open, and the header must have already been
written.  If it is a succesful read, then the function will return True.
└───────────────────────────────────────────────────────────────────────}

CONST
  Count : Word = 1;           { How many bytes to Read    }
  TermChar = $4A;

VAR
   i     : integer;
   Zero, Terminator  : Byte;
   Name : String[NameLen];
   CAMPhone : String[PhoneLen];
   FAXPhone : String[PhoneLen];
   PollPwd : String[PollLen];

BEGIN
    For i := 1 to NameLen Do                          { Name     }
      BlockRead( GroupFile, Name[i], count );
    GrpRecord.Name := Trim(Name);
    BlockRead( GroupFile, Zero, Count );

    For i := 1 to PhoneLen Do                         { CAMPhone }
      BlockRead( GroupFile, CAMPhone[i], count );
    GrpRecord.CAMPhone := Trim(CAMPhone);
    BlockRead( GroupFile, Zero, Count );
    For i := 1 to PhoneLen Do                         { FAXPhone }
      BlockRead( GroupFile, FAXPhone[i], count );
    GrpRecord.FAXPhone := Trim(FAXPhone);
    BlockRead( GroupFile, Zero, Count );
    For i := 1 to PollLen Do                          { PollPWD  }
      BlockRead( GroupFile, PollPWD[i], count );
    GrpRecord.PollPWD := Trim(PollPWD);
    BlockRead( GroupFile, Zero, Count );
    BlockRead(GroupFile, Terminator, Count);
    If (Terminator <> TermChar) then
       WriteLn( 'Trouble Reading Group File Records' );
    For i := 1 to 4 Do
      BlockRead(GroupFile, Zero, Count)
END;  { function GetPBRec  }


{.CP 48}
Procedure PutGrpRec( VAR GroupFile : GroupFile;
                         GrpRecord : GrpRec    );
{───────────────────────────────────────────────────────────────────────┐
This procedure writes a GroupFile Record.  There must be a valid phone
number in at least one of the fields.  Also, the Name field cannot be
blank.  If either of these conditions occur then the procedure will exit
immediately.  The Resulting GroupRecord will contain both blank Name and
blank FAX phone numbers.  The GroupFile must be open and the current
GroupCount must have been written.
└───────────────────────────────────────────────────────────────────────}

CONST
  TermChar : Byte= $4A;      { Last Byte of Each Record }
  Zero  : Byte = 0;
  Count : Word = 1;

VAR
   i     : integer;
   Name     : String[NameLen];
   CAMPhone : String[PhoneLen];
   FAXPhone : String[PhoneLen];
   PollPwd  : String[PollLen];

BEGIN
    Name     := GrpRecord.Name;
    CAMPhone := GrpRecord.CAMPhone;
    FAXPhone := GrpRecord.FAXPhone;
    PollPwd  := GrpRecord.PollPwd;

    If (Length(Name) = 0) or (Length(FAXPhone) = 0)
      Then Exit;
    Name := Pad(Trim(Name), NameLen);
    For i := 1 to NameLen Do
      BlockWrite( GroupFile, Name[i], count );
    BlockWrite( GroupFile, Zero, Count );

    CAMPhone := Pad(Trim(CAMPhone), PhoneLen);
    For i := 1 to PhoneLen Do
      BlockWrite( GroupFile, CAMPhone[i], count );
    BlockWrite( GroupFile, Zero, Count );

    FAXPhone := Pad(Trim(FAXPhone), PhoneLen);
    For i := 1 to PhoneLen Do
      BlockWrite( GroupFile, FAXPhone[i], count );
    BlockWrite( GroupFile, Zero, Count );

    PollPWD := Pad(Trim(PollPWD), PollLen);
    For i := 1 to PollLen Do
      BlockWrite( GroupFile, PollPWD[i], count );
    BlockWrite( GroupFile, Zero, Count );

    BlockWrite(GroupFile, TermChar, Count);
    For i := 1 to 4 Do
      BlockWrite(GroupFile, Zero, Count)
END;


{.cp 20}
FUNCTION OpenGrp( VAR GroupFile : GroupFile;
                      FName : String        ) : Integer;
{───────────────────────────────────────────────────────────────────────┐
This Function opens the Group file.  It returns 0 if everything went
well, otherwise it returns the Turbo Pascal DOS error.  The name of the
file will be extended to .GRP if none supplied.
└───────────────────────────────────────────────────────────────────────}

VAR
  GrpError : Integer;

BEGIN
  OpenGrp := 110;
  GrpCount := 0;
  {$I-}
  FName := DefaultExtension( FName, 'GRP');
  Assign(GroupFile, FName);
  Rewrite(GroupFile, 1);
  {$I+}
  OpenGrp := IoResult;
END;


{.cp 12}
PROCEDURE CloseGrp( VAR GroupFile : GroupFile);
{───────────────────────────────────────────────────────────────────────┐
This procedure Closes the GroupFile.  It MUST be called before exiting
to DOS.
└───────────────────────────────────────────────────────────────────────}

BEGIN
  Close(GroupFile)
END;

END.  { End of Unit }