| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906 |
- 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.
|