MODULE PMIdbms; (* * REPERTOIRE * Release 1.6 * By Charles Bradford and Cole Brecheen * (c) Copyright 1985-1991 PMI * Green Bay Wisconsin * All rights reserved * (414) 468-6040 * * $Header: D:/logfiles/demos/pmidbms.mov 1.3 09 Dec 1990 11:18:22 coleb $ * * A program to illustrate use of REPERTOIRE's screen * and NdxFile system. This is the advanced example; * programmers new to REPERTOIRE should begin with DEMO1. *) (* IMPORT EMS; EMS is part of PMI's EmsStorage, a product separate from Repertoire. It allows Repertoire applications automatically to use expanded memory. If you don't have it, just comment out the IMPORT EMS from any program modules in which it appears.*) IMPORT BuildLst; IMPORT ByteFiddler; IMPORT ControlUtils; IMPORT DateFunctions; IMPORT DirManager; IMPORT Drectory; IMPORT DspFiles; IMPORT EnvironUtils; IMPORT ErrorManager; IMPORT ErrStrgs; IMPORT HandleIO; IMPORT FrameManager; IMPORT FramePainter; IMPORT GenLists; IMPORT InitCompilerMods; IMPORT InputManager; IMPORT KbdInput; IMPORT ListUtils; IMPORT NdxUtils; IMPORT MsgBox2; IMPORT NdxBones; IMPORT NdxFiles; IMPORT NdxTypes; IMPORT NumTypes; IMPORT PosUtils; IMPORT PrtFrame; IMPORT Scrn2Ndx; IMPORT ScrnTypes; IMPORT ScrnUtl1; IMPORT ScrnUtl2; IMPORT SmartScreen; IMPORT StrConv; IMPORT StrEdit; IMPORT StringIO; IMPORT M2Strings; IMPORT UserOps; IMPORT VEditor; IMPORT VWindows; IMPORT WindowPrims; VAR NdxFile: NdxTypes.NdxFileType; ScreenFile: ScrnTypes.DisplayFile; EntryFrame: ScrnTypes.DisplayFrame; NdxFileName, RecName: ARRAY [0..79] OF CHAR; dumbool: BOOLEAN; PrnHandle, SavedCursorHeight : CARDINAL; PROCEDURE PrintMenu(); VAR TmpName: ScrnTypes.AFrameName; thestr: ARRAY [0..79] OF CHAR; ff: ARRAY [0..0] OF CHAR; FormFeeding, dumbool: BOOLEAN; TmpList: GenLists.GenList; chkey: CARDINAL; LeftMargin : INTEGER; InvoiceFrame, DialogBox: ScrnTypes.DisplayFrame; PROCEDURE WriteInvoice(); VAR NewEd: GenLists.GenList; month, day, year, AcctBalance: CARDINAL; date, name, tmpstr : ARRAY [0..50] OF CHAR; BEGIN ControlUtils.ReadInput( EntryFrame, tmpstr, 'ACCTBAL' ); (* get account balance string from record entry frame *) IF NOT StrConv.StrToCardinal(tmpstr, 0, AcctBalance) THEN AcctBalance := 0; END; IF AcctBalance > 0 THEN StrEdit.MakeCurrency( '$', tmpstr ); ControlUtils.ChangeField( InvoiceFrame, tmpstr, 'AMTDUE', TRUE ); ControlUtils.ChangeField( InvoiceFrame, '$0.00', 'AMTPAID', TRUE ); ELSE ControlUtils.ChangeField( InvoiceFrame, 'prepaid', 'TERMS', TRUE ); END; EnvironUtils.GetDate( month, day, year, name, date ); (* get the system date *) ControlUtils.ChangeField( InvoiceFrame, date, 'DATE', TRUE ); (*Insert the current date.*) ControlUtils.ChangeField( InvoiceFrame, date, 'SHIPDATE', TRUE); (* fill in default dates *) ControlUtils.ReadInput( EntryFrame, name, 'NAME'); (* get the name of the customer out of the record entry frame*) ScrnUtl2.CopyEdField( EntryFrame, 'ADDRESS', InvoiceFrame, 'SOLDTO'); ScrnUtl2.GetEdField( InvoiceFrame, 'SOLDTO', NewEd ); GenLists.ListInsert( name, GenLists.StrCode, NewEd, 1); (* put name and address in sold to field; notice that we don't have to do a PutEdField here because ScrnUtl2.GetEdField returns the real list, not a copy of it. *) ScrnUtl2.CopyEdField( InvoiceFrame, 'SOLDTO', InvoiceFrame, 'SHIPTO'); FramePainter.ShowDisplayFrame( InvoiceFrame, 0, 0, 0, 0 ); InputManager.ControlFrame( InvoiceFrame, 0, '', FALSE, TmpName ); (* now let user change screen if desired *) IF NOT PosUtils.Equal( TmpName, InvoiceFrame^.normlnext ) THEN RETURN END; IF AcctBalance > 0 THEN PrtFrame.PrintDisplayFrame( InvoiceFrame, PrnHandle, LeftMargin ); StringIO.WriteStr( PrnHandle, 14C); (* send a page feed to the printer *) END; ControlUtils.ChangeField( InvoiceFrame, ' This Copy For Your Records.', 'TITLE', FALSE ); PrtFrame.PrintDisplayFrame( InvoiceFrame, PrnHandle, LeftMargin ); END WriteInvoice; BEGIN (*PrintMenu*) ScrnTypes.InitDisplayFrame( DialogBox, VWindows.CurrentWindow ); ScrnTypes.InitDisplayFrame( InvoiceFrame, VWindows.CurrentWindow ); DspFiles.ReadDisplayFrame( ScreenFile, InvoiceFrame, '28' ); (* now fill screen with input data *) PrnHandle := StringIO.StdPrn; ff[0] := CHR(12); LOOP TmpName := 'PrintDialog'; (*The print menu screen.*) ControlUtils.ReadShowAndCntrl( ScreenFile, DialogBox, TmpName ); IF PosUtils.Equal( TmpName, '5' ) THEN (* User pressed Cancel or Escape *) EXIT; END; chkey := ScrnUtl1.WhichChoiceKey( DialogBox, ScrnUtl1.FieldNum(DialogBox, 'file') ); CASE CHR(chkey) OF 'f': HandleIO.OpenForAppending( "PRINTER.TXT", PrnHandle); | 'p': StringIO.PrintMessage(HandleIO.OpenFile(PrnHandle,'PRN')); END; FormFeeding := ScrnUtl1.WhichChoiceKey( DialogBox, ScrnUtl1.FieldNum(DialogBox, 'ff') ) = ORD('Y'); ScrnUtl1.GetIntField( DialogBox, ScrnUtl1.FieldNum(DialogBox, 'margin'), LeftMargin ); chkey := ScrnUtl1.WhichChoiceKey( DialogBox, ScrnUtl1.FieldNum(DialogBox, 'label') ); CASE CHR(chkey) OF 'A': ControlUtils.ReadInput( EntryFrame, thestr, 'NAME'); StringIO.PrintMessage( HandleIO.FillFile( PrnHandle, LeftMargin, ' ' ) ); StrEdit.CrunchBlanks(thestr); StringIO.WriteEol( PrnHandle, thestr ); IF NOT ScrnUtl1.ListFromEdField( EntryFrame, ScrnUtl1.FieldNum( EntryFrame, 'ADDRESS' ), TmpList ) THEN HALT(); END; ListUtils.PrintList( PrnHandle, TmpList, LeftMargin, StringIO.CrLf ); | 'I': WriteInvoice(); | 'T': PrtFrame.PrintFrameData( EntryFrame, PrnHandle, LeftMargin ); END; IF FormFeeding THEN StringIO.WriteEol( PrnHandle, ff ); END; END; StringIO.PrintMessage( HandleIO.CloseHandle( PrnHandle)); ScrnUtl2.CloseDisplayFrame( InvoiceFrame ); ScrnUtl2.CloseDisplayFrame( DialogBox ); END PrintMenu; PROCEDURE DoOneRecord( RecName: ARRAY OF CHAR ); VAR KeyHit, month, day, year: CARDINAL; DateStr, dumstr: ARRAY [0..15] OF CHAR; ch: CHAR; NextName: ScrnTypes.AFrameName; TmpFrame: ScrnTypes.DisplayFrame; BEGIN ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); DspFiles.ReadFrame( ScreenFile, EntryFrame, '3' ); (*Frame 3 is the entry form.*) IF NOT Scrn2Ndx.FillScrFast( NdxFile, EntryFrame, RecName, '') THEN (*FillScr says we're creating a new record, so fill the screen with some default values to save the user some typing.*) ControlUtils.ChangeField( EntryFrame, RecName, 'name', TRUE ); (*Insert the RecName they've selected.*) EnvironUtils.GetDate( month, day, year, dumstr, DateStr ); ControlUtils.ChangeField( EntryFrame, DateStr, 'date', TRUE ); (*Insert the current date.*) END; FramePainter.ShowDisplayFrame( EntryFrame, 0, 0, 0, 0 ); (*Displays the entry form.*) REPEAT NextName := '5'; (*The menu at the top of the screen.*) ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextName ); IF PosUtils.Equal( NextName, '2' ) THEN (* User pressed Escape *) IF EntryFrame^.FrameChanged THEN IF MsgBox2.MsgOkay( TmpFrame, VWindows.SE, "Changes made will be lost. Please confirm." ) THEN ScrnUtl2.CloseDisplayFrame( TmpFrame ); RETURN; ELSE ch := 0C; NextName := '5'; END; ELSE ScrnUtl2.CloseDisplayFrame( TmpFrame ); RETURN; END; ELSE ch := CAP( ScrnUtl1.SelectedChar( TmpFrame ) ); END; IF ch = 'S' THEN (*Store*) StrEdit.SetLength( RecName, 0 ); (*We're using a null record name here to make PutScrFast take its record name from the 'name' field in EntryFrame.*) EnvironUtils.GetDate( month, day, year, dumstr, DateStr ); ControlUtils.ChangeField( EntryFrame, DateStr, 'date', TRUE ); (*Make the date field reflect date of last change.*) IF Scrn2Ndx.PutScrFast( NdxFile, EntryFrame, RecName, 'name') THEN IF NOT NdxFiles.WriteRecord( NdxFile, RecName) THEN ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '17' ); (*"Cannot put record in file" message*) ELSE EntryFrame^.FrameChanged := FALSE; ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '15' ); (*"Record successfully added" message*) END; ELSE ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '17' ); END; ELSIF ch = 'D' THEN (*Delete*) ControlUtils.ReadInput( EntryFrame, RecName, 'name'); IF MsgBox2.MsgOkay( TmpFrame, VWindows.SE, "Preparing to delete record. Please confirm." ) THEN IF NdxFiles.DeleteRecord( NdxFile, RecName) THEN ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '14' ); (* successfully deleted *) ELSE ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '11' ); (* cannot delete this record *) END; END; ELSIF ch = 'P' THEN (* Print *) PrintMenu(); FramePainter.ShowDisplayFrame( EntryFrame, 0, 0, 0, 0 ); ELSIF ch = 'E' THEN (*Edit.*) ControlUtils.Control( EntryFrame ); END; UNTIL PosUtils.Equal(NextName, '2'); (*Frame 2 is the Main Menu *) ScrnUtl2.CloseDisplayFrame( TmpFrame ); END DoOneRecord; PROCEDURE ShowAllRecords( TheList: GenLists.GenList ); VAR cnt, lngth, TypeCode: CARDINAL; TmpName: NdxTypes.RecNameStr; TmpFrame: ScrnTypes.DisplayFrame; BEGIN ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '42' ); (* changes the line at the bottom that explains the special keys *) lngth := GenLists.ListLength( TheList ); cnt := 1; WHILE (cnt <= lngth) DO GenLists.GetElmt( TheList, cnt, TmpName, TypeCode ); DoOneRecord( TmpName ); INC(cnt); END; ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '1' ); (* resets the bottom line explaining the special keys *) ScrnUtl2.CloseDisplayFrame( TmpFrame ); END ShowAllRecords; PROCEDURE ProcessRecord(); VAR spot, dumc, LandingField, KeyHit: CARDINAL; done: BOOLEAN; NdxRec: NdxTypes.NdxElement; NextFrame: ScrnTypes.AFrameName; TmpFrame: ScrnTypes.DisplayFrame; BEGIN ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); RecName := ''; REPEAT NextFrame := '4'; (*the record selection form*) DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame ); REPEAT ControlUtils.ChangeField( TmpFrame, RecName, 'name', TRUE ); FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 ); LandingField := 0; InputManager.ControlFrame( TmpFrame, LandingField, '', FALSE, NextFrame ); IF NOT PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN ScrnUtl2.CloseDisplayFrame( TmpFrame ); RETURN; END; ControlUtils.ReadInput( TmpFrame, RecName, 'name'); done := NdxFiles.RecordExists( NdxFile, RecName); IF NOT done THEN done := MsgBox2.MsgOkay( TmpFrame, VWindows.SE, "Record not found. Preparing to create it. Please confirm." ); END; IF NOT done THEN IF MsgBox2.MsgOkay( TmpFrame, VWindows.SE, "Search for a name in which this pattern appears?" ) THEN StrEdit.CrunchBlanks( RecName ); spot := GenLists.ScanList( RecName, NdxFile^.Ndx, 1, 65535, dumc ); IF spot > 0 THEN GenLists.GetElmt( NdxFile^.Ndx, spot, NdxRec, dumc ); M2Strings.Assign( NdxRec.RecName, RecName ); ELSE RecName := ''; END; END; END; UNTIL done; DoOneRecord( RecName ); UNTIL NOT PosUtils.Equal( NextFrame, '4' ); ScrnUtl2.CloseDisplayFrame( TmpFrame ); END ProcessRecord; PROCEDURE StoreList( TheList: GenLists.GenList ); VAR ListName: ARRAY [0..79] OF CHAR; TmpList: GenLists.GenList; NextFrame: ScrnTypes.AFrameName; TmpFrame: ScrnTypes.DisplayFrame; BEGIN ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); NextFrame := '20'; (*List Storage Form*) DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame ); IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame, 'list' )) THEN (*Find the editor field.*) HALT(); END; IF NOT ScrnUtl1.ListToEdField( TheList, TmpFrame, TmpFrame^.CurrentField ) THEN (*Put the list created in BuildList into the editor field.*) HALT(); END; StrConv.CardinalToStr( GenLists.ListLength( TheList), 0, ListName); StrEdit.Append( ListName, '.'); ControlUtils.ChangeField( TmpFrame, ListName, 'size', FALSE); FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 ); REPEAT InputManager.ControlFrame( TmpFrame, 0, '', FALSE, NextFrame ); IF PosUtils.Equal( NextFrame, '999' ) THEN (*They want to store the list.*) ControlUtils.ReadInput( TmpFrame, ListName, 'name' ); (*Get the name they've chosen for the list out of the 'name' field.*) GenLists.CopyList( TheList, TmpList ); IF NOT BuildLst.StoreRecNameList( NdxFile, ListName, TmpList ) THEN HALT(); END; ScrnUtl2.ShowMessage( ScreenFile, '27' ); (*Says store successful; waits for any key.*) ScrnUtl2.CloseDisplayFrame( TmpFrame ); RETURN; END; UNTIL PosUtils.Equal( NextFrame, '21' ); ScrnUtl2.CloseDisplayFrame( TmpFrame ); END StoreList; PROCEDURE SearchFile(); VAR ListMade: GenLists.GenList; ErrorField: CARDINAL; message, LimitingList: ARRAY [0..79] OF CHAR; dumbool: BOOLEAN; NextFrame: ScrnTypes.AFrameName; MsgFrame, TmpFrame: ScrnTypes.DisplayFrame; BEGIN (*SearchFile*) ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); LOOP StrEdit.AssignStr( '', message ); ErrorField := 0; NextFrame := '21'; (*The List Building form*) ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, NextFrame ); REPEAT InputManager.ControlFrame( TmpFrame, ErrorField, message, FALSE, NextFrame ); ErrorField := 0; (*Reset ErrorField and message so they'll signal an error on the next loop only if there's really been an error.*) StrEdit.AssignStr( '', message ); IF NOT PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN (*exit if they press the backup or program-exit keys.*) EXIT; END; IF NOT ScrnUtl1.FieldIsBlank( TmpFrame, 'listname', ErrorField) THEN ControlUtils.ReadInput( TmpFrame, LimitingList, 'listname' ); (*Get the name of the list they've chosen to use out of the 'name' field.*) ELSE StrEdit.AssignStr( '', LimitingList ); END; ScrnTypes.InitDisplayFrame( MsgFrame, VWindows.CurrentWindow ); ScrnUtl2.ReadAndShow( ScreenFile, MsgFrame, '43' ); (*a screen that says list is being created *) BuildLst.BuildList( NdxFile, TmpFrame, 1, 13, LimitingList, ErrorField, ListMade ); FrameManager.EraseFrame( MsgFrame ); ScrnUtl2.CloseDisplayFrame( MsgFrame ); IF ErrorField = 0 THEN BuildLst.DeleteListRec( ListMade); StoreList( ListMade ); EXIT; ELSE StrEdit.AssignStr( "Something's wrong with this field.", message ); END; UNTIL ErrorField = 0; END; ScrnUtl2.CloseDisplayFrame( TmpFrame ); END SearchFile; PROCEDURE ManageLists(); VAR TmpList: GenLists.GenList; LastListName : ARRAY [0..79] OF CHAR; NextFrame: ScrnTypes.AFrameName; TmpFrame: ScrnTypes.DisplayFrame; BEGIN ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); LastListName[0] := 0C; LOOP NextFrame := '29'; (*The main list management menu.*) ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame ); IF PosUtils.Equal( NextFrame, TmpFrame^.parent ) THEN EXIT; END; CASE ScrnUtl1.SelectedChar(TmpFrame) OF 'M': (*Make a new list.*) SearchFile(); | 'D': (*Delete a list.*) IF ControlUtils.GetStrResponse( ScreenFile, '30', LastListName, LastListName ) THEN (* if they didn't try to back up or exit *) IF BuildLst.DelRecNameList( NdxFile, LastListName ) THEN ScrnUtl2.ShowMessage( ScreenFile, '34' ); (*Says the list was successfully deleted.*) ELSE ScrnUtl2.ShowMessage( ScreenFile, '35' ); (*Says no such list stored; waits for any key.*) END; END; | 'S': (*Show lists.*) IF BuildLst.GetListNames( NdxFile, TmpList ) AND (GenLists.ListLength( TmpList) # 0) THEN IF NOT ControlUtils.ListBox( ScreenFile, '31', TmpList, LastListName, NextFrame ) THEN (* We don't care if they press Esc here. *) END; ELSE ScrnUtl2.ShowMessage( ScreenFile, '35' ); (*Says no such list stored and waits for a key.*) END; | 'E': (*Edit a list.*) IF ControlUtils.GetStrResponse( ScreenFile, '32', LastListName, LastListName ) THEN (* if they didn't try to back up or exit *) IF BuildLst.GetRecNameList( NdxFile, LastListName, TmpList ) THEN StoreList( TmpList ); ELSE ScrnUtl2.ShowMessage( ScreenFile, '35' ); (*Says no such list stored; waits for any key.*) END; END; | 'A': (*Examine list of All records.*) NdxUtils.GetRecNames( NdxFile, TmpList ); StoreList( TmpList ); | 'R': (*Retrieve listed records.*) IF ControlUtils.GetStrResponse( ScreenFile, '33', LastListName, LastListName ) THEN (* if they didn't try to back up or exit *) IF BuildLst.GetRecNameList( NdxFile, LastListName, TmpList ) THEN ShowAllRecords( TmpList ); NextFrame := '29'; (* The main list management menu. *) ELSE ScrnUtl2.ShowMessage( ScreenFile, '35' ); (*Says no such list stored; waits for any key.*) END; END; ELSE END; END; ScrnUtl2.CloseDisplayFrame( TmpFrame ); END ManageLists; PROCEDURE ErrorOpeningFile( ErrMsg: CARDINAL; ErrText, fname: ARRAY OF CHAR ); VAR TmpStr1: ARRAY [0..149] OF CHAR; TmpStr2: ARRAY [0..59] OF CHAR; KeyHit: CARDINAL; BEGIN StrEdit.AssignStr( "Error in opening '", TmpStr1 ); StrEdit.Append( TmpStr1, fname ); StrEdit.Append( TmpStr1, "': " ); IF ErrMsg # StringIO.MissingMessage THEN ErrStrgs.NumToStr( ErrMsg, TmpStr2 ); StrEdit.Append( TmpStr1, TmpStr2 ); ELSE StrEdit.Append( TmpStr1, ErrText); END; StrEdit.Append( TmpStr1, " Press any key." ); WindowPrims.MsgBox( VWindows.SE, TmpStr1, KbdInput.AnyKeyNum, KeyHit ); END ErrorOpeningFile; PROCEDURE NotPmiFile( fname: ARRAY OF CHAR): BOOLEAN; BEGIN RETURN NOT PosUtils.Present( 'pmidbms', fname); END NotPmiFile; PROCEDURE ExportRecords( NdxFile: NdxTypes.NdxFileType; VAR NextFrame: ScrnTypes.AFrameName; ScreenFile: ScrnTypes.DisplayFile); VAR TmpFrame: ScrnTypes.DisplayFrame; PROCEDURE ExportToNdxFile( NdxF1: NdxTypes.NdxFileType; RecNameList, MatchingFields: GenLists.GenList; NdxF2: NdxTypes.NdxFileType ); VAR SearchingAll: BOOLEAN; TypeCode, lngth1, cnt: CARDINAL; TmpStr: NdxTypes.RecNameStr; TmpNdxRec: NdxTypes.NdxElement; BEGIN (* ExportToNdxFile *) lngth1 := GenLists.ListLength( RecNameList ); IF lngth1 = 0 THEN SearchingAll := TRUE; lngth1 := GenLists.ListLength( NdxF1^.Ndx ); ELSE SearchingAll := FALSE; END; ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '38' ); FOR cnt := 1 TO lngth1 DO IF SearchingAll THEN GenLists.GetElmt( NdxF1^.Ndx, cnt, TmpNdxRec, TypeCode ); StrEdit.AssignStr( TmpNdxRec.RecName, TmpStr ); ELSE GenLists.GetElmt( RecNameList, cnt, TmpStr, TypeCode ); (*Put the cnt'th record name in TmpStr.*) END; IF (M2Strings.Length( TmpStr ) > 0) AND (0 # M2Strings.CompareStr( TmpStr, BuildLst.ListStorageRec)) THEN (* don't export the special record of list names *) NdxUtils.CopyMatchingFields( NdxF1, NdxF2, TmpStr, MatchingFields ); END; END; END ExportToNdxFile; CONST FillThisField = 'Your selection requires completion of this field. Press any key.'; VAR fname, ListName, TmpStr1, TmpStr2, message: ARRAY [0..79] OF CHAR; MatchingFieldList, RecNameList: GenLists.GenList; DestNdxFile: NdxTypes.NdxFileType; done: BOOLEAN; SavedMessage: CARDINAL; TmpFieldRec: ScrnTypes.InputFieldRecord; ErrField, ExpFile, KeyHit: CARDINAL; PROCEDURE AllFieldsCorrect( TheFrame: ScrnTypes.DisplayFrame; ReqFieldName: ARRAY OF CHAR; VAR BadFieldNum: CARDINAL; VAR message, DestFileName: ARRAY OF CHAR; ListFieldName: ARRAY OF CHAR; VAR RecNameList: GenLists.GenList ): BOOLEAN; VAR ListName: ARRAY [0..79] OF CHAR; dumbool : BOOLEAN; BEGIN IF ScrnUtl1.FieldIsBlank( TheFrame, ReqFieldName, BadFieldNum ) THEN StrEdit.AssignStr( FillThisField, message ); done := FALSE; ELSE ControlUtils.ReadInput( TheFrame, DestFileName, ReqFieldName ); StrEdit.DeleteChar( ' ', DestFileName ); IF ScrnUtl1.FieldIsBlank( TheFrame, ListFieldName, BadFieldNum ) THEN StrEdit.AssignStr( FillThisField, message ); GenLists.NewList( RecNameList ); BadFieldNum := 0; done := TRUE; ELSE ControlUtils.ReadInput( TheFrame, ListName, ListFieldName); IF NOT BuildLst.GetRecNameList( NdxFile, ListName, RecNameList ) THEN done := FALSE; StrEdit.AssignStr( "List does not exist. Press any key.", message ); ELSE BadFieldNum := 0; done := TRUE; END; END; END; RETURN done; END AllFieldsCorrect; PROCEDURE ToNdxFile(); VAR TmpList1, TmpList2, TmpList3: GenLists.GenList; PROCEDURE PairFieldNames( list1, list2: GenLists.GenList; VAR outlist: GenLists.GenList); VAR lngth1, lngth2, cnt, TypeCode, strndx, spot: CARDINAL; TmpStr1, TmpStr2: ARRAY [0..79] OF CHAR; BEGIN lngth1 := GenLists.ListLength( list1 ); lngth2 := GenLists.ListLength( list2 ); GenLists.NewList( outlist ); FOR cnt := 1 TO lngth1 DO GenLists.GetElmt( list1, cnt, TmpStr1, TypeCode ); IF TypeCode = GenLists.StrCode THEN spot := GenLists.ScanList( TmpStr1, list2, 1, lngth2, strndx ); IF (spot > 0) AND (strndx = 0) THEN GenLists.GetElmt( list2, spot, TmpStr2, TypeCode ); StrEdit.Append( TmpStr1, '=' ); StrEdit.Append( TmpStr1, TmpStr2 ); GenLists.ListInsert( TmpStr1, GenLists.StrCode, outlist, GenLists.ListLength(outlist) + 1 ); END; END; END; END PairFieldNames; BEGIN (*ToNdxFile*) done := AllFieldsCorrect( TmpFrame, 'cpyfname', ErrField, message, fname, 'cpylist', RecNameList ); StrEdit.CrunchBlanks( fname); IF done THEN IF PosUtils.Equal( fname, NdxFile^.name) THEN done := FALSE; message := 'Cannot export from a file to itself'; ErrField := 8; ELSIF NOT NdxBones.OpenNdxFile( DestNdxFile, fname ) THEN ErrorOpeningFile( StringIO.MissingMessage, 'Not an Index File.', fname ); done := FALSE; ELSE DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame ); IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame, 'oldstruct' )) THEN HALT(); END; GenLists.CopyList( NdxFile^.StructLst, TmpList1 ); IF NOT ScrnUtl1.ListToEdField( TmpList1, TmpFrame, TmpFrame^.CurrentField ) THEN HALT(); END; IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame, 'newstruct' )) THEN HALT(); END; GenLists.CopyList( DestNdxFile^.StructLst, TmpList2 ); IF NOT ScrnUtl1.ListToEdField( TmpList2, TmpFrame, TmpFrame^.CurrentField ) THEN HALT(); END; IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame, 'matches' )) THEN HALT(); END; PairFieldNames( NdxFile^.StructLst, DestNdxFile^.StructLst, MatchingFieldList ); GenLists.CopyList( MatchingFieldList, TmpList3 ); IF NOT ScrnUtl1.ListToEdField( TmpList3, TmpFrame, TmpFrame^.CurrentField ) THEN HALT(); END; GenLists.DisposeList( MatchingFieldList ); (*We dispose here because the editor field now has a copy of the list.*) FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 ); InputManager.ControlFrame( TmpFrame, 0, '', FALSE, NextFrame ); (*Let them edit the lists.*) IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame, 'MATCHES')) THEN HALT(); END; IF NOT ScrnUtl1.ListFromEdField( TmpFrame, TmpFrame^.CurrentField, MatchingFieldList ) THEN HALT(); END; (*Now we've gotten the list back from the editor field, presumably changed in some way.*) GenLists.CopyList( MatchingFieldList, TmpList1 ); IF PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN ExportToNdxFile( NdxFile, RecNameList, TmpList1, DestNdxFile ); NextFrame := '24'; END; NdxFiles.CloseNdxFile( DestNdxFile ); END; END; END ToNdxFile; PROCEDURE ToAscii(); BEGIN IF AllFieldsCorrect( TmpFrame, 'expfname', ErrField, message, fname, 'explist', RecNameList ) THEN IF NotPmiFile( fname) THEN SavedMessage := HandleIO.CreateFile( ExpFile, fname ); IF SavedMessage = StringIO.NoError THEN ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '38' ); NdxUtils.ExportToFile( NdxFile, RecNameList, ExpFile ); StringIO.PrintMessage( HandleIO.CloseHandle( ExpFile ) ); NextFrame := '24'; done := TRUE; ELSE ErrorOpeningFile( SavedMessage, '', fname ); done := FALSE; END; ELSE ErrorOpeningFile( StringIO.MissingMessage, 'Invalid Reserved PMI File Name', fname ); done := FALSE; END; END; END ToAscii; PROCEDURE ToPrinter(); BEGIN done := AllFieldsCorrect( TmpFrame, 'prnlist', ErrField, message, fname, 'prnlist', RecNameList ); IF done THEN ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '38' ); NdxUtils.ExportToFile( NdxFile, RecNameList, StringIO.StdPrn ); NextFrame := '37'; END; END ToPrinter; BEGIN (*ExportRecords*) ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); NextFrame := '19'; (*This is the export form; the one with all the lines and blanks for list and file names.*) ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, NextFrame ); done := FALSE; ErrField := 0; StrEdit.AssignStr( '', message ); StrEdit.AssignStr( '', fname ); WHILE NOT done DO InputManager.ControlFrame( TmpFrame, ErrField, message, FALSE, NextFrame ); IF PosUtils.Equal( NextFrame, TmpFrame^.parent ) THEN RETURN; END; CASE ScrnUtl1.SelectedChar(TmpFrame) OF (*To determine what they want us to do, we have to figure out where the pointer bar was when the screen was submitted.*) 'A', 'l', 'f': (*Export records to an ASCII file.*) ToAscii(); | 'P', 'p': (*Print records.*) ToPrinter(); | 'N', 'c', 'x': (*Copy records to another Ndx file.*) ToNdxFile(); END; END; (*WHILE NOT done*) ScrnUtl2.CloseDisplayFrame( TmpFrame ); END ExportRecords; PROCEDURE GetFile( VAR NdxFile: NdxTypes.NdxFileType; ScreenFile: ScrnTypes.DisplayFile; VAR NextFrame: ScrnTypes.AFrameName): BOOLEAN; VAR SavedMessage : CARDINAL; SelectedFile, FileSpec: ARRAY [0..79] OF CHAR; FileOpened, dumbool: BOOLEAN; structure: ARRAY [0..511] OF CHAR; pathleng, KeyHit: CARDINAL; TmpFrame: ScrnTypes.DisplayFrame; PROCEDURE OpenExisting( fname: ARRAY OF CHAR ): BOOLEAN; BEGIN IF FileOpened THEN NdxFiles.CloseNdxFile( NdxFile ); END; IF NOT NdxBones.OpenNdxFile( NdxFile, fname ) THEN ErrorOpeningFile( StringIO.MissingMessage, 'Not an Index File.', fname ); RETURN FALSE; ELSE WindowPrims.MsgBox( VWindows.SE, 'New file selected. Press any key.', KbdInput.AnyKeyNum, KeyHit ); NextFrame := '2'; (*We do this to guarantee that we fall out at the bottom of the loop.*) RETURN TRUE; END; END OpenExisting; PROCEDURE TryCreate(); BEGIN (* TryCreate *) IF NotPmiFile( FileSpec ) THEN IF Drectory.ValidFile( FileSpec ) THEN WindowPrims.MsgBox( VWindows.SE, "File not found. Do you want to create it? (Y/N)", KbdInput.YorN, KeyHit ); IF KbdInput.CAPkey(KeyHit) = ORD('Y') THEN IF FileOpened THEN NdxFiles.CloseNdxFile( NdxFile ); END; (*For convenience we've stored the file structure in the DataList for frame 6.*) ListUtils.ListToString( TmpFrame^.DataList, structure ); NdxFiles.CreateNdxFile( NdxFile, FileSpec, structure ); WindowPrims.MsgBox( VWindows.SE, 'File created. Press any key.', KbdInput.AnyKeyNum, KeyHit ); FileOpened := TRUE; END; ELSE ErrorOpeningFile( StringIO.MissingMessage, 'Invalid File Name', FileSpec ); END; ELSE ErrorOpeningFile( StringIO.MissingMessage, 'Invalid Reserved PMI File Name', FileSpec ); END; END TryCreate; BEGIN (*GetFile*) FileOpened := FALSE; ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); REPEAT NextFrame := '6'; (*File Creation/Selection form; prompts for a file specification*) ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame ); IF NOT PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN (*return if they press the backup key*) ScrnUtl2.CloseDisplayFrame( TmpFrame ); RETURN FileOpened; END; ControlUtils.ReadInput( TmpFrame, FileSpec, 'path'); (*Get the string out of the field named 'path' and put it in the variable FileSpec.*) StrEdit.CutTrailingChars( ' ', FileSpec); pathleng := M2Strings.Length(FileSpec); IF HandleIO.FileExists( FileSpec ) THEN (* open file entered *) FileOpened := OpenExisting( FileSpec ); ELSIF (pathleng > 0) AND (NOT PosUtils.Present( '*', FileSpec)) AND (FileSpec[ pathleng-1] # '\') AND (FileSpec[ pathleng-1] # ':') THEN (* try to create file name entered *) TryCreate(); ELSE (* search for file spec entered *) ScrnUtl2.PushFrame( TmpFrame ); (*this saves frame 6*) NextFrame := '7'; (*7 is a blank window to hold the file names*) DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame ); DirManager.ControlDirectory( FileSpec, TmpFrame, 1, SelectedFile, NextFrame ); (*Loads frame 7 with a list of filenames that match the file specification in FileSpec, and controls scrolling of the pointer bar within the frame until the user selects a file. The 1 means ControlDirectory will list only file NAMES (i.e., will use only one column). We could have it list size, date, and time information by using 2, 3, or 4 for the number of columns. *) IF PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN StrEdit.DeleteChar( ' ', SelectedFile ); IF NOT PosUtils.Present( 'Error:', SelectedFile ) THEN FileOpened := OpenExisting( SelectedFile ); ScrnUtl2.PopFrame( TmpFrame ); (*TmpFrame is now frame 6.*) ELSE (* couldn't search for file, so try to create it *) ScrnUtl2.PopFrame( TmpFrame ); (*TmpFrame is now frame 6.*) TryCreate(); END; ELSE ScrnUtl2.PopFrame( TmpFrame ); (*TmpFrame is now frame 6.*) END; END; UNTIL FileOpened; ScrnUtl2.CloseDisplayFrame( TmpFrame ); RETURN FileOpened; END GetFile; PROCEDURE FileManagement( VAR NdxFile: NdxTypes.NdxFileType; VAR NextFrame: ScrnTypes.AFrameName; ScreenFile: ScrnTypes.DisplayFile); PROCEDURE CrunchMenu(); VAR TotSize, GbgSize: LONGINT; PctUsed, NumDatRecs, NumGbgRecs: CARDINAL; dumstr: ARRAY [0..80] OF CHAR; TmpFrame: ScrnTypes.DisplayFrame; BEGIN ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); REPEAT NextFrame := '10'; DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame ); NdxUtils.SizeInfo( NdxFile, TotSize, GbgSize, PctUsed, NumDatRecs, NumGbgRecs); StrConv.LongIntegerToStr( TotSize, 0, dumstr); ControlUtils.ChangeField( TmpFrame, dumstr, 'size', FALSE ); StrConv.LongIntegerToStr( GbgSize, 0, dumstr); ControlUtils.ChangeField( TmpFrame, dumstr, 'save', FALSE ); StrConv.CardinalToStr( PctUsed, 0, dumstr); ControlUtils.ChangeField( TmpFrame, dumstr, 'pct', FALSE ); StrConv.CardinalToStr( NumDatRecs, 0, dumstr); ControlUtils.ChangeField( TmpFrame, dumstr, 'custs', FALSE ); StrConv.CardinalToStr( NumGbgRecs, 0, dumstr); ControlUtils.ChangeField( TmpFrame, dumstr, 'grecs', FALSE ); FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 ); InputManager.ControlFrame( TmpFrame, 0, '', FALSE, NextFrame ); IF PosUtils.Equal( NextFrame, '12' ) THEN ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, NextFrame ); (*File crunch in progress*) NdxUtils.CrunchNdxFile( NdxFile); NextFrame := '13'; (*File crunch complete*) ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame ); END; UNTIL PosUtils.Equal( NextFrame, TmpFrame^.parent ); ScrnUtl2.CloseDisplayFrame( TmpFrame ); END CrunchMenu; PROCEDURE EditFile(); VAR fname: ARRAY [0..79] OF CHAR; ready: BOOLEAN; SavedMessage: CARDINAL; KeyHit: CARDINAL; TheList: GenLists.GenList; ControlRec: VEditor.AnEdControlRec; TmpFrame: ScrnTypes.DisplayFrame; BEGIN ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '18' ); (*This frame prompts for a file name.*) REPEAT InputManager.ControlFrame( TmpFrame, 0, '', FALSE, NextFrame ); IF NOT PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN ScrnUtl2.CloseDisplayFrame( TmpFrame ); RETURN; END; ControlUtils.ReadInput( TmpFrame, fname, 'fname' ); (*Get the file name out of the 'fname' field.*) IF NotPmiFile( fname) THEN GenLists.NewList( TheList ); SavedMessage := ListUtils.TextFileToList( fname, TheList ); IF SavedMessage = StringIO.NoError THEN ready := TRUE; ELSIF SavedMessage = StringIO.FileNotFound THEN WindowPrims.MsgBox( VWindows.SE, "File not found. Do you want to create it? (Y/N)", KbdInput.YorN, KeyHit ); ready := KbdInput.CAPkey(KeyHit) = ORD('Y'); IF ready THEN GenLists.NewList( TheList ); END; ELSE ErrorOpeningFile( SavedMessage, '', fname ); ready := FALSE; END; ELSE ErrorOpeningFile( StringIO.MissingMessage, 'Invalid Reserved PMI File Name', fname ); ready := FALSE; END; UNTIL ready; VEditor.InitEdRec( ControlRec ); VEditor.TheEditor( TheList, ControlRec ); IF ControlRec.ChangeMade THEN (*Ask if they want to save the file.*) WindowPrims.MsgBox( VWindows.SE, "Do you want to save your changes? (Y/N)", KbdInput.YorN, KeyHit ); ready := KbdInput.CAPkey(KeyHit) = ORD('Y'); IF ready THEN SavedMessage := ListUtils.TextListToFile( TheList, fname ); END; END; GenLists.DisposeList( TheList ); ScrnUtl2.CloseDisplayFrame( TmpFrame ); END EditFile; PROCEDURE GetRecDate( NdxFile: NdxTypes.NdxFileType; RecName: ARRAY OF CHAR; VAR Date: CARDINAL ); VAR TypeCode, day, month, year, hours, minutes, seconds: CARDINAL; DateStr: ARRAY [0..31] OF CHAR; BEGIN Drectory.GetFileDateAndTime( NdxFile^.handle, month, day, year, hours, minutes, seconds ); Date := ByteFiddler.DateToCardinal( month, day, year ); IF NOT NdxFiles.GetField( NdxFile, RecName, 'DATE', TypeCode, DateStr ) THEN RETURN; END; IF NOT DateFunctions.StrToDate2( DateStr, FALSE, day, month, year ) THEN RETURN; END; Date := ByteFiddler.DateToCardinal( month, day, year ); END GetRecDate; PROCEDURE FirstIsOlder( VAR date1, date2: CARDINAL ): BOOLEAN; BEGIN RETURN date1 < date2; END FirstIsOlder; PROCEDURE MergeFile(); VAR NextFrame: ScrnTypes.AFrameName; OtherRecName: NdxTypes.RecNameStr; OtherNdxFile: NdxTypes.NdxFileType; AddingRecords, AlwaysUpdate, NeverUpdate, Transferring, DoSomething: BOOLEAN; OurDate, TheirDate, cnt: CARDINAL; FileName: ARRAY [0..63] OF CHAR; TmpFrame: ScrnTypes.DisplayFrame; BEGIN ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); LOOP NextFrame := 'MergeOpts'; ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame ); IF PosUtils.Equal( NextFrame, TmpFrame^.parent ) THEN EXIT; END; ControlUtils.ReadInput( TmpFrame, FileName, 'fname' ); IF NOT NdxBones.OpenNdxFile( OtherNdxFile, FileName ) THEN EXIT; END; AddingRecords := ScrnUtl1.WhichChoiceKey( TmpFrame, ScrnUtl1.FieldNum(TmpFrame, 'add') ) = ORD('y'); Transferring := ScrnUtl1.WhichChoiceKey( TmpFrame, ScrnUtl1.FieldNum(TmpFrame, 'transf') ) = ORD('y'); CASE CHR(ScrnUtl1.WhichChoiceKey( TmpFrame, ScrnUtl1.FieldNum(TmpFrame, 'upd') )) OF 'A': AlwaysUpdate := TRUE; NeverUpdate := FALSE; | 'O': AlwaysUpdate := FALSE; NeverUpdate := FALSE; | 'N': AlwaysUpdate := FALSE; NeverUpdate := TRUE; END; cnt := 1; WHILE NdxUtils.GetRecName( OtherNdxFile, cnt, OtherRecName ) DO IF NdxFiles.RecordExists( NdxFile, OtherRecName ) THEN IF AlwaysUpdate THEN DoSomething := TRUE; ELSIF NeverUpdate THEN DoSomething := FALSE; ELSE GetRecDate( NdxFile, OtherRecName, OurDate ); GetRecDate( OtherNdxFile, OtherRecName, TheirDate ); IF FirstIsOlder( OurDate, TheirDate ) THEN DoSomething := TRUE; ELSE DoSomething := FALSE; END; END; ELSE DoSomething := AddingRecords; END; IF DoSomething THEN IF Transferring THEN IF NOT NdxUtils.TransferRecord( OtherRecName, OtherNdxFile, NdxFile ) THEN ErrorManager.WARN( OtherRecName ); END; ELSE IF NOT NdxUtils.CopyRecord( OtherRecName, OtherNdxFile, NdxFile ) THEN ErrorManager.WARN( OtherRecName ); END; END; END; INC( cnt ); END; NdxFiles.CloseNdxFile( OtherNdxFile ); END; ScrnUtl2.CloseDisplayFrame( TmpFrame ); END MergeFile; VAR NdxFile2 : NdxTypes.NdxFileType; TmpFrame: ScrnTypes.DisplayFrame; BEGIN (* FileManagement *) ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow ); LOOP NextFrame := '9'; ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame ); IF PosUtils.Equal( NextFrame, TmpFrame^.parent ) THEN EXIT; END; CASE ScrnUtl1.SelectedChar(TmpFrame) OF 'C': (*Create or select a new file.*) IF GetFile( NdxFile2, ScreenFile, NextFrame) THEN NdxFiles.CloseNdxFile( NdxFile ); NdxFile := NdxFile2; END; (*TmpFrame will be 6 at this point; NextFrame will be 9.*) |'s': (*Manage space usage in this file.*) CrunchMenu(); |'M': (*Merge another file*) MergeFile(); |'E': (*Edit a file.*) EditFile(); ELSE END; END; ScrnUtl2.CloseDisplayFrame( TmpFrame ); END FileManagement; PROCEDURE RestoreDisplay(); BEGIN SmartScreen.SetAttribOrColor( SmartScreen.lightgrey, SmartScreen.black, SmartScreen.plain ); SmartScreen.ClearPart( 1, 1, SmartScreen.MaxCol, SmartScreen.MaxRow ); SmartScreen.SetCursorHeight( SavedCursorHeight ); END RestoreDisplay; PROCEDURE CloseFiles(); BEGIN DspFiles.CloseDisplayFile(ScreenFile); NdxFiles.CloseNdxFile( NdxFile ); END CloseFiles; VAR NextFrame: ScrnTypes.AFrameName; BEGIN (*Main*) SavedCursorHeight := WindowPrims.GetCursorHeight(); SmartScreen.SetCursorHeight( 0 ); ErrorManager.AddTermProc( RestoreDisplay ); IF NOT DspFiles.OpenDisplayFile( ScreenFile, "pmidbms.dsp") THEN ErrorManager.WARN( "Could not find PMIDBMS.DSP" ); HALT; END; StrEdit.AssignStr( 'pmidbms.ndx', NdxFileName); GenLists.DiagMode := FALSE; IF NOT (NdxBones.OpenNdxFile( NdxFile, NdxFileName) OR GetFile( NdxFile, ScreenFile, NextFrame)) THEN ControlUtils.InputConst( DspFiles.MainFrame, '8' ); (* Tell them we can't proceed without an Ndx file *) DspFiles.CloseDisplayFile( ScreenFile); RETURN; END; ScrnTypes.InitDisplayFrame( EntryFrame, VWindows.CurrentWindow ); ErrorManager.AddTermProc( CloseFiles ); LOOP NextFrame := '2'; ControlUtils.Input( DspFiles.MainFrame, NextFrame ); (*the top menu*) IF PosUtils.Equal( NextFrame, ScrnTypes.ProgramExit ) THEN EXIT; END; CASE ScrnUtl1.SelectedChar( DspFiles.MainFrame ) OF 'P': (*Process a record*) ProcessRecord(); | 'U': (*Search*) ManageLists(); | 'E': (*Export*) ExportRecords( NdxFile, NextFrame, ScreenFile); | 'M': (*File Info & Management*) FileManagement( NdxFile, NextFrame, ScreenFile); ELSE END; END; END PMIdbms.