[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    { Demo at the end of this unit }

    {
      Program by         Miguel Angel Cand¢n
      Last revision date 09-01-93
      miguel_angel@jet
    }
    (*

       First, excuse me, I don't speak english.

      1024 bytes per page,
         Max keys in page = 1014 div (4+LenKey)
         Min keys in page = Max keys in page div 2
         Every key (if not level 0), have another key page
         One page reserved for swaps.

      if (LenKey = 10) and (PagesInMemory = 16) the index file can
      have 36^14 keys up to 72^14.

      MaxPagesInMemory : 4..63 = 16;  { Levels per index file }

       Return:
         RecIndex : LongInt  ==> rec number in data file
         ErrIndex : word     ==> if <> 0 => errors ...

    procedure OpenIndex( var CualIndex:PtrIndex; const NomFile:PathStr );
    procedure CreateIndex( var CualIndex:PtrIndex; const NomFile:PathStr;
    CualKeyLength:byte );
    procedure FindKey( CualIndex:PtrIndex; Clave:string );
    procedure FindKeyRecNo( CualIndex:PtrIndex; const Clave:string;
    RecNo:LongInt );
    procedure NextKey( CualIndex:PtrIndex; SearchNextNotFound:boolean );
    procedure PrevKey( CualIndex:PtrIndex; SearchNextNotFound:boolean );
    procedure InsKey( CualIndex:PtrIndex; Clave:string; RecNo:LongInt );
    procedure CloseIndex( var CualIndex:PtrIndex );
    procedure DelKey( CualIndex:PtrIndex; Clave:string; RecNo:LongInt );
    procedure ReplaceKey( CualIndex:PtrIndex; const OldClave,NewClave:string;
    RecNo:LongInt );
    procedure FindFirstKey(CualIndex:PtrIndex);
    procedure FindLastKey(CualIndex:PtrIndex);

    procedure ShortIntToKey( valor:ShortInt ; var Salida:Char );
    procedure ByteToKey( valor:byte ; var Salida:Char );
    procedure IntegerToKey( valor:integer ; var Salida:Char2 );
    procedure WordToKey( valor:word ; var Salida:Char2 );
    procedure LongIntToKey( valor:LongInt ; var Salida:Char4 );

    *)

    {$A+,B-,D-,E-,F-,G+,I+,L-,N-,O-,P+,Q-,R-,S-,T-,V-,X+,Y-}

    unit
      SwagIdx;

    interface

    uses
      memory,dos;

    const
      Version = $0202;

      MaxPagesInMemory : 4..63 = 16;  { Leves per index file }
      MaxKeyLength = 100;

      IndexRetryCount : word = 10;   { Shared retry }
    {  IndexRetryDelay : word = 1;    }

      ErrIndex : word=0;
      RecIndex : LongInt=0;

      ErrIndexFound       = $0000;
      ErrIndexNotFound    = $0001;
      ErrIndexBig         = $0002;
      ErrIndexEOF         = $0010;
      ErrIndexBOF         = $0011;
      ErrIndexOtherKey    = $0004;
      ErrIndexNoKeys      = $00FF;

      ErrIndexShared      = $1000;
      ErrIndexRead        = $1100;
      ErrIndexWrite       = $1200;
      ErrIndexFileNoOpen  = $1300;
      ErrIndexNoMemory    = $FFFF;
      ErrIndexTooManyKeys = $FEFE;

    type
      char2   = array[1..2] of char;
      char4   = array[1..4] of char;
      Char255 = array[1..255] of char;
    const
      SizeOfResto = 1024-10;
    type
      RegPageIndex = record
        Nivel:byte;
        RecActual:byte;
        OfsResto:word;
        NPage:LongInt; { Rec number in FIndex }
        KeysInPage:word;
        resto:array[0..SizeOfResto-1] of byte;
              { RecNo + clave | RecNo + clave ... }
              { if RecNo = -1 => deleted }
      end;
      RegAuxBufIndexHead = record
        NumKeys,
        NumDelKeys,
        FirstPage,
        LastPage:LongInt;
      end;
      RegBufIndex=record
        NumKeys:LongInt;
        NumDelKeys:LongInt;
        FirstPage,
        LastPage:LongInt;
        KeyLength:word;
        CualVersion:word;
        FIndex:file;
        MaxKeysInPage:word;
        TotKeyLength:word;
        PageActual:byte;     { from 1 to PagesInMemory }
        SeBloquea:boolean;
        PtrClave:pointer;
        SizeCualIndex:word;
        PagesInMemory : 4..63;
        ModPages:array[0..63] of boolean;
        Pages:array[1..63] of RegPageIndex;
      end;
      PtrIndex = ^RegBufIndex;

    procedure OpenIndex( var CualIndex:PtrIndex; const NomFile:PathStr );
    procedure CreateIndex( var CualIndex:PtrIndex; const NomFile:PathStr;
    CualKeyLength:byte );
    procedure FindKey( CualIndex:PtrIndex; Clave:string );
    procedure FindKeyRecNo( CualIndex:PtrIndex; const Clave:string;
    RecNo:LongInt );
    procedure NextKey( CualIndex:PtrIndex; SearchNextNotFound:boolean );
    procedure PrevKey( CualIndex:PtrIndex; SearchNextNotFound:boolean );
    procedure InsKey( CualIndex:PtrIndex; Clave:string; RecNo:LongInt );
    procedure CloseIndex( var CualIndex:PtrIndex );
    procedure DelKey( CualIndex:PtrIndex; Clave:string; RecNo:LongInt );
    procedure ReplaceKey( CualIndex:PtrIndex; const OldClave,NewClave:string;
    RecNo:LongInt );

    procedure FindFirstKey(CualIndex:PtrIndex);
    procedure FindLastKey(CualIndex:PtrIndex);

    procedure ShortIntToKey( valor:ShortInt ; var Salida:Char );
    procedure ByteToKey( valor:byte ; var Salida:Char );
    procedure IntegerToKey( valor:integer ; var Salida:Char2 );
    procedure WordToKey( valor:word ; var Salida:Char2 );
    procedure LongIntToKey( valor:LongInt ; var Salida:Char4 );

    procedure UnLockFileIndex( CualHandle:word );
    function LockFileIndex(CualHandle:word):boolean;

    procedure MyGetMem(var puntero:pointer; Tamano:word; ValorRelleno:byte);
    procedure MyFreeMem(var puntero:pointer; Tamano:word);
    function Equal(var Comparando1,Comparando2; Tamano:word):boolean;

    implementation

    const
      IsLockFileIndex : boolean = false;
    type
      MaskPtr = record
        xOffset,xSegment:word
      end;
      MaskLong = record
        LoWord, HiWord : word
      end;
      MaskWord = record
        LoByte, HiByte : byte
      end;

    procedure MyGetMem(var puntero:pointer; Tamano:word; ValorRelleno:byte);
    begin
      if Lo(Tamano) and $0F<>0 then
        Tamano := (Tamano and $FFF0) + $10;
      if LongInt(Tamano) > MaxAvail then
        RunError(203)   { Heap Overflow Error }
      else
        begin
          if Tamano > 65528 then
            RunError(203);  { Heap Overflow Error }
          Puntero := MemAllocSeg(Tamano); { GetMem(Puntero,Tamano); }
          fillchar( Puntero^, Tamano, ValorRelleno )
        end;
    end;

    procedure MyFreeMem(var puntero:pointer; Tamano:word);
    begin
      if puntero <> nil then
        begin
          if MaskWord(Tamano).LoByte and $0F<>0 then
            Tamano := (Tamano and $FFF0) + $10;
          FreeMem(Puntero,Tamano);
          Puntero:=nil;
        end
    end;

    procedure ShortIntToKey( valor:ShortInt ; var Salida:Char ); assembler;
    asm
      mov  al,valor
      cmp  al,80h
      jb   @@ShortIntToKeyPositivo
      not  ax
      inc  al
      jmp @@EndShortIntToKey
    @@ShortIntToKeyPositivo:
      or  al,80h
    @@EndShortIntToKey:
      les  di,Salida
      stosb
    end;

    procedure ByteToKey( valor:byte ; var Salida:Char ); assembler;
    asm
      mov  al,valor
      les  di,Salida
      stosb
    end;

    procedure IntegerToKey( valor:integer ; var Salida:Char2 ); assembler;
    asm
      mov  ax,valor
      cmp  ah,80h
      jb   @@IntegerToKeyPositivo
      not  ax
      inc  ax
      jmp @@EndIntegerToKey
    @@IntegerToKeyPositivo:
      or  ah,80h
    @@EndIntegerToKey:
      xchg al,ah
      les  di,Salida
      stosw
    end;

    procedure WordToKey( valor:word ; var Salida:Char2 ); assembler;
    asm
      mov  ax,valor
      xchg al,ah
      les  di,Salida
      stosw
    end;

    procedure LongIntToKey( valor:LongInt ; var Salida:Char4 ); assembler;
    asm
      mov  ax,MaskLong(valor).HiWord
      mov  dx,MaskLong(valor).LoWord
      cmp  ah,80h
      jb   @@LongIntToKeyPositivo
      not  ax
      not  dx
      inc  dx
      jnc  @@EndLongIntToKey
      inc  ax
      jmp @@EndLongIntToKey
    @@LongIntToKeyPositivo:
      or  ah,80h
    @@EndLongIntToKey:
      xchg al,ah
      xchg dl,dh
      les  di,Salida
      cld
      stosw
      mov  es:[di],dx
    end;

    function Equal(var Comparando1,Comparando2; Tamano:word):boolean;
    assembler;
    asm
      mov  al,false
      push ds
      cld
      mov  cx,Tamano
      les  di,Comparando1
      lds  si,Comparando2
      repe cmpsb
      jne  @@NoEqual
      mov  al,True
    @@NoEqual:
      pop  ds
    end;

    procedure WritePage(CualIndex:PtrIndex; CualPage:byte);
    begin
      with CualIndex^ do
        if Pages[CualPage].NPage>0 then
          begin
            seek(FIndex,Pages[CualPage].NPage);
            BlockWrite(FIndex,Pages[CualPage],1);
            ModPages[CualPage]:=false
          end
    end;

    procedure GetEmptyPage(CualIndex:PtrIndex; DondeLeer:byte);
    var
      AuxBucle:byte;
    begin
      with CualIndex^ do
        begin
          inc(LastPage);
          Pages[DondeLeer].NPage:=LastPage
        end
    end;

    function LockFileIndex(CualHandle:word):boolean;
    var
      Intentos:word;
      HayError:boolean;
    begin
      Intentos:=0;
      repeat
        HayError:=false;
        asm
          mov  ax,5C00h
          mov  bx,CualHandle
          xor  cx,cx
          mov  dx,cx
          mov  si,cx
          mov  di,16
          int  21h
          jnc  @@LockFileIndexOk
          mov  HayError,True     { If AL=1 => Invalid function code, =6 Invalid
    handle, 33 File-Locking violation }
    @@LockFileIndexOk:
        end;
        if HayError then
          if IndexRetryCount <> 0 then inc(intentos)
      until (not HayError) or (intentos >= IndexRetryCount);
      IsLockFileIndex := not HayError;
      LockFileIndex := ( not HayError )
    end;

    procedure UnLockFileIndex( CualHandle:word );
    {var                  }
    {  Intentos:word;     }
    {  HayError:boolean;  }
    begin
    { Intentos:=0;
      repeat
        HayError:=false;  }
        asm
          mov  ah,68h         { Commit file }
          mov  bx,CualHandle
          int  21h
          mov  ax,5C01h
          mov  bx,CualHandle
          xor  cx,cx
          mov  dx,cx
          mov  si,cx
          mov  di,16
          int  21h
    (*
          jnc  @@UnLockFileIndexOk
          mov  HayError,True     { if AL=1 => Invalid function code, =6 Invalid
    handle, 33 File-Locking violation }
    @@UnLockFileIndexOk:
    *)
        end;
    (*
        if HayError then
          if IndexRetryCount<>0 then inc(intentos)
      until (not HayError) or (intentos=IndexRetryCount);
    *)
      IsLockFileIndex:=false
    end;

    procedure LoadPage(var CualIndex:PtrIndex; PageToLeer:LongInt;
    DondeLeer:byte );
    label
      LeePage;
    var
      leidos:word;
      LowLevel:byte;
      PageLowLevel:byte;
    procedure ChangePage;
    var
      AuxPage:RegPageIndex;
      AuxModPage:boolean;
    begin
      with CualIndex^ do
        begin
          AuxPage:=Pages[DondeLeer];
          Pages[DondeLeer]:=Pages[leidos];
          Pages[leidos]:=AuxPage;
          AuxModPage:=ModPages[DondeLeer];
          ModPages[DondeLeer]:=ModPages[leidos];
          ModPages[Leidos]:=AuxModPage
        end
    end;
    begin   { LoadPage }
      with CualIndex^ do
        begin
          if DondeLeer>PagesInMemory then
            begin
              ErrIndex:=ErrIndexTooManyKeys;
              exit
            end;
          for leidos:=2 to PagesInMemory do
            if PageToLeer = Pages[leidos].NPage then
              begin
                if leidos<>DondeLeer then
                  ChangePage;
                exit
              end;
          for leidos:=2 to PagesInMemory do   { find empty page ... }
            if Pages[leidos].NPage = 0 then
              begin
                ChangePage;
                goto LeePage
              end;
          if DondeLeer < PagesInMemory then
            begin
              LowLevel := $FF;
              PageLowLevel := 0;
              for leidos := DondeLeer+1 to PagesInMemory do
                begin
                  if Pages[leidos].Nivel < LowLevel then
                    begin
                      LowLevel := Pages[leidos].Nivel;
                      PageLowLevel := leidos
                    end;
                  if (Pages[leidos].Nivel = 0) and (not ModPages[leidos]) then
                    begin
                      LowLevel := Pages[leidos].Nivel;
                      PageLowLevel := leidos
                    end;
                end;
              if LowLevel <> $FF then
                begin
                  leidos := PageLowLevel;
                  ChangePage
                end;
            end;
    LeePage:
          if ModPages[DondeLeer] then
            WritePage( CualIndex, DondeLeer );
          if PageToLeer >= 0 then
            begin
              seek( FIndex, PageToLeer );
              BlockRead( FIndex, Pages[DondeLeer], 1 )
            end
          else
            fillchar( Pages[DondeLeer], SizeOf(RegPageIndex), 0 )
        end
    end;    { LoadPage }

    procedure ChkModFile(CualIndex:PtrIndex);
    var
      AuxHead  : RegAuxBufIndexHead; { NumKeys , NumDelKeys , FirstPage,
    LastPage }
      OfsAuxHead:word;
      Handle:word;
      HayError:byte;
    begin
      with CualIndex^ do
        if LockFileIndex(FileRec(FIndex).Handle) then
          begin
            HayError := 0;
            Handle:=FileRec(FIndex).Handle;
            OfsAuxHead:=ofs(AuxHead);

            FileRec( FIndex ).RecSize := 1;
            seek( FIndex, 0 );
            BlockRead( FIndex, AuxHead, SizeOf(RegAuxBufIndexHead) );
            FileRec( FIndex ).RecSize := SizeOf( RegPageIndex );

            if (AuxHead.NumKeys<>NumKeys) or (AuxHead.NumDelKeys<>NumDelKeys)
    then
              begin
                move( AuxHead, CualIndex^, SizeOf(RegAuxBufIndexHead) );

    fillchar(CualIndex^.Pages,SizeOf(RegPageIndex)*PagesInMemory,0);
                LoadPage( CualIndex, FirstPage, 1 );
                PageActual:=1;
                IsLockFileIndex := true
              end
          end
        else
          ErrIndex:=Lo(ErrIndex) + ErrIndexShared
    end;

    procedure IniciaIndex(CualIndex:PtrIndex; var SeDesbloquea:boolean);
    begin
      ErrIndex := Lo(ErrIndex);
      if CualIndex^.SeBloquea then
        begin
          SeDesbloquea:=not IsLockFileIndex;
          if SeDesbloquea then
            ChkModFile(CualIndex)
        end
      else
        SeDesbloquea:=false
    end;

    procedure FinalizaIndex( CualIndex:PtrIndex; SeDesbloquea:boolean );
    var
      Handle:word;
      AuxBucle:byte;
      HayError:byte;
    begin
      if CualIndex^.SeBloquea then
        with CualIndex^ do
          begin
            for AuxBucle:=1 to PagesInMemory do
              if ModPages[AuxBucle] then
                WritePage(CualIndex,AuxBucle);
            if ModPages[0] then
              begin
                HayError := 0;
                Handle:=FileRec(FIndex).Handle;

                FileRec( FIndex ).RecSize := 1;
                seek( FIndex, 0 );
                BlockWrite( FIndex, CualIndex^, SizeOf(RegAuxBufIndexHead) );
                FileRec( FIndex ).RecSize := SizeOf( RegPageIndex );
                ErrIndex := Lo(ErrIndex);
                ModPages[0]:=false
              end;
          if SeDesbloquea then
            UnLockFileIndex(FileRec(FIndex).Handle)
        end
    end;

    procedure CreateIndex(var CualIndex:PtrIndex; const NomFile:PathStr;
    CualKeyLength:byte );
    var
      AuxWord:word;
    begin
      AuxWord :=
    SizeOf(RegBufIndex)-(63-MaxPagesInMemory)*SizeOf(RegPageIndex);
      MyGetMem( pointer(CualIndex), AuxWord, 0 );
      if CualIndex = nil then
        ErrIndex:=ErrIndexNoMemory
      else
        begin
          with CualIndex^ do
            begin
              SizeCualIndex := AuxWord;
              PagesInMemory := MaxPagesInMemory;
              if (FileMode and 112) = 0 then
                SeBloquea := false
              else
                SeBloquea := ( FileMode and 112 ) <> 16 ;  { if shared }
              CualVersion := Version;
              KeyLength := CualKeyLength;
              FirstPage := 1;
              LastPage := 1;
              System.assign(FIndex,NomFile);

              rewrite( FIndex, 1 );
    {$I-}
              if IOResult<>0 then
                begin
                  ErrIndex := ErrIndexFileNoOpen;
                  MyFreeMem(pointer(CualIndex),SizeOf(RegBufIndex));
                  exit
                end;
    {$I+}
              if SeBloquea then
                LockFileIndex( FileRec(FIndex).Handle );

              Pages[2].NPage:=1;

              BlockWrite( FIndex, CualIndex^.Pages[1], SizeOf(RegPageIndex)*2
    );
              seek( FIndex, 0 );
              BlockWrite( FIndex, CualIndex^, 20 );

              Pages[1].NPage := 1;
              Pages[2].NPage := 0;

              TotKeyLength := KeyLength+4;
              MaxKeysInPage := SizeOfResto div TotKeyLength;
              if SeBloquea then
                UnLockFileIndex( FileRec(FIndex).Handle );
              close( FIndex );
              reset( FIndex, SizeOf(RegPageIndex ) )
            end;
        end
    end;

    procedure OpenIndex(var CualIndex:PtrIndex; const NomFile:PathStr );
    var
      SaveFileMode:byte;
      AuxWord:word;
    begin
      AuxWord :=
    SizeOf(RegBufIndex)-(63-MaxPagesInMemory)*SizeOf(RegPageIndex);
      MyGetMem( pointer(CualIndex), AuxWord , 0 );
      if CualIndex=nil then
        ErrIndex:=ErrIndexNoMemory
      else
        with CualIndex^ do
          begin
            SizeCualIndex := AuxWord;
            PagesInMemory := MaxPagesInMemory;
            if (FileMode and 112) = 0 then
              SeBloquea := false
            else
              SeBloquea := ( FileMode and 112 <> 16 ); { if shared }
            System.assign(FIndex,NomFile);
    {$I-}
            reset( FIndex, SizeOf(RegPageIndex) );
            if IOResult <> 0 then
              begin
                ErrIndex := ErrIndexFileNoOpen;
                MyFreeMem( pointer(CualIndex), CualIndex^.SizeCualIndex );
                exit
              end;
    {$I+}
            if SeBloquea then
              LockFileIndex( FileRec(FIndex).Handle );

            FileRec( FIndex ).RecSize := 1;
            BlockRead( FIndex, CualIndex^, 20 );  { file tail }
            FileRec( FIndex ).RecSize := SizeOf( RegPageIndex );

            TotKeyLength := KeyLength + 4;
            MaxKeysInPage := SizeOfResto div TotKeyLength;

            seek( FIndex, FirstPage );
            BlockRead( FIndex, Pages[1], 1 );
            LastPage := FileSize(FIndex) - 1;
            if SeBloquea then
              UnLockFileIndex( FileRec(FIndex).Handle )
          end
    end;

    procedure CloseIndex(var CualIndex:PtrIndex);
    var
      AuxBucle:byte;
    begin
      if FileRec(CualIndex^.FIndex).Mode = fmInOut then
        begin
          with CualIndex^ do
            begin
              for AuxBucle:=1 to PagesInMemory do
                if ModPages[AuxBucle] then
                  WritePage(CualIndex,AuxBucle);
              if CualIndex^.ModPages[0] then
                begin
                  FileRec( FIndex ).RecSize := 1;
                  seek( FIndex, 0 );
                  BlockWrite( Findex, NumKeys, SizeOf(RegAuxBufIndexHead) );
                end;
              close( FIndex );
            end;
          MyFreeMem( pointer(CualIndex), CualIndex^.SizeCualIndex );
          CualIndex:=nil
        end
    end;

    procedure InsKey(CualIndex:PtrIndex; Clave:string; RecNo:LongInt);
    var
      AuxWord,AuxBucle:word;
      AuxRecNo,AuxRecPage:LongInt;
      SeDesbloquea:boolean;
    procedure MeteKey(CualPagina:word; Donde:word; Replace:boolean; var Clave);
    var
      AuxWord:word;
    procedure ModifyPagesBefore;
    var
      BuscaPage,AuxLong:LongInt;
      SaveDonde:word;
    begin
      SaveDonde:=Donde;
      with CualIndex^ do
        begin
          while (donde = Pages[CualPagina].KeysInPage) and (CualPagina > 1) do
    { modificar p�gina(s) anterior(es) }
            begin        (***************************)
              BuscaPage := Pages[CualPagina].NPage;
              dec( CualPagina );
              donde := 0;
              AuxWord := 0;
              repeat
                move( Pages[CualPagina].resto[AuxWord], AuxLong, 4 );
                inc( donde );
                AuxWord := AuxWord + TotKeyLength
              until (Donde > Pages[CualPagina].KeysInPage) or (AuxLong =
    BuscaPage);
              if AuxLong = BuscaPage then
                begin
                  AuxWord := AuxWord-TotKeyLength;
                  move( clave, Pages[CualPagina].resto[AuxWord], TotKeyLength
    );
                  move( AuxLong, Pages[CualPagina].resto[AuxWord], 4 );
                  ModPages[CualPagina] := true
                end
            end
        end;
      Donde:=SaveDonde
    end;
    procedure PartePage;
    var
      AuxBucle:word;
      AuxClave:Char255;
    begin
      with CualIndex^ do
        begin
          LoadPage( CualIndex, -1, PagesInMemory );  (* // *)
    (*  //
          if ModPages[PagesInMemory] then
            WritePage( CualIndex, PagesInMemory );
          fillchar( Pages[PagesInMemory], SizeOf(RegPageIndex), 0 );
    //  *)
          AuxWord := TotKeyLength * ( MaxKeysInPage div 2 );
          move( Pages[CualPagina], Pages[PagesInMemory], 10 + AuxWord );
          ModPages[PagesInMemory] := true;
          ModPages[CualPagina] := true;
          GetEmptyPage( CualIndex, PagesInMemory );
          Pages[PagesInMemory].KeysInPage := MaxKeysInPage div 2;
          Pages[CualPagina].KeysInPage := MaxKeysInPage -
    Pages[PagesInMemory].KeysInPage;
          AuxWord := TotKeyLength * Pages[CualPagina].KeysInPage;
          move( Pages[CualPagina].resto[ (MaxKeysInPage div 2)*TotKeyLength ],
    Pages[CualPagina].resto[0], AuxWord );
          fillchar( Pages[CualPagina].resto[AuxWord], SizeOfResto - AuxWord, 0
    );
          if donde > Pages[PagesInMemory].KeysInPage then
            begin
              PageActual := CualPagina;
              donde := donde - Pages[PagesInMemory].KeysInPage;
            end
          else
            PageActual := PagesInMemory;
          Pages[PageActual].OfsResto := (donde-1) * TotKeyLength;
          Pages[PageActual].RecActual := donde;
          if not Replace then
            begin
              inc( Pages[PageActual].KeysInPage );
              inc( NumKeys );
              ModPages[0] := true;
              move( Pages[PageActual].resto[Pages[PageActual].OfsResto],
                    Pages[PageActual].resto[Pages[PageActual].OfsResto +
    TotKeyLength],
                    TotKeyLength*(Pages[PageActual].KeysInPage - donde));
            end;
          move( clave, Pages[PageActual].resto[Pages[PageActual].OfsResto],
    TotKeyLength );
          if CualPagina = 1 then  { make another first key page }
            begin
              if Pages[1].Nivel+1 = PagesInMemory then  { too many keys }
                begin
                  ErrIndex := ErrIndexTooManyKeys;
                  exit
                end;
              LoadPage( CualIndex, -1, PagesInMemory-1 );  (* // *)
    (* //
              WritePage( CualIndex, PagesInMemory );
              if ModPages[ PagesInMemory-1 ] then
                WritePage( CualIndex, PagesInMemory-1 );
    // *)
              for AuxBucle := PagesInMemory-1 downto 2 do
                begin
                  Pages[AuxBucle] := Pages[AuxBucle-1];
                  ModPages[AuxBucle] := ModPages[AuxBucle-1];
                end;
              fillchar( Pages[1], SizeOf(RegPageIndex), 0 );

              ModPages[1] := true;
              GetEmptyPage( CualIndex, 1 );
              Pages[1].KeysInPage := 2;
              Pages[1].Nivel := Pages[2].Nivel+1;
              move( Pages[PagesInMemory].NPage, Pages[1].resto[0], 4 );
              move(
    Pages[PagesInMemory].resto[(Pages[PagesInMemory].KeysInPage-1)*TotKeyLength+
    4],
                Pages[1].resto[4], KeyLength );
              move( Pages[2].NPage, Pages[1].resto[TotKeyLength], 4 );
              move( Pages[2].resto[(Pages[2].KeysInPage-1)*TotKeyLength+4],
    Pages[1].resto[TotKeyLength+4], KeyLength );
              FirstPage := Pages[1].NPage;
              ModPages[0] := true
            end
          else
            begin
              move(
    Pages[PagesInMemory].resto[(Pages[PagesInMemory].KeysInPage-1)*TotKeyLength]
    ,
                    AuxClave[1], TotKeyLength );
              move( Pages[PagesInMemory].NPage, AuxClave[1], 4 );
              if PageActual = PagesInMemory then
                begin
                  LoadPage( CualIndex, -1, CualPagina );  (* // *)
    (*  //
                  if ModPages[CualPagina] then
                    WritePage( CualIndex, CualPagina );
    // *)
                  Pages[CualPagina] := Pages[PagesInMemory];
                  ModPages[CualPagina] := true;
                end
              else
                begin
                  LoadPage( CualIndex, -1, PagesInMemory )  (* // *)
    (* //
                  WritePage( CualIndex, PagesInMemory );
    // *)
                end;
              fillchar( Pages[PagesInMemory], SizeOf(RegPageIndex), 0 );
              ModPages[PagesInMemory] := false;
              PageActual := CualPagina;
              if ErrIndex = ErrIndexNotFound then
                MeteKey( CualPagina-1, Pages[CualPagina-1].RecActual-1, false,
    AuxClave[1] )
              else
                MeteKey( CualPagina-1, Pages[CualPagina-1].RecActual, false,
    AuxClave[1] );
              PageActual := CualPagina;
              if ErrIndex=ErrIndexTooManyKeys then exit;
              ModifyPagesBefore
            end;
        end
    end;

    begin   { MeteKey }
      with CualIndex^ do
        begin
          if (donde > MaxKeysInPage) or ((not Replace) and
    (Pages[CualPagina].KeysInPage = MaxKeysInPage)) then
            if CualPagina < PagesInMemory then
              PartePage
            else
              ErrIndex := ErrIndexTooManyKeys
          else
            begin
              AuxWord := (donde-1)*TotKeyLength;
              if not Replace then
                move( Pages[CualPagina].Resto[AuxWord],
    Pages[CualPagina].Resto[AuxWord+TotKeyLength],
                  (Pages[CualPagina].KeysInPage+1-donde)*TotKeyLength);
              move( clave, Pages[CualPagina].resto[AuxWord], TotKeyLength );
              if not Replace then
                begin
                  inc( Pages[CualPagina].KeysInPage );
                  inc( NumKeys );
                  ModPages[0] := true;
                end;
              Pages[CualPagina].RecActual := donde;
              Pages[CualPagina].OfsResto := (donde-1)*TotKeyLength;
              ModPages[CualPagina] := true;
              ModifyPagesBefore
            end
        end
    end;    { MeteKey }

    begin  { InsKey }
      IniciaIndex( CualIndex, SeDesbloquea );
      if Hi(ErrIndex) <> 0 then exit;
      while length(Clave) < CualIndex^.KeyLength do Clave:=Clave+#0;
      FindKey( CualIndex, Clave );
      move( Clave[1],Clave[5], CualIndex^.KeyLength );
      move( RecNo, Clave[1], 4 );
      with CualIndex^ do
        begin
          if ErrIndex = ErrIndexNotFound then { clave mayor que todas las
    claves }
            begin
              PageActual := 1;
              while Pages[PageActual].Nivel <> 0 do
                begin
                  Pages[PageActual].RecActual :=
    Pages[PageActual].KeysInPage+1;
                  Pages[PageActual].OfsResto :=
    Pages[PageActual].KeysInPage*TotKeyLength;
                  move(
    Pages[PageActual].resto[TotKeyLength*(Pages[PageActual].KeysInPage-1)],
    AuxRecPage, 4 );
                  inc( PageActual );
                  LoadPage( CualIndex, AuxRecPage, PageActual );
                  if ErrIndex = ErrIndexTooManyKeys then exit;
                end;
              Pages[PageActual].RecActual := Pages[PageActual].KeysInPage+1;
              Pages[PageActual].OfsResto :=
    Pages[PageActual].KeysInPage*TotKeyLength;
              MeteKey( PageActual,Pages[PageActual].KeysInPage+1, false,
    Clave[1] )
            end
          else { if ErrIndex=ErrIndexNotFound then key more big that last key
    in file }
            begin { find key greather equal }
              MeteKey( PageActual,Pages[PageActual].RecActual, false, Clave[1]
    )
            end
        end;
      FinalizaIndex( CualIndex, SeDesbloquea );
    end;   { InsKey }

    procedure NextKey(CualIndex:PtrIndex; SearchNextNotFound:boolean);
    label
      Label01;
    var
      AuxRecPage:LongInt;
      AuxWord,WordBusca:word;
      AuxClave:Char255;
    begin
      with CualIndex^ do
        begin
          move( Pages[PageActual].resto[Pages[PageActual].OfsResto], AuxClave,
    TotKeyLength );
          if Pages[PageActual].RecActual < Pages[PageActual].KeysInPage then
            begin
              inc( Pages[PageActual].RecActual );
              inc( Pages[PageActual].OfsResto,TotKeyLength )
            end
          else
            begin
              AuxWord := PageActual;
    { $R-}
              while (Pages[PageActual].RecActual =
    Pages[PageActual].KeysInPage) and (PageActual > 1) do
                dec( PageActual );
    { $R+}
              if Pages[PageActual].RecActual = Pages[PageActual].KeysInPage
    then
                begin
                  PageActual := AuxWord;
                  ErrIndex := ErrIndexEOF;
                  exit
                end;
              inc( Pages[PageActual].OfsResto, TotKeyLength );
              inc( Pages[PageActual].RecActual );
              while Pages[PageActual].Nivel <> 0 do
                begin
                  move( Pages[PageActual].Resto[Pages[PageActual].OfsResto],
    AuxRecPage, 4 );
                  inc( PageActual );
                  LoadPage( CualIndex, AuxRecPage, PageActual );
                  if ErrIndex = ErrIndexTooManyKeys then exit;
                  Pages[PageActual].OfsResto := 0;
                  Pages[PageActual].RecActual := 1;
                end
            end;
          move( Pages[PageActual].Resto[Pages[PageActual].OfsResto], RecIndex,
    4 );
          PtrClave :=
    addr(Pages[PageActual].resto[Pages[PageActual].OfsResto+4]);
          if Equal( AuxClave[5],
    Pages[PageActual].Resto[Pages[PageActual].OfsResto+4], KeyLength) then
            ErrIndex := ErrIndexFound
          else
            if SearchNextNotFound then
              ErrIndex := ErrIndexFound
            else
              ErrIndex := ErrIndexOtherKey
        end
    end;

    procedure PrevKey(CualIndex:PtrIndex; SearchNextNotFound:boolean);
    label
      Label01;
    var
      AuxRecPage:LongInt;
      AuxWord,WordBusca:word;
      AuxClave:Char255;
    begin
      with CualIndex^ do
        begin
          move( Pages[PageActual].resto[Pages[PageActual].OfsResto], AuxClave,
    TotKeyLength );
          if Pages[PageActual].RecActual > 1 then
            begin
              dec( Pages[PageActual].RecActual );
              dec( Pages[PageActual].OfsResto, TotKeyLength )
            end
          else
            begin
              AuxWord := PageActual;
    { $R-}
              while (Pages[PageActual].RecActual = 1) and (PageActual > 1) do
                dec( PageActual );
    { $R+}
              if Pages[PageActual].RecActual = 1 then
                begin
                  PageActual := AuxWord;
                  ErrIndex := ErrIndexBOF;
                  exit
                end;
              dec( Pages[PageActual].OfsResto, TotKeyLength );
              dec( Pages[PageActual].RecActual );
              while Pages[PageActual].Nivel <> 0 do
                begin
                  move( Pages[PageActual].Resto[Pages[PageActual].OfsResto],
    AuxRecPage, 4 );
                  inc( PageActual );
                  LoadPage( CualIndex, AuxRecPage, PageActual );
                  if ErrIndex = ErrIndexTooManyKeys then exit;
                  Pages[PageActual].RecActual := Pages[PageActual].KeysInPage;
                  Pages[PageActual].OfsResto :=
    (Pages[PageActual].KeysInPage-1) * TotKeyLength
                end
            end;
          move( Pages[PageActual].Resto[Pages[PageActual].OfsResto], RecIndex,
    4 );
          PtrClave := addr(
    Pages[PageActual].resto[Pages[PageActual].OfsResto+4] );
          if Equal( AuxClave,
    Pages[PageActual].Resto[Pages[PageActual].OfsResto+4], KeyLength ) then
            ErrIndex := ErrIndexFound
          else
            if SearchNextNotFound then
              ErrIndex := ErrIndexFound
            else
              ErrIndex := ErrIndexOtherKey
        end
    end;

    procedure FindKey(CualIndex:PtrIndex; Clave:string);
    label
      H1;
    var
      AuxRecPage:LongInt;
      AuxCont:word;
      SeDesbloquea:boolean;
    function BuscaMayorIgual(var Clave, Resto; KeyLength,
    KeysInPage:word):byte; assembler;
    asm
      mov  cx,KeyLength
      mov  dx,cx
      add  dx,4            { dx = TotKeyLength }

      mov  ax,1
      mov  bx,KeysInPage

      cld
      push ds
      les  di,Clave
      lds  si,Resto
      add  si,4
    @@Bucle:
      cmp  ax,bx
      ja   @@EndXX
      push si
      push di
      push cx
      repe cmpsb
      pop  cx
      pop  di
      pop  si
      jae  @@EndXX
      add  si,dx
      inc  ax
      jmp  @@Bucle
    @@EndXX:
      pop  ds
    end;
    begin
      IniciaIndex( CualIndex, SeDesbloquea );
      if Hi(ErrIndex)<>0 then exit;
      while length(Clave) < CualIndex^.KeyLength do
        Clave := Clave+#0;
      with CualIndex^ do
        begin
          PageActual := 1;
    H1:
          Pages[PageActual].RecActual :=
    BuscaMayorIgual(Clave[1],Pages[PageActual].Resto,KeyLength,Pages[PageActual]
    .KeysInPage);
          Pages[PageActual].OfsResto := (Pages[PageActual].RecActual-1) *
    TotKeyLength;
          if Pages[PageActual].RecActual > Pages[PageActual].KeysInPage then
            ErrIndex := ErrIndexNotFound
          else
            begin
              if Pages[PageActual].Nivel <> 0 then
                begin
                  move( Pages[PageActual].Resto[Pages[PageActual].OfsResto],
    AuxRecPage, 4 );
                  inc( PageActual );
                  LoadPage( CualIndex, AuxRecPage, PageActual );
                  if ErrIndex = ErrIndexTooManyKeys then exit;
                  goto H1
                end
              else
                begin
                  if
    Equal(clave[1],Pages[PageActual].resto[Pages[PageActual].OfsResto+4],KeyLength)
                  and (Pages[PageActual].RecActual <=
    Pages[PageActual].KeysInPage) then
                    ErrIndex := ErrIndexFound
                  else
                    ErrIndex := ErrIndexBig;
                  move( Pages[PageActual].resto[Pages[PageActual].OfsResto],
    RecIndex, 4 );
                  PtrClave := addr(
    Pages[PageActual].resto[Pages[PageActual].OfsResto+4] )
                end
            end;
          if SeBloquea and SeDesbloquea then
            UnLockFileIndex( FileRec(FIndex).Handle )
        end;
    {  FinalizaIndex( CualIndex, SeDesbloquea ); }
    end;

    procedure FindKeyRecNo(CualIndex:PtrIndex; const Clave:string;
    RecNo:LongInt);
    var
      SeDesbloquea:boolean;
    begin
      IniciaIndex( CualIndex, SeDesbloquea );
      if Hi(ErrIndex) <> 0 then exit;
      FindKey( CualIndex, Clave );
      if ErrIndex = ErrIndexFound then
        with CualIndex^ do
          begin
            repeat
              move( Pages[PageActual].Resto[Pages[PageActual].OfsResto],
    RecIndex, 4 );
              if RecIndex <> RecNo then
                NextKey( CualIndex, false );
            until (ErrIndex = ErrIndexOtherKey) or (ErrIndex = ErrIndexEOF) or
    (RecIndex = RecNo);
            if (RecIndex <> RecNo) or (ErrIndex = ErrIndexEOF) or (ErrIndex =
    ErrIndexOtherKey) then
              ErrIndex := ErrIndexNotFound
          end
      else
        ErrIndex := ErrIndexNotFound;
      FinalizaIndex( CualIndex, SeDesbloquea );
    end;

    procedure DelKey(CualIndex:PtrIndex; Clave:string; RecNo:LongInt);
    label
      Label01;
    var
      AuxLong:LongInt;
      BuclePage:word;
      SavePage:word;
      SeDesbloquea:boolean;
    procedure MiraFirstPage;
    var
      AuxBuclePage:word;
    begin
      with CualIndex^ do
        if (Pages[1].KeysInPage = 1) and (Pages[1].Nivel > 0) then
          begin
            Pages[1].KeysInPage := 0;
            fillchar( Pages[1].Resto, SizeOfResto, 0 );
            Pages[1].RecActual := 0;
            Pages[1].OfsResto := 0;
            Pages[1].Nivel := 0;
            WritePage( CualIndex, 1 );
            for AuxBuclePage := 1 to PagesInMemory-1 do
              begin
                Pages[AuxBuclePage] := Pages[AuxBuclePage+1];
                ModPages[AuxBuclePage] := ModPages[AuxBuclePage+1];
              end;
            ModPages[PagesInMemory] := false;
            fillchar( Pages[PagesInMemory], SizeOf(RegPageIndex), 0 );
            FirstPage := Pages[1].NPage;
            dec( SavePage )
          end
    end;
    procedure JuntaPages;
    var
      sw:boolean;
      AuxPage:byte;
    begin
      with CualIndex^ do
        begin
          sw:=true;
          if Pages[BuclePage-1].RecActual > 0 then
            begin
              if ModPages[PagesInMemory] then
                WritePage( CualIndex, PagesInMemory );
              move(
    Pages[BuclePage-1].resto[Pages[BuclePage-1].OfsResto-TotKeyLength],AuxLong,4
    );
              LoadPage( CualIndex, AuxLong, PagesInMemory );
              if
    Pages[PagesInMemory].KeysInPage+Pages[BuclePage].KeysInPage<MaxKeysInPage
    then
                begin
                  sw:=false;
                  move( Pages[BuclePage].Resto, Pages[PagesInMemory].resto[
    Pages[PagesInMemory].KeysInPage*TotKeyLength ],
                    Pages[BuclePage].KeysInPage * TotKeyLength );
                  Pages[BuclePage].RecActual := Pages[PagesInMemory].KeysInPage
    + Pages[BuclePage].RecActual;
                  Pages[BuclePage].OfsResto :=
    (Pages[BuclePage].RecActual-1)*TotKeyLength;
                  Pages[BuclePage].KeysInPage :=
    Pages[PagesInMemory].KeysInPage +
                    Pages[BuclePage].KeysInPage;

                  Pages[BuclePage].Resto := Pages[PagesInMemory].Resto;
                  move(Pages[BuclePage-1].resto[Pages[BuclePage-1].OfsResto],

    Pages[BuclePage-1].resto[Pages[BuclePage-1].OfsResto-TotKeyLength],

    (MaxKeysInPage-Pages[BuclePage-1].RecActual+1)*TotKeyLength);
                end
            end;
         if sw and (Pages[BuclePage-1].RecActual<Pages[BuclePage-1].KeysInPage)
    then
            begin
              if ModPages[PagesInMemory] then
                WritePage( CualIndex, PagesInMemory );
              move(
    Pages[BuclePage-1].resto[Pages[BuclePage-1].OfsResto+TotKeyLength],AuxLong,4
    );
              LoadPage( CualIndex, AuxLong, PagesInMemory );
              if
    Pages[PagesInMemory].KeysInPage+Pages[BuclePage].KeysInPage<MaxKeysInPage
    then
                begin
                  sw:=false;
                  move(Pages[PagesInMemory].resto,

    Pages[BuclePage].resto[Pages[BuclePage].KeysInPage*TotKeyLength],
                    Pages[PagesInMemory].KeysInPage*TotKeyLength);
    {              Pages[BuclePage].RecActual := Pages[BuclePage].KeysInPage +
    Pages[PagesInMemory].RecActual; }
    {              Pages[BuclePage].OfsResto  :=
    Pages[BuclePage].RecActual*TotKeyLength;                      }

    inc(Pages[BuclePage].KeysInPage,Pages[PagesInMemory].KeysInPage);
                  move(
    Pages[BuclePage-1].resto[Pages[BuclePage-1].OfsResto+TotKeyLength+4],

    Pages[BuclePage-1].resto[Pages[BuclePage-1].OfsResto+4],

    (MaxKeysInPage-Pages[BuclePage-1].RecActual-1)*TotKeyLength);
                  if (Pages[BuclePage-1].RecActual+1 =
    Pages[BuclePage-1].KeysInPage) and (BuclePage > 2) then
                    begin
                      AuxPage := BuclePage-2;
                      while AuxPage >= 1 do
                        begin
                          with Pages[BuclePage-1] do
                            move( Resto[OfsResto+4],
    Pages[AuxPage].Resto[Pages[AuxPage].OfsResto+4], KeyLength );
                          dec( AuxPage )
                        end;
                    end
                end
            end;
          if not sw then
            begin
              fillchar( Pages[PagesInMemory], SizeOf(RegPageIndex), 0);
              Pages[PagesInMemory]. NPage := AuxLong;
              ModPages[PagesInMemory]:=true;
              ModPages[BuclePage]:=true;
              dec(Pages[BuclePage-1].KeysInPage);
              ModPages[BuclePage-1]:=true
            end;
        end
    end;
    begin  { DelKey }
      IniciaIndex( CualIndex, SeDesbloquea );
      if Hi(ErrIndex)<>0 then exit;
      FindKeyRecNo(CualIndex,Clave,RecNo);
      if ErrIndex=ErrIndexFound then
        with CualIndex^ do
          begin
            SavePage:=PageActual;
    Label01:
            if Pages[PageActual].KeysInPage=Pages[PageActual].RecActual then
              begin
                dec(Pages[PageActual].KeysInPage);

    fillchar(Pages[PageActual].Resto[Pages[PageActual].OfsResto],TotKeyLength,0)
    ;
                dec(Pages[PageActual].OfsResto,TotKeyLength);
                dec(Pages[PageActual].RecActual);
                ModPages[PageActual]:=true;
                { change previous pages }
                if (Pages[PageActual].KeysInPage=0) and (PageActual>1) then
                  begin
                    dec(PageActual);
                    goto Label01
                  end;
                if Pages[PageActual].KeysInPage>0 then
                  begin

    move(Pages[PageActual].resto[Pages[PageActual].OfsResto],Clave[1],TotKeyLength);
                    while (PageActual>1) and
    (Pages[PageActual].KeysInPage=Pages[PageActual].RecActual) do
                      begin

    move(Clave[5],Pages[PageActual-1].resto[Pages[PageActual-1].OfsResto+4],KeyLength);
                        ModPages[PageActual-1]:=true;
                        dec(PageActual)
                      end
                  end
              end
            else
              begin
                with Pages[PageActual] do
                  move( resto[ OfsResto + TotKeyLength ], resto[ OfsResto ],
                    ( MaxKeysInPage - RecActual ) * TotKeyLength );
                dec(Pages[PageActual].KeysInPage);
                ModPages[PageActual]:=true
              end;
            inc(NumDelKeys);
            dec(NumKeys);
            ModPages[0]:=true;
            MiraFirstPage;
            PageActual:=SavePage;
    { Comprobaci¢n de que las p�ginas se puedan juntar con la anterior o
    siguiente
      siempre y cuando KeysInPage <= MaxKeysInPage div 3 }
            for BuclePage := SavePage downto 2 do
              if Pages[BuclePage].KeysInPage > 0 then
                begin
                  if (Pages[BuclePage].KeysInPage<=(MaxKeysInPage div 3)) then
                    JuntaPages
                end
              else
                begin
    { P�gina vac¡a }
                end;
            MiraFirstPage
          end
      else
        ErrIndex:=ErrIndexNotFound;
      FinalizaIndex( CualIndex, SeDesbloquea );
    end;  { DelKey }

    procedure ReplaceKey(CualIndex:PtrIndex; const OldClave,NewClave:string;
    RecNo:LongInt);
    var
      SeDesbloquea:boolean;
    begin
      IniciaIndex( CualIndex, SeDesbloquea );
      if Hi(ErrIndex)<>0 then exit;
      DelKey(CualIndex,OldClave,RecNo);
      if ErrIndex=ErrIndexFound then
        InsKey(CualIndex,NewClave,RecNo)
      else
        ErrIndex:=ErrIndexNotFound;
      FinalizaIndex( CualIndex, SeDesbloquea )
    end;

    procedure FindFirstKey(CualIndex:PtrIndex);
    var
      AuxClave:string;
    begin
      fillchar(AuxClave,SizeOf(AuxClave),0);
      AuxClave[0]:=char(CualIndex^.KeyLength);
      FindKey(CualIndex,AuxClave);
      if (Lo(ErrIndex)=ErrIndexBig) or (ErrIndex=0) then
        ErrIndex := ErrIndexFound
      else
        ErrIndex := ErrIndexNoKeys
    end;

    procedure FindLastKey(CualIndex:PtrIndex);
    var
      AuxLong:LongInt;
      SeDesbloquea:boolean;
    begin
      IniciaIndex( CualIndex, SeDesbloquea );
      if Hi(ErrIndex)<>0 then exit;
      with CualIndex^ do
        begin
          if Pages[1].KeysInPage > 0 then
            begin
              PageActual := 1;
              while Pages[PageActual].Nivel <> 0 do
                begin
                  move(
    Pages[PageActual].resto[(Pages[PageActual].KeysInPage-1)*TotKeyLength],AuxLong,4);
                  inc( PageActual );
                  LoadPage( CualIndex, AuxLong, PageActual );
                end;
              Pages[PageActual].RecActual := Pages[PageActual].KeysInPage;
              Pages[PageActual].OfsResto :=
    (Pages[PageActual].RecActual-1)*TotKeyLength;

    move(Pages[PageActual].resto[Pages[PageActual].OfsResto],RecIndex,4);

    PtrClave:=addr(Pages[PageActual].resto[Pages[PageActual].OfsResto+4]);
              ErrIndex := ErrIndexFound
            end
          else
            ErrIndex := ErrIndexNoKeys
        end;
      FinalizaIndex( CualIndex, SeDesbloquea )
    end;

    end.

    { ----------------------------  DEMO -------------------- }
    { CUT }

    {
       SwagIndex Demo.

       First, excuse me, I don't speak english.

       There are two index file for one file data
         -The first index is the field Numero (one data rec => one key)
         -The second index is the field Nombre1 and Nombre2 if not empty
          (one data rec => one or two keys).

    }
    uses
      crt,dos,SwagIdx;
    type
      RegData = record
        Numero:integer;
        Nombre1,Nombre2:string[25];
        telefono:string[12]
      end;
    var
      FData:file of RegData;
      RData:RegData;
      IndexDataNumero,IndexDataNombre,AuxIndex:PtrIndex;
      ch,CualClave,CualOrden:char;
      CadBusca:string;
      swWriteCab:boolean;

    procedure WriteError;
    begin
      case ErrIndex and $00FF of
        ErrIndexNotFound  : writeln( 'Key not found' );
        ErrIndexBig       : writeln( 'Key not found, big exist');
        ErrIndexEOF       : writeln( 'End of index file, no more keys' );
        ErrIndexBOF       : writeln( 'Begin of index file' );
        ErrIndexOtherKey  : writeln( 'It''s another key' );
        ErrIndexNoKeys    : writeln( 'No keys in index file' );
      end;
      case (ErrIndex and $FF00) of
        ErrIndexShared     : writeln( 'Sharing mode error');
        ErrIndexRead       : writeln( 'Read error');
        ErrIndexWrite      : writeln( 'Write error');
        ErrIndexFileNoOpen : writeln( 'Index file not open' );
      end;
      case ErrIndex of
        ErrIndexNoMemory    : writeln( 'Not enaught memory' );
        ErrIndexTooManyKeys : writeln( 'Too many keys in file' )
      end
    end;

    procedure InsRec( Numero:integer; const Nombre1,Nombre2,Telefono:string);
    var
      AuxClave : char2;
    begin
      IntegerToKey( Numero, AuxClave );
      InsKey( IndexDataNombre, Nombre1 , FileSize(FData) );
      if Nombre2 <> '' then { if there is a second name ... }
        InsKey( IndexDataNombre, Nombre2 , FileSize(FData) );
      InsKey( IndexDataNumero, AuxClave, FileSize(FData) );
      RData.Numero := Numero;
      RData.Nombre1 := Nombre1;
      RData.Nombre2 := Nombre2;
      RData.Telefono := Telefono;
      seek(FData,FileSize(FData));
      write(FData,RData);
    end;

    procedure ShowRec;
    procedure WriteCab;
    begin
      swWriteCab:=true;
      writeln(' Rec   Num.          Name 1                    Name 2
       Telephon');
      writeln('----- ----- --------------------------
    -------------------------- ------------')
    end;
    begin   { ShowRec }
      if not swWriteCab then WriteCab;
      seek(FData,RecIndex);
      read(FData,RData);
      writeln( RecIndex:5, RData.Numero:6,'
    ',RData.Nombre1,'':27-length(RData.Nombre1),RData.Nombre2,'':27-length(RData
    .Nombre2),
        RData.Telefono);
    end;    { ShowRec }

    procedure MakeFile;
    begin
      if FileRec(FData).Mode = fmInOut then
        begin
          writeln( 'File already open');
          exit
        end;
      rewrite(FData);
      CreateIndex( IndexDataNombre, 'SWAGNDC.NOM',30 );
      CreateIndex( IndexDataNumero, 'SWAGNDC.NUM', 2 );
      InsRec( 1245,'PEPITO PEREZ','JOSEFA PEREZ','12354'  );
      InsRec( 1313,'PEPITO LOPEZ','','91-13123123' );
      InsRec(  245,'OTRO PEPITO','','959-12354' );
      InsRec(  145,'FULANITO DE TAL','MENGANITA','9912354' );
      InsRec(  -12,'TAL Y TAL','GIL','1544254' );
      InsRec( 1435,'TAL Y PASCUAL','MARAGALL','07505505505' );

    { y ya me he cansado }
    end;

    procedure LeeFile;
    begin
      if FileRec(FData).Mode = fmInOut then
        begin
          writeln( 'File already open');
          exit
        end;
    {$I-}
      reset(FData);
      if IOResult <> 0 then
    {$I+}
        begin
          writeln( 'Open data file error');
          exit
        end;
      OpenIndex( IndexDataNombre, 'SWAGNDC.NOM' );
      OpenIndex( IndexDataNumero, 'SWAGNDC.NUM' )
    end;

    procedure Informa;
    begin
      writeln( FileSize(FData):5,' recs. in file data' );
      writeln( IndexDataNumero^.NumKeys:5,' keys in number''s index file and ',
        IndexDataNumero^.NumDelKeys:5,' deleted keys');
      writeln( IndexDataNombre^.NumKeys:5,' keys in name''s index file and   ',
        IndexDataNombre^.NumDelKeys:5,' deleted keys');
    end;

    procedure MuestraRecs;
    begin
      if CualOrden = 'A' then
        begin
          FindFirstKey( AuxIndex );
          if ErrIndex=ErrIndexNoKeys then
            WriteError
          else
            while ErrIndex <> ErrIndexEOF do
              begin
                ShowRec;
                NextKey( AuxIndex, true )
             end
        end
      else
        begin
          FindLastKey( AuxIndex );
          if ErrIndex=ErrIndexNoKeys then
            WriteError
          else
            while ErrIndex <> ErrIndexBOF do
              begin
                ShowRec;
                PrevKey( AuxIndex, true )
              end;
        end
    end;

    procedure BuscaClave;
    var
      AuxInt:integer;
      AuxChar2:char2;
    begin
      write('Key to find: ');
      if CualClave = '2' then
        readln(CadBusca)
      else
        begin
          readln(AuxInt);
          IntegerToKey( AuxInt, AuxChar2 );
          CadBusca := AuxChar2
        end;
      FindKey( AuxIndex, CadBusca );
      if ErrIndex = ErrIndexFound then
        ShowRec
      else
        WriteError
    end;

    procedure BuscaGenerica;
    var
      AuxChar2:char2;
      AuxInt:integer;
    begin
      write('Key to find: ');
      if CualClave = '2' then
        readln(CadBusca)
      else
        begin
          readln(AuxInt);
          IntegerToKey( AuxInt, AuxChar2 );
          CadBusca := AuxChar2
        end;
      FindKey( IndexDataNombre, CadBusca );
      while (ErrIndex = ErrIndexFound) or (ErrIndex=ErrIndexBig) do
        begin
          if Equal( IndexDataNombre^.PtrClave^, CadBusca[1], length(CadBusca) )
    then
            begin
              ShowRec;
              NextKey( IndexDataNombre, true )
            end
          else
            break
        end
    end;

    procedure BorraClave;
    begin
      if (ErrIndex = 0) or (ErrIndex = ErrIndexBig) or (ErrIndex =
    ErrIndexOtherKey) then
        begin
          CadBusca[0] := char(AuxIndex^.KeyLength);
          move( AuxIndex^.PtrClave^, CadBusca[1], byte(CadBusca[0]) );
          DelKey( AuxIndex, CadBusca, RecIndex );
          if ErrIndex <> 0 then WriteError
        end
    end;

    procedure MeteRec;
    var
      AuxInt:integer;
      AuxNombre1,AuxNombre2:string[25];
      AuxTelefono:string[12];
    begin
      write('Number: '); readln(AuxInt);
      write('Name 1 : '); readln(AuxNombre1);
      write('Name 2 : '); readln(AuxNombre2);
      write('Telephon: '); readln(AuxTelefono);
      InsRec( AuxInt, AuxNombre1, AuxNombre2, AuxTelefono )
    end;

    begin
      assign( FData,'SWAGNDC.D');
      repeat
        swWriteCab:=false;
        ClrScr;
        writeln( '0.- Create file' );
        writeln( '1.- Read file' );
        writeln( 'A.- About files' );
        writeln( 'B.- Show recs' );
        writeln( 'C.- Find Key' );
        writeln( 'D.- Find generic key (only names)' );
        writeln( 'E.- Delete last found key' );
        writeln( 'F.- Find next' );
        writeln( 'G.- Find prev' );
        writeln( 'H.- Find smallest key' );
        writeln( 'I.- Find biggest key' );
        writeln( 'J.- Add rec' );
        writeln( 'Z.- End' );
        writeln;
        write( 'Option 0,A-I,Z: ' );
        ch := UpCase(ReadKey);
        writeln( ch );
        writeln;
        if ch = 'Z' then break;
        if (ch in ['A'..'J']) and (FileRec(FData).Mode <> fmInOut) then
          begin
            writeln( 'Must read o create index file first' );
            ch := #0
          end;
        if (ch >='B') and (ch <= 'I') then
          begin
            if (ch <> 'D') and (ch <> 'E') then
              begin
                write( 'Key (1=Numbers, 2=Names) : ');
                CualClave := ReadKey;
                writeln( CualClave )
              end
            else
              if ch = 'D' then
                CualClave := '2';
            if (CualClave <> '1') and (CualClave <> '2') then
    	  ch := #0
            else
              begin
                if CualClave = '1' then
    	      AuxIndex := IndexDataNumero
    	    else
    	      AuxIndex := IndexDataNombre;
                if ch = 'B' then
                  begin
                    write('Orden Ascendente o Descendente (A/D): ');
                    CualOrden := UpCase(ReadKey);
                    writeln(CualOrden)
                  end
              end
          end;
        case ch of
          '0':MakeFile;
          '1':LeeFile;
          'A':Informa;
          'B':MuestraRecs;
          'C':BuscaClave;
          'D':BuscaGenerica;
          'E':BorraClave;
          'F':begin
                NextKey( AuxIndex, true );
                if ErrIndex = 0 then ShowRec else WriteError
              end;
          'G':begin
                PrevKey( AuxIndex, true );
                if ErrIndex = 0 then ShowRec else WriteError
              end;
          'H':begin
                FindFirstKey( AuxIndex );
                if ErrIndex = ErrIndexFound then
                  ShowRec
                else
                  WriteError
              end;
          'I':begin
                FindLastKey( AuxIndex );
                if ErrIndex = ErrIndexFound then
                  ShowRec
                else
                  WriteError
              end;
           'J':MeteRec
        end;
        writeln;
        write('Press Enter ...'); readln;
      until false;
      if FileRec(FData).Mode = fmInOut then
        begin
          close(FData);
          CloseIndex( IndexDataNumero );
          CloseIndex( IndexDataNombre )
        end
    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]