Topspeed_JPI/TS-V3/MODBASE/ADDRBOOK.MOD

MODULE AddrBook;
(*
 *  ModBase
 *  Release 3.0
 *  (c) Copyright 1986 - 1990 Donald G. Fletcher
 *  (c) Copyright 1986 - 1990 PMI
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *)
(* IMPORT PMD;*)
IMPORT DBIndxes;
IMPORT DspFiles;
IMPORT ErrorManager;
IMPORT HandleIO;
IMPORT KbdInput;
IMPORT LowLevel;
IMPORT M2Strings;
IMPORT ModBase3;
IMPORT MsColors;
IMPORT PosUtils;
IMPORT ScreenDisplay;
IMPORT ScreenInput;
IMPORT Scrn2DBF;
IMPORT ScrnTypes;
IMPORT SmartScreen;
IMPORT StrConv;
IMPORT StrEdit;
IMPORT StringIO;
IMPORT SYSTEM;
IMPORT UserOps;
IMPORT VWindows;
IMPORT WindowPrims;

IMPORT InitCompilerMods;

VAR
  DataFile: ModBase3.DBFile;
  IndexByName: DBIndxes.DBIndex;
  ScreenFile : ScrnTypes.DisplayFile;
  SavedCursorHeight : CARDINAL;

PROCEDURE Confirm(query: ARRAY OF CHAR): BOOLEAN;
  VAR
    KeyHit: CARDINAL;
  BEGIN
    WindowPrims.MsgBox( VWindows.SE, query,
        KbdInput.YorN, KeyHit );
    RETURN KbdInput.CAPkey( KeyHit ) = ORD('Y');
  END Confirm;

PROCEDURE ChangeExtension(VAR name: ARRAY OF CHAR; ext: ARRAY OF CHAR);
  VAR
    i, j: CARDINAL;
  BEGIN
    i := 0;
    StrEdit.CrunchBlanks(name);
    LOOP
      IF (i > HIGH(name)) OR (name[i] = 0C) OR (name[i] = '.') THEN
        EXIT
      END;
      INC(i);
    END; (* LOOP *)
    IF i <= (HIGH(name)) THEN
      name[i] := '.';
      INC(i);
      FOR j := 0 TO 2 DO
        IF i <= HIGH(name) THEN
          name[i] := ext[j];
          INC(i);
        END;
      END;
    END;
  END ChangeExtension;

PROCEDURE GetNewDbFile( VAR TheDbFile: ModBase3.DBFile; VAR TheDbIndex:
    DBIndxes.DBIndex; TheName: ARRAY OF CHAR ): BOOLEAN;
  VAR
    temp: ARRAY [1..8] OF ModBase3.DBFieldDescriptor;
    TmpStr: ARRAY [0..255] OF CHAR;
    IndexOpened : BOOLEAN;
  BEGIN
    IF ModBase3.Initialized(TheDbFile) THEN
      ModBase3.CloseDBF( TheDbFile );
      ModBase3.DisposeDBF(TheDbFile);
      DBIndxes.CloseIndex( TheDbIndex );
      DBIndxes.DisposeIndex(TheDbIndex );
    END;
    ChangeExtension( TheName, 'dbf');
    IndexOpened := FALSE;
    ModBase3.InitDBF( TheName, TheDbFile, 0, TRUE ,FALSE,TRUE,ModBase3.DefaultFixUp);
    IF NOT ModBase3.OpenDBF( TheDbFile ) THEN
      StrEdit.AssignStr(
          'File not found.  Create a new file named ', TmpStr );
      StrEdit.Append( TmpStr, TheName );
      StrEdit.CutTrailingChars( ' ', TmpStr );
      StrEdit.Append( TmpStr, '?  (Y/N)' );
      IF Confirm( TmpStr ) THEN
        temp[1].name := 'NAME';
        temp[1].size := 30;
        temp[1].fldtype := 'C';

        temp[2].name := 'COMPANY';
        temp[2].size := 30;
        temp[2].fldtype := 'C';

        temp[3].name := 'ADDRESS1';
        temp[3].size := 30;
        temp[3].fldtype := 'C';

        temp[4].name := 'ADDRESS2';
        temp[4].size := 30;
        temp[4].fldtype := 'C';

        temp[5].name := 'CITY';
        temp[5].size := 20;
        temp[5].fldtype := 'C';

        temp[6].name := 'STATE';
        temp[6].size := 2;
        temp[6].fldtype := 'C';

        temp[7].name := 'ZIPCODE';
        temp[7].size := 10;
        temp[7].fldtype := 'C';

        temp[8].name := 'ASKDATE';
        temp[8].size := 8;
        temp[8].fldtype := 'C';

        StringIO.PrintMessage(ModBase3.BuildDBF( temp, 8, TheDbFile ));

      END;
    END;
    ChangeExtension(TheName, 'NUM');
    IF ModBase3.OpenDBF(TheDbFile) THEN
      IF HandleIO.FileExists( TheName ) THEN
        DBIndxes.InitIndex(TheName, TheDbIndex,TheDbFile, 5, TRUE,TRUE,FALSE);
        IndexOpened := DBIndxes.OpenIndex(TheDbIndex);
      ELSE
        DBIndxes.InitIndex(TheName, TheDbIndex, TheDbFile, 5, TRUE,TRUE,FALSE);
        StringIO.PrintMessage(DBIndxes.BuildIndex(TheDbIndex, 'NAME'));
        IndexOpened := DBIndxes.OpenIndex(TheDbIndex);
      END;
    END;
    RETURN (*TheDbFile.open AND*) IndexOpened;
  END GetNewDbFile;

  PROCEDURE ProcessNumberedRecord( RecordNumber: LONGINT;
      NewRecord: BOOLEAN; NameIfNew: ARRAY OF CHAR ): ScrnTypes.FrameKey;
    VAR
      NxtFrame: ScrnTypes.FrameKey;
      TheCount: CARDINAL;
    BEGIN
      IF (RecordNumber >ModBase3.NumberRecords(DataFile))  THEN
        IF NOT NewRecord THEN
          RETURN 2;
        END;
      END;
      ScreenDisplay.ReadDisplayFrame( ScreenFile,
          DspFiles.MainFrame, 4 );
      (* The data input frame. *)
      IF NOT NewRecord THEN
        ModBase3.ReadDBRec( DataFile, RecordNumber );
        IF ModBase3.Deleted( DataFile ) THEN
          RETURN 2;
        END;
        Scrn2DBF.DBFToFrame( DataFile, DspFiles.MainFrame );
      ELSE
        ScreenInput.ChangeField( DspFiles.MainFrame,
            NameIfNew, 'NAME', TRUE );
      END;
      REPEAT
        (* MainFrame should always have frame 4, the input frame,
           in it at this point. *)
        ScreenDisplay.ShowDisplayFrame( DspFiles.MainFrame,
            0, 0, 0, 0 );
        ScreenDisplay.PushFrame( DspFiles.MainFrame );
          (* This saves the contents of the input frame until we
             are ready to Edit it or write it to the DataFile. *)
        NxtFrame := 3; (* The Edit/Save/Delete/Return menu. *)
        ScreenInput.Input( NxtFrame );
        CASE NxtFrame OF
          4: (* User wants to Edit record. *)
            ScreenDisplay.PopFrame( DspFiles.MainFrame );
              (* Pop frame 3 off MainFrame's frame stack,
                 bringing frame 4 back to the top. *)
            NxtFrame := ScreenInput.ControlFrame(
                DspFiles.MainFrame, 0, '', FALSE );
        | 9: (*Save*)
            ScreenDisplay.PopFrame( DspFiles.MainFrame );
              (* Brings the input frame back to the top of
                 MainFrame's frame stack. *)
            IF NewRecord THEN
              ModBase3.AppendBlank( DataFile );
            END;
            IF NOT Scrn2DBF.FrameToDBF( DataFile,
               DspFiles.MainFrame) THEN
              IF NOT Confirm( 'Error writing record.  Continue?' ) THEN
                HALT;
              END;
            END;
            ModBase3.WriteDBRec( DataFile );
            IF NOT NewRecord THEN
              DBIndxes.DeleteCurrentEntry( IndexByName );
            ELSE
              NewRecord := FALSE;
            END;
            DBIndxes.AddRecord( DataFile, IndexByName );
            ScreenDisplay.PushFrame( DspFiles.MainFrame );
              (* We're going to be pushing MainFrame at the top
                 of the next loop, so we save and restore it
                 here. *)
            ScreenInput.Input( NxtFrame ); (* success message *)
            ScreenDisplay.PopFrame( DspFiles.MainFrame );
        | 10: (*Delete*)
            ScreenDisplay.PopFrame( DspFiles.MainFrame );
            IF NOT NewRecord THEN
              ModBase3.DeleteRecord( DataFile );
              DBIndxes.DeleteCurrentEntry( IndexByName );
            END;
            NewRecord := TRUE;
            ScreenDisplay.PushFrame( DspFiles.MainFrame );
            ScreenInput.Input( NxtFrame ); (* success message *)
            ScreenDisplay.PopFrame( DspFiles.MainFrame );
        | 2: (*Return*)
            ScreenDisplay.PopFrame( DspFiles.MainFrame );
        END;
      UNTIL (NxtFrame = 2);
      RETURN NxtFrame;
    END ProcessNumberedRecord;

  PROCEDURE ProcessNamedRecord( RecordName: ARRAY OF CHAR; VAR
      RecordNumber: LONGINT ): ScrnTypes.FrameKey;
    VAR
      found: BOOLEAN;
    BEGIN
      IF PosUtils.IsBlank( RecordName ) THEN
        RETURN 2;
      END;
      DBIndxes.FindPositionCh( IndexByName, RecordName, found );
      IF (NOT found) AND
          (NOT Confirm( 'Record not found.  Create it? (Y/N)' )) THEN
        RETURN 2;
      END;
      RecordNumber := DBIndxes.CurrentRec( IndexByName );
      ScreenDisplay.ReadDisplayFrame( ScreenFile,
          DspFiles.MainFrame, 4 );
        (* Reads the data input frame from disk into MainFrame. *)
      RETURN ProcessNumberedRecord( RecordNumber, NOT found, RecordName );
    END ProcessNamedRecord;

  PROCEDURE ImportFromAscii( VAR TheDbFile: ModBase3.DBFile; VAR
      TheIndexFile: DBIndxes.DBIndex; AsciiFileName: ARRAY OF CHAR ):
      BOOLEAN;
    (*Assumes the ascii file contains fixed-length records, each
      on a single CR/LF-terminated line. *)
    VAR
      FieldCnt, FileHandle: CARDINAL;
      CheckStr: ARRAY [0..1] OF CHAR;
      fpt:ModBase3.DBFieldPtr;
    BEGIN
      IF NOT (HandleIO.OpenFile( FileHandle, AsciiFileName) =
          StringIO.NoError) THEN
        RETURN FALSE;
      END;
      fpt:= ModBase3.FieldList(TheDbFile);
      LOOP
        ModBase3.AppendBlank( TheDbFile );
        FieldCnt := 1;
        REPEAT
          IF NOT (HandleIO.BlockRead( FileHandle,
              LowLevel.AddAddr(ModBase3.RecordPtr(TheDbFile),
              fpt^[FieldCnt].offset - 1),
              fpt^[FieldCnt].size ) =
                  StringIO.NoError) THEN
            EXIT;
          END;
          INC( FieldCnt );
        UNTIL FieldCnt > ModBase3.NumberOfFields(TheDbFile);
        IF NOT (HandleIO.BlockRead( FileHandle,
            SYSTEM.ADR(CheckStr), 2 ) = StringIO.NoError) THEN
          (*Read what should be the CR/LF.*)
          EXIT;
        END;
        IF M2Strings.CompareStr( CheckStr, StringIO.CrLf ) # 0 THEN
          EXIT;
          (* We exit here instead of returning false to make sure
             the FileHandle is closed. *)
        END;
        ModBase3.WriteDBRec( TheDbFile );
        DBIndxes.AddRecord( TheDbFile, TheIndexFile );
        IF HandleIO.EndReached( FileHandle ) THEN
          EXIT;
        END;
      END;
      IF (HandleIO.CloseHandle( FileHandle ) = StringIO.NoError) THEN
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END ImportFromAscii;

  PROCEDURE ExportToAscii( VAR TheDbFile: ModBase3.DBFile; AsciiFileName:
      ARRAY OF CHAR );
    VAR
      FieldCnt, FileHandle: CARDINAL;
      RecordNumber: LONGINT;
      fpt:ModBase3.DBFieldPtr;
    BEGIN
      IF NOT (HandleIO.CreateFile( FileHandle, AsciiFileName ) =
          StringIO.NoError) THEN
        RETURN;
      END;
      fpt:= ModBase3.FieldList(TheDbFile);
      RecordNumber := VAL(LONGINT, 0);
      LOOP
        INC( RecordNumber );
        IF (RecordNumber > ModBase3.NumberRecords(TheDbFile)) THEN
          EXIT;
        END;
        ModBase3.ReadDBRec( TheDbFile, RecordNumber );
        IF NOT ModBase3.Deleted( TheDbFile ) THEN
            (* skip records that have been marked for deletion *)
          FieldCnt := 1;
          REPEAT
            IF NOT (HandleIO.BlockWrite( FileHandle,
                LowLevel.AddAddr(ModBase3.RecordPtr(TheDbFile),
                fpt^[FieldCnt].offset - 1),
                fpt^[FieldCnt].size ) =
                    StringIO.NoError) THEN
              EXIT;
            END;
            INC( FieldCnt );
          UNTIL FieldCnt > ModBase3.NumberOfFields(TheDbFile);
          StringIO.WriteEol( FileHandle, '' );
        END;
      END;
      StringIO.PrintMessage( HandleIO.CloseHandle( FileHandle ) );
    END ExportToAscii;

PROCEDURE RestoreDisplay();
  BEGIN
    VWindows.SetForeColor( VWindows.CurrentWindow, MsColors.lightgrey );
    VWindows.SetBackColor( VWindows.CurrentWindow, MsColors.black );
    VWindows.SetMonoAttr( VWindows.CurrentWindow, MsColors.plain );
    VWindows.ClearPart( VWindows.CurrentWindow, 1, 1,
        VWindows.EndCol(VWindows.CurrentWindow),
        VWindows.EndRow(VWindows.CurrentWindow) );
    VWindows.SetCursorHeight( VWindows.CurrentWindow, SavedCursorHeight );
  END RestoreDisplay;

PROCEDURE CloseFiles();
  BEGIN
    DspFiles.CloseDisplayFile( ScreenFile );
    IF  ModBase3.Initialized(DataFile) AND ModBase3.OpenDBF(DataFile) THEN
      ModBase3.CloseDBF( DataFile );
      DBIndxes.CloseIndex( IndexByName );
    END;
  END CloseFiles;


VAR
  NextFrame : ScrnTypes.FrameKey;
  CurrentRecName: ARRAY [0..29] OF CHAR;
  CurrentRecNum: LONGINT;
  AsciiFileName, DbFileName: ARRAY [0..63] OF CHAR;
  dumbool: BOOLEAN;

BEGIN (* MAIN *)
  ModBase3.NilDBF(DataFile);
  SavedCursorHeight := WindowPrims.GetCursorHeight();
  (*VWindows.GetCursorHeight( VWindows.CurrentWindow );*)
  SmartScreen.SetCursorHeight(0);
(*  VWindows.SetCursorHeight( VWindows.CurrentWindow, 0 );*)
  ErrorManager.AddTermProc( RestoreDisplay );
  ErrorManager.AddTermProc( CloseFiles );
  CurrentRecName := '';
  CurrentRecNum := VAL( LONGINT, 1 );
  ScreenDisplay.OpenDisplayFile( ScreenFile, 'AddrBook.DSP' );
  ScreenDisplay.Display( 1 );
    (* the box and the banner *)
  NextFrame := 8;
  ScreenInput.Input( NextFrame );
    (* Prompts for the name of the database file; you could get
       it from the command line if you wanted to. *)
  ScreenInput.ReadInput( DspFiles.MainFrame, DbFileName,
      dumbool, 'filename' );
  StrEdit.CrunchBlanks( DbFileName );
  IF GetNewDbFile( DataFile, IndexByName, DbFileName ) THEN
    LOOP
      (*NextFrame should always be 2 at this point.*)
      ScreenInput.Input( NextFrame );
      CASE NextFrame OF
        11: (*User has selected Record option.*)
          ScreenInput.Input( NextFrame );
            (* This is the drop-down menu. *)
          IF NextFrame # StrConv.ReturnedInt(DspFiles.MainFrame^.parent) THEN
            CASE NextFrame OF
              5: (* user wants a Specific record *)
                ScreenInput.Input( NextFrame );
                  (* Prompts for the name of the record. *)
                IF NextFrame = UserOps.EndCode THEN
                  (*User wants to exit program.*)
                  EXIT;
                ELSE
                  ScreenInput.ReadInput( DspFiles.MainFrame,
                      CurrentRecName, dumbool, 'name' );
                  NextFrame := ProcessNamedRecord( CurrentRecName,
                      CurrentRecNum );
                    (*NextFrame should always be 2 at this point.*)
                END;
            | 1000: (* user wants Next record *)
                IF (CurrentRecNum <= ModBase3.NumberRecords(DataFile)) THEN
                  INC( CurrentRecNum );
                  NextFrame := ProcessNumberedRecord(
                      CurrentRecNum, FALSE, '' );
                ELSE
                  NextFrame := 2;
                END;
            | 1001: (* user wants Prev record *)
                IF (CurrentRecNum > VAL(LONGINT, 1)) THEN
                  DEC( CurrentRecNum );
                  NextFrame := ProcessNumberedRecord(
                      CurrentRecNum, FALSE, '' );
                ELSE
                  NextFrame := 2;
                END;
            END;
          END;

      | 8: (*User has selected File option.*)
          CurrentRecName := '';
          CurrentRecNum := VAL( LONGINT, 1 );
          REPEAT
            ScreenInput.Input( NextFrame );
              (* Prompts for the name of the database file. *)
            ScreenInput.ReadInput( DspFiles.MainFrame,
                DbFileName, dumbool, 'filename' );
            StrEdit.CrunchBlanks( DbFileName );
            IF NOT GetNewDbFile( DataFile, IndexByName, DbFileName ) THEN
              EXIT;
            END;
          UNTIL ModBase3.OpenDBF(DataFile);

      | 6: (*User has selected Import option.*)
          ScreenInput.Input( NextFrame );
          ScreenInput.ReadInput( DspFiles.MainFrame,
                AsciiFileName, dumbool, 'filename' );
          IF NOT ImportFromAscii( DataFile, IndexByName,
              AsciiFileName ) THEN
            IF NOT Confirm( 'Error importing file.  Continue?' ) THEN
              EXIT;
            END;
          END;
          NextFrame := 2;

      | 7:  (*User has selected Export option.*)
          ScreenInput.Input( NextFrame );
          ScreenInput.ReadInput( DspFiles.MainFrame,
                AsciiFileName, dumbool, 'filename' );
          ExportToAscii( DataFile, AsciiFileName );
          NextFrame := 2;

      | UserOps.EndCode: EXIT;
      ELSE
        IF NOT Confirm(
            'Unanticipated value returned from frame 2.  Continue?') THEN
          EXIT;
        END;
      END;
    END;
  END;
END AddrBook.