[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]