CD Actual 13/CDA13.ISO/cdactual/demobin/share/program/Pascal/AIM.ZIP/AIMDEXP.PAS

Pascal/Delphi Source File | 1991-06-29 | 34.1 KB | 1,047 lines

        {Compiler directives}

{D+}                    {debug information}
{T-}                    {create .TPM file for debugging}
{F-}                    {automatically force far calls}
{V-}                    {var string checking}
{L+}                    {link buffer in memory}
{$R-}                   {range checking}
{$B+}                   {boolean complete evaluation}
{$S+}                   {stack checking}
{$I+}                   {I/O checking}
{$N-}                   {numeric coprocessor}
{$M 65500,0,655360}     {memory sizes}

{***************************************************************************}
{*                                                                         *}
{*      AIMDEXP.PAS         Copyright - Matt Goodrich                      *}
{*                              Jun 29, 1991                               *}
{*                                                                         *}
{*   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -   *}
{*                                                                         *}
{*      Maintenance History :                                              *}
{*                                                                         *}
{*  1.A  MG  6/29/91 - Initial Keyin.                                      *}
{*                                                                         *}
{***************************************************************************}

PROGRAM AIMDEXP;

USES

  CRT, MISCSTUF, AIMUNIT;


{$I AIMVAR.PAS}  {inclusion with shared variable definitions}

CONST

  Version           = '1.A';    {version number of this program}


  EOF_Mark          = CHR (26);
  CarrRet           = CHR (13);
  LineFeed          = CHR (10);

  WorkArrayMax      = 16383;    {The max seems to be 16383.}
  ReadBufferMaxSize = 32000;


TYPE
  IntPtr            = ^INTEGER;

  WrkArrPtr         = ARRAY [1..WorkArrayMax] OF LONGINT;
  WrkArrType        = ^WrkArrPtr;





VAR
  BytesPerHash    : LONGINT;
  BytesToWrit     : LONGINT;
  BytesToWrite    : LONGINT;
  BytesWritten    : LONGINT;
  DashPos         : INTEGER;
  DataFileSize    : LONGINT;
  EOFReached      : STRING [ 1];
  InRecnumBuffEnd : LONGINT;
  InRecnumToGet   : LONGINT;
  NewByte         : BYTE;
  NextBuffRec     : INTEGER;
  NumRecsInBuff   : INTEGER;
  NumbDataRecs    : LONGINT;
  OldBlockOn      : LONGINT;
  OldByteOn       : LONGINT;
  OldHash         : LONGINT;
  One             : LONGINT;
  ParamKeys       : STRING [99];
  ParamLen        : STRING [ 7];
  ReadBuffer      : ARRAY [1..ReadBufferMaxSize] OF CHAR;
  ReadBufferSize  : LONGINT;
  RecToProcess    : LONGINT;
  SeekPosData     : LONGINT;
  SizeAimFile     : LONGINT;
  StrPtr          : INTEGER;
  StringToAdd     : STRING [ 3];
  WorkArray       : WrkArrType;
  WorkArrayCtr    : LONGINT;
  WorkPtr         : INTPTR;

{***************************************************************************}
{***************************************************************************}
{***************************************************************************}
{***************************************************************************}
{***************************************************************************}
{                                                                           }
{                 Some notes on how AIMDEXP works:                          }
{                                                                           }
{ It figures out how big the aimfile needs to be based on how many records  }
{ are in the datafile (plus a little extra).  It then creates an empty      }
{ aimdex file (hex 00 or all bits off).                                     }
{                                                                           }
{ It then gets a record from the datafile, calculates the hash value for    }
{ each of the triplets, then 'flicks on' the bits in the aimdex that        }
{ correspond to that datafile record and the various hash values.           }
{                                                                           }
{ Now in order to speed things up, I did a couple of things.  First of all, }
{ it doesn't read the datafile records one at a time, but instead does a    }
{ block read (of about 32K bytes) and if the requested record is in that    }
{ block, it gets it from there.  If not, it reads in the next block.        }
{                                                                           }
{ The other trick is that it doesn't actually do the aimfile writes one     }
{ triplet at a time.  Instead, with each triplet that gets processed, it    }
{ adds an element to a work array that consists of the hash value and the   }
{ datafile record number.  That array is defined as LONGINT where the first }
{ four digits are the hash value, and the last six digits are the record    }
{ number.  When the array gets full, it is sorted (using a recursive        }
{ quicksort algorithm) which leaves it looking something like:              }
{                                                                           }
{                                                                           }
{                         hash     rec                                      }
{                        value    number                                    }
{                        -----    ------                                    }
{                            1       47                                     }
{                            2       11                                     }
{                            3       11                                     }
{                            3       42                                     }
{                            7      116                                     }
{                            7      118                                     }
{                            7      148                                     }
{                            8       55                                     }
{                            .        .                                     }
{                            .        .                                     }
{                         1009       32                                     }
{                                                                           }
{ Now we go through the work array to 'flick on' the appropriate bits in    }
{ the aimdex file. We're writing one aimdex record per hash value, so we do }
{ 'control break' logic to read the aimdex record for that hash value,      }
{ 'flick on' all the appropriate bits, then write the record to the aimdex  }
{ file.  It's complicated by the fact that 2 particular elements that have  }
{ the same hash value, may be in 2 different blocks in the aimdex file and  }
{ thus we need a 'control break' for when the block number changes too (in  }
{ the above example, recnums 118 & 148 may fall into different blocks).     }
{                                                                           }
{***************************************************************************}
{***************************************************************************}
{***************************************************************************}
{***************************************************************************}
{***************************************************************************}

PROCEDURE DispHelpScreen;

BEGIN

   Disp_String ('Basic syntax is:', 1, 8, Normal_Video);

   Disp_String ('AIMDEXP  <infile>  <outfile>  <keyspec>  [-F=nnn]',
            10, 10, Normal_Video);

   Disp_String ('An example might be:', 1, 14, Normal_Video);

   Disp_String ('AIMDEXP  CUSTFILE.TXT  CUSTFILE.AIM  8-28,39-45,52-57',
            10, 16, Normal_Video);

END;

{***************************************************************************}

PROCEDURE DispSomeStuff;

BEGIN
  Disp_String ('Data file  : ' + Aim.DataFileName, 1,  3, Normal_Video);
  Disp_String ('Aim  file  : ' + Aim.AimFileName,  1,  4, Normal_Video);
  Disp_String ('Key fields : ' + ParamKeys,    1,  6, Normal_Video);
END;

{***************************************************************************}

PROCEDURE ProcessParamKeys;

{---------------------------------------------------------------------------}
{ Process the parameter with the aimdex keys.  It typically looks something }
{ like '11-15,22-39,43-46'.  We want to break that up into the arrays       }
{ KeyBeg and KeyEnd.  KeyBeg [1] would be '11', KeyEnd [1] would be '15',   }
{ etc.                                                                      }
{---------------------------------------------------------------------------}

VAR
  I             : INTEGER;
  TempStringBeg : STRING [ 4];
  TempStringEnd : STRING [ 4];
  TempString99  : STRING [99];

BEGIN

  ParamKeys := PARAMSTR (3);

  Aim.NumbValidKeys := 0;

  { -- Initialize the arrays to nothing defined.}
  FOR I := 1 TO AimMaxKeys DO
    BEGIN
      Aim.KeyBegCol [I] := 0;
      Aim.KeyEndCol [I] := 0;
    END;




  TempString99 := '';

  FOR I:= 1 TO LENGTH (ParamKeys) DO
    BEGIN
      IF COPY (ParamKeys, I, 1) = ','
        THEN BEGIN
               Aim.NumbValidKeys := Aim.NumbValidKeys + 1;
               IF Aim.NumbValidKeys > AimMaxKeys
                   THEN AimFatalError (150, '');

               DashPos := POS ('-', TempString99);
               IF (DashPos > 0)
                 THEN BEGIN
                        TempStringBeg := COPY (TempString99, 1, DashPos - 1);
                        VAL (TempStringBeg, Aim.KeyBegCol [Aim.NumbValidKeys],
                                    ValError);
                        IF ValError <> 0
                           THEN AimFatalError (20, TempStringBeg);

                        TempStringEnd := COPY (TempString99, DashPos + 1,
                               LENGTH (TempString99) - DashPos);
                        VAL (TempStringEnd, Aim.KeyEndCol [Aim.NumbValidKeys],
                                    ValError);
                        IF ValError <> 0
                           THEN AimFatalError (21, TempStringEnd);

                        TempString99 := '';
                      END

                 ELSE BEGIN
                        { -- Someday I may allow keys of 1 digit.}
                        AimFatalError (22, TempString99);
                      END;

             END

        ELSE BEGIN
               TempString99 := TempString99 + COPY (ParamKeys, I, 1);
             END;
    END;




  { -- Build a key from the string after the last comma.}
  Aim.NumbValidKeys := Aim.NumbValidKeys + 1;
  IF Aim.NumbValidKeys > AimMaxKeys
     THEN AimFatalError (151, '');

  DashPos := POS ('-', TempString99);
  IF (DashPos > 0)
     THEN BEGIN
             TempStringBeg := COPY (TempString99, 1, DashPos - 1);
             VAL (TempStringBeg, Aim.KeyBegCol [Aim.NumbValidKeys], ValError);
             IF ValError <> 0
                THEN AimFatalError (23, TempStringBeg);

             TempStringEnd := COPY (TempString99, DashPos + 1,
                           LENGTH (TempString99) - DashPos);
             VAL (TempStringEnd, Aim.KeyEndCol [Aim.NumbValidKeys], ValError);
             IF ValError <> 0
                THEN AimFatalError (24, TempStringEnd);
          END

     ELSE BEGIN
             { -- Someday I may allow keys of 1 digit.}
             AimFatalError (25, TempString99);
          END;



  { -- A little more edit checking here}
  FOR I := 1 TO Aim.NumbValidKeys DO
    BEGIN
      IF (Aim.KeyEndCol [I] - Aim.KeyBegCol [I] < 2)
        THEN AimFatalError (26, '- they must be at least 3 chars');

      IF (Aim.KeyEndCol [I] - Aim.KeyBegCol [I] > 255)
        THEN AimFatalError (27, '- key is too long');

      IF (Aim.KeyEndCol [I] > Aim.RecLenData-2)
        THEN AimFatalError (28, '- key is bigger than datafile record');

      IF (Aim.KeyBegCol [I] < 1)
        THEN AimFatalError (29, '- key is less than 1');
    END;

END;

{***************************************************************************}

PROCEDURE OpenDataFile;

BEGIN

 ASSIGN (Aim.DataFile, Aim.DataFileName);

 {$I-}
 RESET  (Aim.Datafile, 1);
 {$I+}

 IF IORESULT <> 0
    THEN BEGIN
            AimFatalError (71, Aim.DataFileName);
         END;
END;

{***************************************************************************}

PROCEDURE OpenAimFile;

BEGIN

 ASSIGN (Aim.AimFile, Aim.AimFileName);

 {$I-}
 RESET  (Aim.Aimfile, 1);
 {$I+}

 IF IORESULT <> 0
    THEN BEGIN
            AimFatalError (51, Aim.AimFileName);
         END;
END;

{***************************************************************************}

PROCEDURE Read1stDataRec;

{---------------------------------------------------------------------------}
{ Get the record length of the data file by reading the first record.  Read }
{ in a block and search for a line feed character to denote the EOR.        }
{---------------------------------------------------------------------------}

VAR
  EndLoop  : STRING [ 1];
  I        : INTEGER;

BEGIN

  SEEK (Aim.DataFile, 0);
  BLOCKREAD (Aim.DataFile, ReadBuffer, RecLenDataMax, CharsRead);

  IF CharsRead <= 1
    THEN Aim.RecLenData := 0

    ELSE BEGIN
           I := 1;

           EndLoop := No;
           WHILE (EndLoop = No) DO
             BEGIN
               IF I > RecLenDataMax
                 THEN AimFatalError (90, '');

               IF ReadBuffer [I] = LineFeed
                 THEN BEGIN
                        Aim.RecLenData := I;
                        EndLoop        := Yes;
                      END
                 ELSE BEGIN
                        I := I + 1;
                      END;
             END;

         END;

END;

{***************************************************************************}

PROCEDURE GetRecLenData;

{---------------------------------------------------------------------------}
{ Process the parameter for the length of the datafile records ('-F=nnn').  }
{ If they didn't specify it, read the first record in the datafile and      }
{ assume it to be the correct record length.                                }
{---------------------------------------------------------------------------}

VAR
  TempString04 : STRING [ 4];

BEGIN
  ParamLen := PARAMSTR (4);

  IF ParamLen = ''
     THEN BEGIN
            Read1stDataRec;
            IF Aim.RecLenData < 1
               THEN AimFatalError (120, '');
          END

     ELSE BEGIN
            { -- skip past '-F='}
            TempString04 := COPY (ParamLen, 4, LENGTH (ParamLen) - 3);
            VAL (TempString04, Aim.RecLenData, ValError);
            IF ValError <> 0
              THEN AimFatalError (100, TempString04);
            Aim.RecLenData := Aim.RecLenData + 2;
          END;

END;

{***************************************************************************}

PROCEDURE GetNumbDataRecs;

{---------------------------------------------------------------------------}
{ Calculate the number of records in the datafile, based on the file size   }
{ in bytes and the record length.                                           }
{---------------------------------------------------------------------------}

BEGIN

  DataFileSize := FILESIZE (Aim.DataFile);   {Gives size in bytes.}
  DataFileSize := DataFileSize - 1;          {Minus 1 for the EOF marker.}

  { -- Filesize must be an even multiple of the record length.}
  IF (DataFileSize / Aim.RecLenData) <> INT (DataFileSize / Aim.RecLenData)
    THEN BEGIN
            AimFatalError (13, Aim.DataFileName);
         END;

  NumbDataRecs := DataFileSize DIV Aim.RecLenData;

  { -- Max is around 1 million}
  IF NumbDataRecs > 999990
     THEN AimFatalError (140,'');
END;

{***************************************************************************}

PROCEDURE ExchangeValues (X, Y : INTEGER);

{---------------------------------------------------------------------------}
{ Exchange two elements of the work array. This gets used when partitioning }
{ and sorting the array.                                                    }
{---------------------------------------------------------------------------}

VAR
  TempLongInt : LONGINT;

BEGIN

   TempLongInt    := WorkArray^ [X];
   WorkArray^ [X] := WorkArray^ [Y];
   WorkArray^ [Y] := TempLongInt;

END;

{***************************************************************************}

PROCEDURE Partition (VAR L  : LONGINT;
                     VAR R  : LONGINT;
                     VAR L1 : LONGINT;
                     VAR R1 : LONGINT;
                     VAR L2 : LONGINT;
                     VAR R2 : LONGINT);

{---------------------------------------------------------------------------}
{ This routine is used by the quicksort.  It divides an array into 2        }
{ smaller 'halves'. It does it by evaluating the first element, and moving  }
{ all smaller items to the 'left' and all larger items to the 'right',      }
{ leaving that first element roughly in the middle.                         }
{---------------------------------------------------------------------------}

VAR
 I,J : LONGINT;

BEGIN

  IF (L >= R)
    THEN BEGIN
            L1 := L;
            R1 := R;
            L2 := L;
            R2 := R;
            EXIT;
         END;

  I := L;
  J := R;

  WHILE (1=1) DO
    BEGIN

      WHILE (WorkArray^ [I] <= WorkArray^ [J]) AND (I < J) DO
         BEGIN
           J := J - 1;
         END;

      IF (I < J)
         THEN ExchangeValues (I, J)
         ELSE BEGIN
                L1 := L;
                IF I > L
                  THEN R1 := I-1
                  ELSE R1 := L;
                L2 := I+1;
                R2 := R;
                EXIT;
              END;

      WHILE (WorkArray^ [I] <= WorkArray^ [J]) AND (I < J) DO
         BEGIN
           I := I + 1;
         END;

      IF (I < J)
         THEN ExchangeValues (I, J)
         ELSE BEGIN
                L1 := L;
                R1 := J-1;
                IF J < R
                   THEN L2 := J+1
                   ELSE L2 := J;
                R2 := R;
                EXIT;
              END;

    END;

END;

{***************************************************************************}

PROCEDURE QSortWorkArray (VAR L : LONGINT;
                          VAR R : LONGINT);

{---------------------------------------------------------------------------}
{ This routine sorts the work array with a recursive quicksort.  First      }
{ divides it into 2 roughly equal halves where one is made up of all items  }
{ less than some value, and the other half is all items greater than that   }
{ value.  It then performs the sort on each half.                           }
{---------------------------------------------------------------------------}

VAR
  L1, R1, L2, R2 : LONGINT;

BEGIN

  Partition (L, R, L1, R1, L2, R2);

  IF L1 < R1
    THEN QSortWorkArray (L1, R1);

  IF L2 < R2
    THEN QSortWorkArray (L2, R2);

END;

{***************************************************************************}

PROCEDURE SortWorkArray;

{---------------------------------------------------------------------------}
{ Sort the work array (by hash value).                                      }
{---------------------------------------------------------------------------}

VAR
  I,J           : LONGINT;
  TempLongInt   : LONGINT;

BEGIN

   Disp_Number (WorkArrayCtr, 33, 12, Normal_Video, 7, 0);
   Disp_String ('Sorting work array...', 50, 12, Normal_Video);

   QSortWorkArray (One, WorkArrayCtr);

   GOTOXY (50, 12);      { -- Clear the 'Sorting' message from screen.}
   CLREOL;

END;

{***************************************************************************}

PROCEDURE FlushWorkArray;

{---------------------------------------------------------------------------}
{ Use the values in the work array to turn on the appropriate bits in the   }
{ aimdex file.                                                              }
{---------------------------------------------------------------------------}

VAR
  I           : LONGINT;
  TempLongInt : LONGINT;

BEGIN

  { -- Empty array, nothing to do.}
  IF WorkArrayCtr <= 0
    THEN EXIT;

  { -- Figure out which block the 'prime read' is on.}
  TempLongInt := WorkArray^[1] MOD 1000000;
  OldBlockOn := ((TempLongInt-1) DIV (AimBlockSize * 8)) + 1;
  OldByteOn  := (((TempLongInt-1) MOD (AimBlockSize * 8)) DIV 8) + 1;

  { -- Get the hash value for that first item.  Save for control break.}
  TempLongInt := WorkArray^[1] DIV 1000000;
  OldHash := TempLongInt;

  { -- Prime read - for control break.}
  SeekPos := (OldBlockOn-1) * 1010 * AimBlockSize +
             (OldHash * AimBlockSize);
  SEEK (Aim.AimFile, SeekPos);
  BLOCKREAD  (Aim.AimFile, AimBuffer, AimBlockSize, CharsRead);




  { -- Process each item in the work array.}
  FOR I:= 1 TO WorkArrayCtr DO
    BEGIN
      IF I MOD 100 = 0
         THEN Disp_Number (I, 33, 13, Normal_Video, 7, 0);

      { -- Calculate which block & byte we are on.}
      TempLongInt := WorkArray^[I] MOD 1000000;
      Aim.BlockOn     := ((TempLongInt-1) DIV (AimBlockSize * 8)) + 1;
      Aim.ByteOn      := (((TempLongInt-1) MOD (AimBlockSize * 8)) DIV 8) + 1;


      { -- If the hash value or the block number have changed, then write the }
      { -- aimdex record.                                                     }
      IF ((WorkArray^[I] DIV 1000000) <> OldHash) OR
         (Aim.BlockOn <> OldBlockOn)
         THEN BEGIN

                SeekPos := (OldBlockOn-1) * 1010 * AimBlockSize +
                           (OldHash * AimBlockSize);
                SEEK (Aim.AimFile, SeekPos);
                BLOCKWRITE (Aim.AimFile, AimBuffer, AimBlockSize, CharsWrit);

                OldHash := WorkArray^[I] DIV 1000000;  {save for control break}
                OldBlockOn := Aim.BlockOn;

                SeekPos := (Aim.BlockOn-1) * 1010 * AimBlockSize  +
                           ((WorkArray^[I] DIV 1000000) * AimBlockSize);
                SEEK (Aim.AimFile, SeekPos);
                BLOCKREAD  (Aim.AimFile, AimBuffer, AimBlockSize, CharsRead);

              END;


      { -- 'Flick on' the appropriate bit in the aimdex Buffer.}
      NewByte := AimBuffer [Aim.ByteOn];

      WhichBit := ((WorkArray^ [I] MOD 1000000)-1) MOD 8 + 1;
      CASE WhichBit OF
         1 : NewByte := NewByte OR $80;
         2 : NewByte := NewByte OR $40;
         3 : NewByte := NewByte OR $20;
         4 : NewByte := NewByte OR $10;
         5 : NewByte := NewByte OR $08;
         6 : NewByte := NewByte OR $04;
         7 : NewByte := NewByte OR $02;
         8 : NewByte := NewByte OR $01;
      END;

      AimBuffer [Aim.ByteOn] := NewByte;

    END;




  { -- Do last control break}
  SeekPos := (OldBlockOn-1) * 1010 * AimBlockSize +
             (OldHash * AimBlockSize);
  SEEK (Aim.AimFile, SeekPos);
  BLOCKWRITE (Aim.AimFile, AimBuffer, AimBlockSize, CharsWrit);


  { -- Reset the work array back to zero, to begin all over again.}
  WorkArrayCtr := 0;

  Disp_Number (0, 30, 12, Normal_Video, 10, 0);
  Disp_Number (0, 30, 13, Normal_Video, 10, 0);
END;

{***************************************************************************}

PROCEDURE AddToAimdex;

{---------------------------------------------------------------------------}
{ Add a hash numb/record numb to the work array.  If the work array is      }
{ full, sort it, then 'flush it out' (ie, use it to write to the aimdex     }
{ file.)                                                                    }
{---------------------------------------------------------------------------}

BEGIN

  AimGetHashNumb (StringToAdd, HashNumb);

  IF WorkArrayCtr >= WorkArrayMax
    THEN BEGIN
           SortWorkArray;
           FlushWorkArray;
         END;

  WorkArrayCtr := WorkArrayCtr + 1;
  WorkArray^ [WorkArrayCtr] := HashNumb * 1000000 + RecToProcess;

END;

{***************************************************************************}

PROCEDURE ProcessInRecord;

{---------------------------------------------------------------------------}
{ Process the next input record.                                            }
{---------------------------------------------------------------------------}

VAR
  I,J        : INTEGER;

BEGIN

  { -- If you want to ignore deleted records by way of an "I'm a deleted }
  { -- record" byte, put that logic here, and don't bother processing    }
  { -- the datafile record.                                              }

  RecToProcess := RecToProcess + 1;

  { -- Do this loop once for each key field.}
  FOR I:= 1 TO Aim.NumbValidKeys DO
    BEGIN

       { -- Do this loop once for each triplet.}
       FOR J:= Aim.KeyBegCol [I] TO (Aim.KeyEndCol [I]-2) DO
          BEGIN
            StringToAdd := DataBuffer [J];
            IF (J+1 <= Aim.KeyEndCol [I])
              THEN StringToAdd := StringToAdd + DataBuffer [J + 1]
              ELSE StringToAdd := StringToAdd + Bla;
            IF (J+2 <= Aim.KeyEndCol [I])
              THEN StringToAdd := StringToAdd + DataBuffer [J + 2]
              ELSE StringToAdd := StringToAdd + Bla;

            { -- Ignore any all blank triplets.  If you want to ignore      }
            { -- records that had been overwritten with a delete character, }
            { -- you should check for that here.                            }
            IF StringToAdd <> '   '
              THEN BEGIN
                     Convert_Upper (StringToAdd);
                     AddToAimdex;
                   END;
          END;

    END;

END;

{***************************************************************************}

PROCEDURE GetNextInRec;

{---------------------------------------------------------------------------}
{ This routine gets the next record and puts it into DataBuffer.  It buffers}
{ the read by doing BLOCKREADs into ReadBuffer.  If the next record is in   }
{ ReadBuffer, just load DataBuffer from there.  If it isn't, do another     }
{ BLOCKREAD of the datafile.                                                }
{---------------------------------------------------------------------------}

VAR
  I           : INTEGER;
  DispPctDone : REAL;

BEGIN
  { -- Is the desired record past the last record in the read buffer?}
  IF InRecnumToGet > InRecnumBuffEnd
    THEN BEGIN
           { -- Read the next buffer full.}
           SEEK (Aim.DataFile, SeekPosData);
           BLOCKREAD (Aim.DataFile, ReadBuffer, ReadBufferSize, CharsRead);
           IF CharsRead = 0
             THEN AimFatalError (14, '');

           { -- Number of bytes read should be an even multiple of record }
           { -- length.  Subtract one for EOF marker if the entire buffer }
           { -- didn't get filled.                                        }
           IF (CharsRead < ReadBufferSize) AND
              (((CharsRead-1) / Aim.RecLenData) <> INT ((CharsRead-1) /
              Aim.RecLenData))
             THEN AimFatalError (15, Aim.DataFileName);

           IF CharsRead = ReadBufferSize
             THEN NumRecsInBuff := ReadBufferSize DIV Aim.RecLenData
             ELSE NumRecsInBuff := ((CharsRead-1) DIV Aim.RecLenData) + 1;

           InRecnumBuffEnd := InRecnumBuffEnd + NumRecsInBuff;

           { -- The count included EOF, so subtract one when displaying.}
           Disp_Number (InRecnumBuffEnd-1, 31, 10, Normal_Video, 9, 0);

           IF NumbDataRecs > 0
             THEN BEGIN
                    DispPctDone := ((InRecnumBuffEnd-1) / NumbDataRecs) * 100 ;
                    Disp_Number (DispPctDone,  43, 10, Normal_Video, 3, 0);
                  END;

           { -- Position the file pointer for the next BLOCKREAD.}
           SeekPosData := SeekPosData + CharsRead;
           NextBuffRec := 1;     {Pointer to record in ReadBuffer.}
         END;



  { -- If pointing to EOF, then we're finished.}
  IF ReadBuffer [NextBuffRec * Aim.RecLenData - Aim.RecLenData + 1] = EOF_Mark
    THEN BEGIN
            EOFReached := Yes;
         END

    ELSE BEGIN
           { -- Make sure it has EOR markers}
           IF ReadBuffer [NextBuffRec * Aim.RecLenData] <> LineFeed
              THEN AimFatalError (16, Aim.DataFileName);
           IF ReadBuffer [NextBuffRec * Aim.RecLenData - 1] <> CarrRet
              THEN AimFatalError (17, Aim.DataFileName);

           { -- Transfer from ReadBuffer to DataBuffer.}
           FOR I:= 1 TO Aim.RecLenData DO
             BEGIN
               DataBuffer [I] := ReadBuffer [NextBuffRec * Aim.RecLenData
                                    - Aim.RecLenData + I];
             END;

           NextBuffRec := NextBuffRec + 1;

         END;

END;

{***************************************************************************}

PROCEDURE CreateEmptyAimFile;

{---------------------------------------------------------------------------}
{ This creates a completely empty aimdex file (all null characters) that is }
{ the correct size.                                                         }
{---------------------------------------------------------------------------}

VAR
  I             : INTEGER;
  EndWritLoop   : STRING [ 1];
  WhoCares      : INTEGER;

BEGIN

 ASSIGN (Aim.AimFile, Aim.AimFileName);

 { -- This extra erase is because of the Novell 'PURGE' feature.}
 {$I-}
 ERASE (Aim.AimFile);
 {$I+}
 WhoCares := IORESULT;


 {$I-}
 REWRITE (Aim.AimFile, 1);
 {$I+}
 IF IORESULT <> 0
    THEN BEGIN
            AimFatalError (110, Aim.AimFileName);
         END;







 FOR I := 1 TO ReadBufferMaxSize DO
   BEGIN
     ReadBuffer [I] := CHR (00);   {Null character}
   END;

 { -- Calculate how many bytes the aimdex file needs to be.}
 BytesPerHash  := (NumbDataRecs DIV 8) + 126;      {126 = 1008 empty slots}
 Aim.BlocksPerHash := (BytesPerHash DIV AimBlockSize) + 1;
 SizeAimFile := Aim.BlocksPerHash * 1010 * AimBlockSize;

 Disp_String ('Size of file to build...', 1,  9, Normal_Video);
 Disp_String ('Bytes written so far...',  1, 10, Normal_Video);
 Disp_Number (SizeAimFile, 26,  9, Normal_Video, 11, 0);


 { -- Loop to write a big block of bytes, until we've written the full file.}
 BytesWritten := 0;
 EndWritLoop := No;
 WHILE (EndWritLoop = No) DO
   BEGIN
     IF (BytesWritten + ReadBufferMaxSize) <= SizeAimFile
        THEN BytesToWrite := ReadBufferMaxSize
        ELSE BytesToWrite := SizeAimFile - BytesWritten;

     BLOCKWRITE (Aim.AimFile, ReadBuffer, BytesToWrite, CharsWrit);
     IF CharsWrit <> BytesToWrite
       THEN BEGIN
               AimFatalError (41, Aim.AimFileName);
            END;

     BytesWritten := BytesWritten + BytesToWrite;
     IF BytesWritten >= SizeAimFile
        THEN EndWritLoop := Yes;

     Disp_Number (BytesWritten, 26, 10, Normal_Video, 11, 0);

   END;



 AimWritHeaderRec (Aim);

 CLOSE (Aim.AimFile);
 GOTOXY (1,  9);
 CLREOL;
 GOTOXY (1, 10);
 CLREOL;

END;

{***************************************************************************}

PROCEDURE DoItAll;

{---------------------------------------------------------------------------}
{ This is the main loop that builds the whole aimdex file.                  }
{---------------------------------------------------------------------------}

BEGIN

  Disp_String ('Total data records in file :', 1, 9, Normal_Video);
  Disp_Number (NumbDataRecs,  31, 9, Normal_Video, 9, 0);

  Disp_String ('Data records read in so far:                 %', 1, 10,
                        Normal_Video);

  Disp_String ('Triplets in work array      :', 1, 12, Normal_Video);
  Disp_String ('Writing work array to aimdex:', 1, 13, Normal_Video);


  ReadBufferSize := (ReadBufferMaxSize DIV Aim.RecLenData) * Aim.RecLenData;

  MARK (WorkPtr);     {Dynamically allocate memory for work array}
  NEW (WorkArray);


  WorkArrayCtr    := 0;
  RecToProcess    := 0;
  SeekPosData     := 0;
  InRecnumBuffEnd := 0;
  InRecnumToGet   := 1;
  EOFReached      := No;

  GetNextInRec;        {Prime read}

  WHILE (EOFReached = No) DO
    BEGIN
        ProcessInRecord;
        InRecnumToGet := InRecnumToGet + 1;

        GetNextInRec;   {eventually returns EOFReached = Yes}
    END;

  SortWorkArray;       {Do the last 'Control Break'}
  FlushWorkArray;

  RELEASE (WorkPtr);

END;

{***************************************************************************}
{***************************************************************************}

BEGIN    {Main Procedure AIMDEXP}

 Ins_Mode := Yes;      {Initialize for Keyin_String routine}
 One      := 1;
 Cursor_Off;           {I don't like cursors flying all over the screen}

 CLRSCR;

 Disp_String ('Progam: AIMDEXP',  1,  1, Normal_Video);
 Disp_String ('Version: ' + Version,  60,  1, Normal_Video);


 IF PARAMCOUNT < 3
   THEN BEGIN
          DispHelpScreen;
          AimHaltProgram (1);  {Return DOS errorlevel of 1.}
        END;


 IF (HeaderBuffSize > AimBlockSize)
    THEN BEGIN
            AimFatalError (131, '');
         END;


 Aim.DataFileName := PARAMSTR (1);
 Aim.AimFileName  := PARAMSTR (2);
 Convert_Upper (Aim.DataFileName);     {upper case fetishist}
 Convert_Upper (Aim.AimFileName);

 OpenDataFile;

 GetRecLenData;

 GetNumbDataRecs;      {Find out how many records are in the datafile.}

 ProcessParamKeys;     {Process the aimdex keys parameter, eg '5-12,20-25'}

 DispSomeStuff;

 CreateEmptyAimFile;

 OpenAimFile;

 DoItAll;              {Fill in the empty aimdex file}

 CLOSE (Aim.DataFile);
 CLOSE (Aim.AimFile);

 Disp_String ('Aimdexing completed successfully.', 1, 22, Normal_Video);

 AimHaltProgram (0);      {Return DOS errorlevel of 0.}

END.

{***************************************************************************}
{***                         End of AIMDEXP.PAS                          ***}
{***************************************************************************}