IMPLEMENTATION MODULE NdxUtils; (* * REPERTOIRE * Release 1.6 * By Charles Bradford and Cole Brecheen * (c) Copyright 1985-1992 PMI * Green Bay, Wisconsin * All rights reserved * (414) 468-6040 * * $Header: D:/logfiles/mods/ndxutils.mov 1.7 10 Mar 1991 15:30:56 coleb $ * *) (*EntryDiag: IMPORT Diagnostics; :EntryDiag*) (* IMPORT BuildLst; *) IMPORT EnvironUtils; IMPORT ErrorManager; IMPORT ErrorNames; IMPORT HandleIO; IMPORT GenLists; IMPORT ListUtils; IMPORT LowLevel; IMPORT M2Strings; IMPORT NdxBones; IMPORT NdxFiles; FROM NdxTypes IMPORT NdxElement; IMPORT NdxTypes; IMPORT Numbers; IMPORT NumTypes; IMPORT PosUtils; IMPORT StrConv; IMPORT StrEdit; IMPORT StringIO; IMPORT SYSTEM; IMPORT VStorage; VAR Initialized : BOOLEAN; PROCEDURE CopyMatchingFields( NdxF1: NdxTypes.NdxFileType; VAR NdxF2: NdxTypes.NdxFileType; RecName: ARRAY OF CHAR; MatchingFields: GenLists.GenList ); VAR spot, TypeCode: CARDINAL; FieldName1, FieldName2: ARRAY [0..79] OF CHAR; BufElement: ARRAY [0..1023] OF CHAR; TmpList1, TmpList2: GenLists.GenList; PROCEDURE GetPair( index: CARDINAL; TheList: GenLists.GenList; VAR s1, s2: ARRAY OF CHAR ); VAR eqspot, TypeCode: CARDINAL; BEGIN GenLists.GetElmt( TheList, index, s1, TypeCode ); eqspot := PosUtils.Pos( '=', s1 ); IF eqspot < HIGH(s1) THEN M2Strings.Copy( s1, eqspot + 1, (M2Strings.Length(s1) - eqspot) - 1, s2 ); M2Strings.Delete( s1, eqspot, M2Strings.Length(s1) - eqspot ); ELSE StrEdit.SetLength( s1, 0 ); StrEdit.SetLength( s2, 0 ); END; END GetPair; BEGIN (* CopyMatchingFields *) spot := 1; GetPair( spot, MatchingFields, FieldName1, FieldName2 ); WHILE spot <= GenLists.ListLength( MatchingFields ) DO IF (M2Strings.Length(FieldName1) > 0) AND (M2Strings.Length(FieldName2) > 0) THEN IF NdxFiles.GetField( NdxF1, RecName, FieldName1, TypeCode, BufElement ) THEN IF TypeCode # GenLists.ListCode THEN IF NOT NdxFiles.PutField( NdxF2, RecName, FieldName2, TypeCode, BufElement ) THEN (* You could do something here to account for fields that do not exist in the destination structure *) END; ELSE (* copy lists before insertion *) IF NdxFiles.GetField( NdxF1, RecName, FieldName1, TypeCode, TmpList1 ) THEN GenLists.CopyList( TmpList1, TmpList2 ); IF NOT NdxFiles.PutField( NdxF2, RecName, FieldName2, TypeCode, TmpList2 ) THEN (* You could do something here to account for fields that do not exist in the destination structure *) END; END; END; END; END; INC( spot ); IF spot <= GenLists.ListLength(MatchingFields) THEN GetPair( spot, MatchingFields, FieldName1, FieldName2 ); END; END; IF NOT NdxFiles.WriteRecord( NdxF2, RecName ) THEN (* You could do something here to account for records that could not be read from source file, so none of the GetFields above succeeded *) END; END CopyMatchingFields; PROCEDURE CopyRecord( RecName: ARRAY OF CHAR; SourceFile, DestFile: NdxTypes.NdxFileType ): BOOLEAN; VAR TypeCode: CARDINAL; TmpList1, TmpList2: GenLists.GenList; BEGIN IF NdxFiles.GetField( SourceFile, RecName, 'RECORD', TypeCode, TmpList1 ) THEN IF TypeCode = GenLists.ListCode THEN GenLists.CopyList( TmpList1, TmpList2 ); IF NdxFiles.PutField( DestFile, RecName, 'RECORD', TypeCode, TmpList2 ) THEN IF NdxFiles.WriteRecord( DestFile, RecName ) THEN RETURN TRUE; END; END; END; END; RETURN FALSE; END CopyRecord; PROCEDURE TransferRecord( RecName: ARRAY OF CHAR; SourceFile, DestFile: NdxTypes.NdxFileType ): BOOLEAN; VAR TypeCode: CARDINAL; TmpList1, TmpList2: GenLists.GenList; BEGIN IF NdxFiles.GetField( SourceFile, RecName, 'RECORD', TypeCode, TmpList1 ) THEN IF TypeCode = GenLists.ListCode THEN GenLists.CopyList( TmpList1, TmpList2 ); IF NdxFiles.PutField( DestFile, RecName, 'RECORD', TypeCode, TmpList2 ) THEN IF NdxFiles.WriteRecord( DestFile, RecName ) THEN IF NdxFiles.DeleteRecord( SourceFile, RecName ) THEN RETURN TRUE; END; END; END; END; END; RETURN FALSE; END TransferRecord; PROCEDURE ExportToFile( NdxFile: NdxTypes.NdxFileType; RecNameList: GenLists.GenList; fhandle: CARDINAL ); (* exports records to a plain ascii file *) VAR lngth, cnt, TypeCode: CARDINAL; TmpStr: NdxTypes.RecNameStr; TmpList: GenLists.GenList; SearchingAll: BOOLEAN; TmpNdxRec: NdxTypes.NdxElement; BEGIN lngth := GenLists.ListLength( RecNameList ); IF lngth = 0 THEN SearchingAll := TRUE; lngth := GenLists.ListLength( NdxFile^.Ndx ); ELSE SearchingAll := FALSE; END; FOR cnt := 1 TO lngth DO IF SearchingAll THEN GenLists.GetElmt( NdxFile^.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*) 'qQqQqQqQ' )) THEN (*Next, get the entire record.*) IF NOT NdxFiles.GetField( NdxFile, TmpStr, 'RECORD', TypeCode, TmpList ) THEN StringIO.WriteStr( fhandle, TmpStr ); StringIO.WriteEol( fhandle, ' is not a record in this file.' ); END; (*We are assuming TypeCode will always = ListCode here.*) ListUtils.PrintList( fhandle, TmpList, 0, ',' ); END; END; END ExportToFile; PROCEDURE SizeInfo( VAR NdxFile: NdxTypes.NdxFileType; VAR TotlSize, GbgSize: LONGINT; VAR PctUsed, NumDataRecs, NumGbgRecs: CARDINAL); VAR CardTotalRecs: CARDINAL; long2, long1, NdxElemSize, LongTotalRecs : LONGINT; (*We use these temporary variables to avoid bugs in Logitech's v3.03 compiler.*) BEGIN GarbageSize( NdxFile^.Ndx, GbgSize, NumDataRecs, NumGbgRecs); (* returns total size of garbage data and number of records *) CardTotalRecs := NumDataRecs + NumGbgRecs; NdxElemSize := Numbers.Lc( SYSTEM.TSIZE(NdxElement)); LongTotalRecs := Numbers.Lc( CardTotalRecs); long1 := (NdxElemSize * LongTotalRecs); TotlSize := NdxFile^.NdxFilePtr + long1; INC( TotlSize, 6 ); long2 := Numbers.Lc( NumGbgRecs); long1 := (NdxElemSize * long2); GbgSize := GbgSize + long1; (* add size of garbage index entries to garbage size of data *) long1 := GbgSize * Numbers.Lc( 100); long2 := long1 DIV TotlSize; PctUsed := 100 - Numbers.C( long2); END SizeInfo; PROCEDURE GetRecName( NdxFile: NdxTypes.NdxFileType; Which: CARDINAL; VAR RecName: ARRAY OF CHAR ): BOOLEAN; (* returns name of Which'th ndx element, or FALSE if not found *) VAR NdxEl : NdxTypes.NdxElement; TheType: CARDINAL; BEGIN NdxTypes.CheckInit( NdxFile); IF GenLists.ListLength( NdxFile^.Ndx) < Which THEN RETURN FALSE; END; GenLists.GetElmt( NdxFile^.Ndx, Which, NdxEl, TheType); StrEdit.AssignStr( NdxEl.RecName, RecName); RETURN M2Strings.Length(RecName) # 0; (* Return FALSE if index entry is marked as garbage *) END GetRecName; PROCEDURE GetRecNames( NdxFile: NdxTypes.NdxFileType; VAR NameList: GenLists.GenList ); VAR TmpElmt: NdxTypes.NdxElement; lngth, cnt, TypeCode : CARDINAL; BEGIN GenLists.NewList( NameList ); lngth := GenLists.ListLength( NdxFile^.Ndx ); FOR cnt := 1 TO lngth DO GenLists.GetElmt( NdxFile^.Ndx, cnt, TmpElmt, TypeCode ); StrEdit.CrunchBlanks( TmpElmt.RecName ); IF (NOT PosUtils.Equal(TmpElmt.RecName, 'qQqQqQqQ' (*BuildLst.ListStorageRec*)) ) AND (M2Strings.Length( TmpElmt.RecName ) > 0) THEN GenLists.ListInsert( TmpElmt.RecName, GenLists.StrCode, NameList, 65535 ); END; END; END GetRecNames; PROCEDURE GarbageSize( VAR TheNdx: GenLists.GenList; VAR GbgSize: LONGINT; VAR NumDataRecs, NumGbgRecs: CARDINAL); VAR cnt, dum: CARDINAL; TheElmt: NdxTypes.NdxElement; long1: LONGINT; BEGIN GbgSize := NumTypes.L0; NumGbgRecs := 0; NumDataRecs := GenLists.ListLength( TheNdx); FOR cnt := 1 TO NumDataRecs DO GenLists.GetElmt( TheNdx, cnt, TheElmt, dum); IF TheElmt.UsedChars < TheElmt.Allocated THEN (* for every record with any gargbage in it *) dum := TheElmt.Allocated - TheElmt.UsedChars; (*We do this in steps because of bugs in Logitech's v3.03 LONGINTs.*) long1 := Numbers.Lc(dum); GbgSize := GbgSize + long1; IF TheElmt.UsedChars = 0 THEN INC( NumGbgRecs); END; END; END; DEC( NumDataRecs, NumGbgRecs); END GarbageSize; PROCEDURE ByFilePos(adr1: SYSTEM.ADDRESS; size1: CARDINAL; adr2: SYSTEM.ADDRESS; size2: CARDINAL): INTEGER; (*We pass this procedure to the procedure variable parameter of SortList to make it sort the Ndx according to position of the record in the file. Used only in CrunchNdxFile, but we can't make it local to that procedure because of an implementation restriction in Logitech's handling of procedure variables.*) VAR tmpsize: CARDINAL; tmp1, tmp2: NdxTypes.NdxElement; BEGIN tmpsize := SYSTEM.TSIZE( NdxElement ); LowLevel.Move( adr1, SYSTEM.ADR(tmp1), tmpsize ); LowLevel.Move( adr2, SYSTEM.ADR(tmp2), tmpsize ); IF tmp1.FilePos > tmp2.FilePos THEN RETURN 1; ELSIF tmp1.FilePos < tmp2.FilePos THEN RETURN -1; ELSE RETURN 0; END; END ByFilePos; PROCEDURE ByFileName( adr1: SYSTEM.ADDRESS; size1: CARDINAL; adr2: SYSTEM.ADDRESS; size2: CARDINAL ): INTEGER; (*We pass this procedure to the procedure variable parameter of SortList to make it restore the Ndx to reverse alphabetical order.*) VAR tmpsize: CARDINAL; tmp1, tmp2: NdxTypes.NdxElement; BEGIN tmpsize := SYSTEM.TSIZE(NdxElement); LowLevel.Move( adr1, SYSTEM.ADR(tmp1), tmpsize ); LowLevel.Move( adr2, SYSTEM.ADR(tmp2), tmpsize ); RETURN - M2Strings.CompareStr( tmp1.RecName, tmp2.RecName ); END ByFileName; PROCEDURE CrunchNdxFile( VAR NdxFile: NdxTypes.NdxFileType ); (*Copies the file over itself.*) PROCEDURE MoveFileData( TheHandle: CARDINAL; FromSpot, ToSpot: LONGINT; HowMuch: CARDINAL); VAR BytesCopied, BufSize, ChunkSize : CARDINAL; bufadr: SYSTEM.ADDRESS; SavedMessage: CARDINAL; TmpL : LONGINT; BEGIN BytesCopied := 0; IF VStorage.DosAvail( HowMuch ) THEN BufSize := HowMuch; ELSE BufSize := EnvironUtils.MemAvail( 1000 ); (*Guesses the amount of memory available to within 1000 bytes.*) END; VStorage.DosAlloc( bufadr, BufSize ); REPEAT IF (HowMuch - BytesCopied) > BufSize THEN ChunkSize := BufSize; ELSE ChunkSize := HowMuch - BytesCopied; END; TmpL := FromSpot + Numbers.Lc( BytesCopied); (*Necessary because of bugs in Logitech's LONGINT arithmetic that have persisted into v3.03.*) HandleIO.SetFilePtr( TheHandle, HandleIO.FromStart, TmpL ); SavedMessage := HandleIO.BlockRead( TheHandle, bufadr, ChunkSize ); CASE SavedMessage OF StringIO.NoError, StringIO.PartialRead, StringIO.EndOfFile: (*Do nothing.*); ELSE StringIO.PrintMessage( SavedMessage ); (*Explains the error and aborts the program.*) END; TmpL := ToSpot + Numbers.Lc(BytesCopied); HandleIO.SetFilePtr( TheHandle, HandleIO.FromStart, TmpL ); SavedMessage := HandleIO.BlockWrite( TheHandle, bufadr, ChunkSize ); CASE SavedMessage OF StringIO.NoError, StringIO.PartialRead, StringIO.EndOfFile: (*Do nothing.*); ELSE StringIO.PrintMessage( SavedMessage ); (*Explains the error and aborts the program.*) END; INC( BytesCopied, ChunkSize ); UNTIL BytesCopied = HowMuch; VStorage.DosDealloc( bufadr, BufSize ); END MoveFileData; VAR WritingSpot: LONGINT; RecordCnt, TypeCode : CARDINAL; TmpElmt: NdxTypes.NdxElement; ListReplaceNeeded : BOOLEAN; BEGIN (*CrunchNdxFile*) NdxTypes.CheckInit( NdxFile ); IF GenLists.ListLength( NdxFile^.Ndx ) = 0 THEN (*empty file*) RETURN; END; HandleIO.UpdateDisk( NdxFile^.handle ); GenLists.SortList( NdxFile^.Ndx, ByFilePos ); RecordCnt := 1; GenLists.GetElmt(NdxFile^.Ndx, RecordCnt, TmpElmt, TypeCode); WritingSpot := TmpElmt.FilePos; (*Skip the structure record.*) ListReplaceNeeded := FALSE; WHILE RecordCnt <= GenLists.ListLength(NdxFile^.Ndx) DO (* We look at every element in the Ndx. *) GenLists.GetElmt(NdxFile^.Ndx, RecordCnt, TmpElmt, TypeCode); IF (M2Strings.Length(TmpElmt.RecName) > 0) THEN IF TmpElmt.FilePos > WritingSpot THEN (* If the record starts farther into the file than we think it's supposed to start. *) MoveFileData( NdxFile^.handle, TmpElmt.FilePos, WritingSpot, TmpElmt.UsedChars ); (* In NdxFile^.handle, move TmpElmt.UsedChars from TmpElmt.FilePos to WritingSpot. *) TmpElmt.FilePos := WritingSpot; NdxFile^.UpdateNeeded := TRUE; ListReplaceNeeded := TRUE; ELSIF TmpElmt.Allocated > TmpElmt.UsedChars THEN (* We know that the amount of space allocated to this record is going to be reduced in the next loop, so we go ahead and update its entry in the Ndx. *) ListReplaceNeeded := TRUE; END; IF ListReplaceNeeded THEN TmpElmt.Allocated := TmpElmt.UsedChars; GenLists.ListReplace(TmpElmt, TypeCode, NdxFile^.Ndx, RecordCnt); ListReplaceNeeded := FALSE; END; WritingSpot := WritingSpot + Numbers.Lc( TmpElmt.UsedChars ); (* Since we increment WritingSpot by TmpElmt.UsedChars instead of by TmpElmt.Allocated, when we look at the next record, its FilePos will be greater than WritingSpot, so we will crunch out small bits of garbage at the ends of records. *) INC( RecordCnt ); ELSE (* The length of the RecName is 0, so we know it's a garbage record.*) GenLists.ListDelete( NdxFile^.Ndx, RecordCnt, 1 ); NdxFile^.UpdateNeeded := TRUE; END; END; (*WHILE*) NdxFile^.NdxFilePtr := WritingSpot; (*Sets the position of the NdxMarker.*) IF GenLists.ListLength( NdxFile^.Ndx ) > 0 THEN GenLists.SortList( NdxFile^.Ndx, ByFileName ); (*Put the Ndx list back into reverse alphabetical order.*) END; IF NdxFile^.UpdateNeeded THEN NdxFiles.WriteNdx( NdxFile ); END; END CrunchNdxFile; PROCEDURE RebuildNdx( VAR NdxFile: NdxTypes.NdxFileType ); (*Scans a file for record separators and builds a new linked list of record names, record sizes, and file offsets, then writes the list to the file, beginning at the last byte of the last record in the file. Used to repair damaged NdxFiles. *) CONST DuplicateNameMessage = 'Duplicate RecName found. Will try to make it unique'; IrreparableMsg = 'NdxFile may be irreparably damaged'; VAR RecFound, FileEndReached, NdxMarkFound, Garbage, FirstChar: BOOLEAN; bufch: CHAR; L4, ThisEndSpot, FileSize, BytesToRead, LastSpot, FileSpot: LONGINT; NdxElemSize, NestingLevel, cnt, BufSize, BufSpot, ZeroRecSize, ChunkSize, memory: CARDINAL; buf: LowLevel.Address8086; OldNdxElmt, NewNdxElmt: NdxTypes.NdxElement; TmpRecName: NdxTypes.RecNameStr; TmpStr: ARRAY [0..127] OF CHAR; PROCEDURE MakeUniqueName( InStr: ARRAY OF CHAR; VAR OutStr: ARRAY OF CHAR); VAR dumc: CARDINAL; TimeStr: ARRAY [0..30] OF CHAR; BEGIN StrEdit.AssignStr( InStr, OutStr ); EnvironUtils.GetTime(dumc,dumc,dumc,dumc, TimeStr); StrEdit.DeleteChar( ':', TimeStr ); StrEdit.DeleteChar( ' ', TimeStr ); IF M2Strings.Length(OutStr) < (HIGH(OutStr) - 1) THEN M2Strings.Delete( TimeStr, 1, M2Strings.Length(TimeStr) - 2 ); StrEdit.Append( OutStr, TimeStr ); ELSE StrEdit.AssignStr( TimeStr, OutStr ); END; END MakeUniqueName; PROCEDURE NextChar(): CHAR; VAR tmpch: CHAR; SavedMessage: CARDINAL; BEGIN IF FirstChar THEN (*We only want to allocate our buffer on the first call.*) FirstChar := FALSE; FileSpot := NumTypes.L0; (*FileSpot tracks our position in the file.*) BytesToRead := FileSize; IF BytesToRead > Numbers.Lc( 65000) THEN (*We make it a little less than 64K because the Storage module can't really allocate a full 64K block.*) BufSize := 65000; ELSE BufSize := Numbers.C( BytesToRead ); END; memory := EnvironUtils.MemAvail( 5000 ); (*Guess the amount of memory available, to within 5000 bytes.*) IF memory < BufSize THEN BufSize := memory; END; VStorage.DosAlloc( buf.a, BufSize ); BufSpot := BufSize; (*We do this so that we'll begin by doing a BlockRead, just as we would if we'd reached the end of a buffer.*) ChunkSize := BufSize; END; IF BytesToRead = NumTypes.L0 THEN FileEndReached := TRUE; RETURN 0C; END; IF (BufSpot >= ChunkSize) THEN IF BytesToRead < Numbers.Lc( BufSize) THEN (*If we have fewer bytes to read than will fit in the buffer.*) ChunkSize := Numbers.C( BytesToRead ); END; HandleIO.SetFilePtr( NdxFile^.handle, HandleIO.FromStart, FileSpot ); SavedMessage := HandleIO.BlockRead( NdxFile^.handle, buf.a, ChunkSize ); (*This is where we actually load the buffer.*) IF (SavedMessage # StringIO.NoError) AND (SavedMessage # StringIO.PartialRead) AND (SavedMessage # StringIO.EndOfFile) THEN StringIO.PrintMessage( SavedMessage ); END; BufSpot := 0; END; tmpch := LowLevel.PeekByte( buf.seg, buf.off + BufSpot ); INC( BufSpot ); INC( FileSpot ); DEC( BytesToRead ); IF BytesToRead = NumTypes.L0 THEN FileEndReached := TRUE; END; RETURN tmpch; END NextChar; PROCEDURE NextCard(): CARDINAL; VAR conv : RECORD (*Used in swap and BytesToWord.*) CASE : BOOLEAN OF TRUE : x : CARDINAL; | FALSE : a, b : CHAR; END; END; BEGIN conv.a := NextChar(); conv.b := NextChar(); RETURN conv.x; END NextCard; PROCEDURE NdxEntryInsert( TmpElmt: NdxTypes.NdxElement; VAR NdxFile: NdxTypes.NdxFileType ): BOOLEAN; VAR dummylong: LONGINT; TheElmt, dummycard: CARDINAL; BEGIN IF NOT NdxBones.FindRecord( NdxFile, TmpElmt.RecName, dummylong, dummycard, TheElmt) THEN (*The FindRecord returns the alphabetically correct insertion point, TheElmt.*) GenLists.ListInsert( TmpElmt, NdxTypes.NdxTypeCode, NdxFile^.Ndx, TheElmt); RETURN TRUE; ELSE RETURN FALSE; END; END NdxEntryInsert; PROCEDURE SetName( RecName: ARRAY OF CHAR; VAR OldNdxElmt: NdxTypes.NdxElement ); BEGIN IF OldNdxElmt.FilePos = NumTypes.L0 THEN (* This makes sure that we don't try to set the name of the last record while we're processing the first record in the file.*) RETURN; END; StrEdit.AssignStr( RecName, OldNdxElmt.RecName ); IF M2Strings.Length( RecName ) > 0 THEN WHILE NOT NdxEntryInsert(OldNdxElmt, NdxFile ) DO StrEdit.AssignStr( DuplicateNameMessage, TmpStr ); M2Strings.Insert( ': ', TmpStr, 0 ); M2Strings.Insert( RecName, TmpStr, 0 ); ErrorManager.WARN( TmpStr ); MakeUniqueName(OldNdxElmt.RecName, OldNdxElmt.RecName); StrEdit.AssignStr( OldNdxElmt.RecName, TmpStr ); M2Strings.Insert( 'Trying "', TmpStr, 0 ); StrEdit.Append( TmpStr, '". Please note new name' ); ErrorManager.WARN( TmpStr ); END; ELSE GenLists.ListInsert(OldNdxElmt, NdxTypes.NdxTypeCode, NdxFile^.Ndx, 65535); (*appends OldNdxElmt to end of Ndx*) END; END SetName; PROCEDURE SkipToNext(); (* When something goes wrong in a record, we call this to try to skip ahead to the next thing that looks like the start of a record. It's not foolproof, but it ought to work most of the time.*) BEGIN StringIO.WriteEol( StringIO.outp, 'Skipping over this data:' ); LOOP bufch := NextChar(); StringIO.WriteStr( StringIO.outp, bufch ); IF (bufch = NdxBones.CodeChar) THEN bufch := NextChar(); IF bufch = NdxBones.NdxMarker[1] THEN NdxMarkFound := TRUE; EXIT; END; IF (bufch = NdxBones.StartSep[1]) AND (NextCard() = GenLists.ListCode) AND (NextChar() = NdxBones.CodeChar) AND (NextChar() = NdxBones.StartSep[1]) AND (NextCard() = GenLists.StrCode) THEN bufch := NextChar(); IF (bufch = 'O') OR (bufch = 'G') THEN NestingLevel := 2; RecFound := TRUE; EXIT; END; END; END; END; END SkipToNext; PROCEDURE TruncateChosen(): BOOLEAN; VAR tmp: ARRAY [0..15] OF CHAR; BEGIN StringIO.WriteEol( StringIO.outp, '' ); StringIO.WriteStr( StringIO.outp, 'Do you want to truncate the file here? ' ); StringIO.ReadStr( StringIO.inp, tmp ); IF CAP(tmp[0]) = 'Y' THEN NdxMarkFound := TRUE; RETURN TRUE; ELSE RETURN FALSE; END; END TruncateChosen; PROCEDURE MarkBad( VAR RecName: ARRAY OF CHAR ); VAR TmpStr: ARRAY [0..79] OF CHAR; BEGIN StrConv.LongIntegerToStr( FileSpot, 0, TmpStr ); StrEdit.Append( TmpStr, '= file offset. This record has been corrupted: "' ); StrEdit.Append( TmpStr, RecName ); StrEdit.Append( TmpStr, '"' ); ErrorManager.WARN( TmpStr ); StrEdit.SetLength( RecName, 0 ); END MarkBad; BEGIN (*RebuildNdx*) NdxElemSize := SYSTEM.TSIZE(NdxElement); (*This gets us around a bug in the beta copy of v3.0.*) GenLists.NewList( NdxFile^.Ndx ); (*Initialize the list in preparation for rebuilding it; we assume it hasn't yet been initialized.*) FileSize := HandleIO.FileLength( NdxFile^.handle ); HandleIO.SetFilePtr( NdxFile^.handle, HandleIO.FromStart, NumTypes.L0 ); LowLevel.Fill( SYSTEM.ADR(OldNdxElmt), NdxElemSize, 0C ); LowLevel.Fill( SYSTEM.ADR(NewNdxElmt), NdxElemSize, 0C ); StrEdit.SetLength( TmpRecName, 0 ); NdxMarkFound := FALSE; FileEndReached := FALSE; FirstChar := TRUE; ZeroRecSize := NextCard(); (*BufSpot should now be 2, because the byte at offset 2--the 3rd byte--is the next one to be read.*) IF (FileSize < NumTypes.L65535) AND (ZeroRecSize > Numbers.C( FileSize)) THEN ErrorManager.WARN( IrreparableMsg ); END; FOR cnt := 1 TO ZeroRecSize DO (*Skip the zero record because it just contains the structure.*) bufch := NextChar(); END; NestingLevel := 1; RecFound := FALSE; LastSpot := NumTypes.L0; ThisEndSpot := NumTypes.L0; WHILE (NOT FileEndReached) AND (NOT NdxMarkFound) DO (*Find the next CodeChar.*) bufch := NextChar(); IF bufch = NdxBones.CodeChar THEN bufch := NextChar(); (*find out what kind of separator this is*) IF bufch = NdxBones.StartSep[1] THEN INC( NestingLevel ); bufch := NextChar(); bufch := NextChar(); (*Skip over the type code.*) IF NestingLevel = 2 THEN RecFound := TRUE; END; ELSIF bufch = NdxBones.EndSep[1] THEN DEC( NestingLevel ); IF NestingLevel = 1 THEN ThisEndSpot := FileSpot; ELSIF NestingLevel = 0 THEN (*If NestingLevel gets back to 0 before we find the NdxMarker, we're done for.*) ErrorManager.WARN( IrreparableMsg ); MarkBad( TmpRecName ); IF NOT TruncateChosen() THEN SkipToNext(); END; ThisEndSpot := FileSpot; END; ELSIF bufch = NdxBones.NdxMarker[1] THEN ThisEndSpot := FileSpot; NdxMarkFound := TRUE; ELSIF bufch = NdxBones.CodedStr[1] THEN (* This means there was a CodeChar embedded in the user's data. We just skip it. It will be decoded when it's read.*) ELSE StrConv.LongIntegerToStr( FileSpot, 0, TmpStr ); M2Strings.Insert( '" ": illegal character at ', TmpStr, 0 ); TmpStr[1] := bufch; ErrorManager.WARN( TmpStr ); MarkBad( TmpRecName ); IF NOT TruncateChosen() THEN SkipToNext(); END; END; END; IF (NOT NdxMarkFound) AND RecFound THEN RecFound := FALSE; (*We've just read the next record StartSep.*) LowLevel.Fill( SYSTEM.ADR(OldNdxElmt), NdxElemSize, 0C ); OldNdxElmt.FilePos := LastSpot; (* position saved when last start sep was found *) OldNdxElmt.Allocated := Numbers.C( FileSpot - LastSpot); DEC( OldNdxElmt.Allocated, 4 ); (* position when this rec startsep found minus position saved when last rec start sep was found *) IF M2Strings.Length(TmpRecName) > 0 THEN OldNdxElmt.UsedChars := Numbers.C( ThisEndSpot - LastSpot ); (*position when this rec endsep found minus position saved when last rec start sep was found *) ELSE OldNdxElmt.UsedChars := 0; END; L4 := Numbers.Lc( 4); (*We do this to avoid a bug in Logitech's v3.0 LONGINTs.*) LastSpot := FileSpot - L4; SetName( TmpRecName, OldNdxElmt ); bufch := NextChar(); bufch := NextChar(); (*Skip over the StartSep that starts the record name.*) bufch := NextChar(); bufch := NextChar(); (*Skip over the record name type code.*) StrEdit.SetLength(TmpRecName, 0); bufch := NextChar(); Garbage := bufch = 'G'; LOOP (*This is where we get the record name, we keep it in TmpRecName until we get to the start of the next record or to the NdxMarker. SetName then assigns TmpRecName to the RecName field of OldNdxElmt, taking care of any duplication of names.*) bufch := NextChar(); IF FileEndReached THEN EXIT; END; IF bufch = NdxBones.CodeChar THEN bufch := NextChar(); IF bufch = NdxBones.EndSep[1] THEN IF Garbage THEN StrEdit.SetLength( TmpRecName, 0 ); END; EXIT; END; ELSE StrEdit.Append( TmpRecName, bufch ); END; END; StrEdit.CrunchBlanks( TmpRecName ); ELSIF NdxMarkFound THEN LowLevel.Fill( SYSTEM.ADR(OldNdxElmt), NdxElemSize, 0C ); OldNdxElmt.FilePos := LastSpot; (* position saved when last start sep was found *) OldNdxElmt.Allocated := Numbers.C( FileSpot - LastSpot); DEC( OldNdxElmt.Allocated, 2 ); (* position when this rec startsep found minus position saved when last rec start sep was found *) IF M2Strings.Length( TmpRecName ) > 0 THEN OldNdxElmt.UsedChars := Numbers.C( ThisEndSpot - LastSpot); (*position when this rec endsep found minus position saved when last rec start sep was found *) ELSE OldNdxElmt.UsedChars := 0; END; NdxFile^.NdxFilePtr := FileSpot - NumTypes.L2; SetName( TmpRecName, OldNdxElmt ); END; END;(*WHILE (NOT FileEndReached) AND (NOT NdxMarkFound)*) IF (NOT NdxMarkFound) THEN IF LastSpot = NumTypes.L0 THEN ErrorNames.WarningName('NotNdx'); ELSE NdxFile^.NdxFilePtr := LastSpot; END; END; VStorage.DosDealloc( buf.a, BufSize ); NdxFile^.BufSizeNow := 0; NdxFiles.WriteNdx( NdxFile ); END RebuildNdx; PROCEDURE AllowRebuild( VAR NdxFile: NdxTypes.NdxFileType ); BEGIN ErrorManager.WARN( 'Damaged file. Will attempt to rebuild it' ); RebuildNdx( NdxFile ); END AllowRebuild; PROCEDURE Init(); BEGIN IF Initialized THEN RETURN; ELSE Initialized := TRUE; END; (*EntryDiag: Diagnostics.Init(); :EntryDiag*) EnvironUtils.Init(); ErrorManager.Init(); ErrorNames.Init(); HandleIO.Init(); GenLists.Init(); ListUtils.Init(); LowLevel.Init(); M2Strings.Init(); NdxBones.Init(); NdxFiles.Init(); NdxTypes.Init(); Numbers.Init(); NumTypes.Init(); PosUtils.Init(); StrConv.Init(); StrEdit.Init(); StringIO.Init(); VStorage.Init(); (*EntryDiag: Diagnostics.diagS( 'Entering NdxUtils', '' ); :EntryDiag*) NdxBones.RebuildProc := AllowRebuild; (*EntryDiag: Diagnostics.diagS( 'Exiting NdxUtils', '' ); :EntryDiag*) END Init; BEGIN Initialized := FALSE; Init(); END NdxUtils.