Советы по Delphi



Работа с индексами Clipper'а - часть 3


/p>

Файл NtxRO.pas

unit NtxRO;

interface

uses
Classes;

type TBuf=array[0..1023]of Byte;
PBuf=^TBuf;TTraceRec=classpublicpg:integer;cn:SmallInt;constructor Create(p:integer;c:SmallInt);end;TNtxRO=classprotectedfs:string[10];empty:integer;csize:integer;rc:integer; {Текущий номер записи}tr:TList; {Стек загруженных страниц}h:integer; {Дескриптор файла}isz:Word; {Размер элемента}ksz:Word; {Размер ключа}max:Word; {Максимальное кол-во элементов}hlf:Word; {Половина страницы}function GetRoot:integer; {Указатель на корень}function GetEmpty:integer; {Пустая страница}function GetSize:integer; {Возвращает размер файла}function GetCount(p:PBuf):Word; {Число элементов на странице}function Changed:boolean; virtual;procedure Clear;function Load(n:integer):PBuf;function Pop:PBuf;function Seek(const s:ShortString;fl:boolean):boolean;function Skip:PBuf;function GetItem(p:PBuf):PBuf;function GetLink(p:PBuf):integer;publicError:boolean;DosFl:boolean;constructor Open(nm:ShortString);destructor Destroy; override;function Find(const s:ShortString):boolean;function GetString(p:PBuf;c:SmallInt):ShortString;function GetRecN(p:PBuf):integer;function Next:PBuf;end;
function GetPage(h,fs:integer):PBuf;
procedure FreeHandle(h:integer);
function DosToWin(const ss:ShortString):ShortString;
function WinToDos(const ss:ShortString):ShortString;

implementation

uses
Windows, SysUtils;

const MaxPgs=5;
var Buf:array[1..1024*MaxPgs]of char;
Cache:array[1..MaxPgs]of recordHandle:integer; {0-страница свободна}Offset:integer; { смещение в файле}Countr:integer; { счетчик использования}Length:SmallInt;end;
function TNtxRO.Next:PBuf;
var cr:integer;
p:PBuf;begin
if
h<=0 thenbeginResult:=nil;exit;end;while Changed dobegincr:=rc;Find(fs);while cr>0 dobeginp:=Skip;if GetRecN(p)=cr then break;end;end;Result:=Skip;end;

function TNtxRO.Skip:PBuf;
var cnt:boolean;
p,r:PBuf;n:integer;begin r:=nil;
cnt:=True;with tr dobeginp:=GetPage(h,(TTraceRec(Items[Count-1])).pg);while cnt dobegin cnt:=False;if (TTraceRec(Items[Count-1])).cn>GetCount(p)+1 thenbeginif Count<=1 thenbeginResult:=nil;exit;end;p:=Pop;endelsewhile True dobeginr:=GetItem(p);n:=GetLink(r);if n=0 then break;p:=Load(n);end;if (TTraceRec(Items[Count-1])).cn>=GetCount(p)+1 then cnt:=Trueelse r:=GetItem(p);Inc((TTraceRec(Items[Count-1])).cn);end;end;if r<>nil thenbeginrc:=GetRecN(r);fs:=GetString(r,length(fs));end;Result:=r;end;

function TNtxRO.GetItem(p:PBuf):PBuf;
var r:PBuf;
begin
with
TTraceRec(tr.items[tr.Count-1]) dor:=PBuf(@(p^[cn*2]));r:=PBuf(@(p^[GetCount(r)]));Result:=r;end;

function TNtxRO.GetString(p:PBuf;c:SmallInt):ShortString;
var i:integer;
r:ShortString;begin r:='';
if c=0 then c:=ksz;for i:=0 to c-1 dor:=r+chr(p^[8+i]);if DosFl then r:=DosToWin(r);Result:=r;end;

function TNtxRO.GetLink(p:PBuf):integer;
var i,r:integer;
begin r:=0;
for i:=3 downto 0 dor:=r*256+p^[i];Result:=r;end;

function TNtxRO.GetRecN(p:PBuf):integer;
var i,r:integer;
begin r:=0;
for i:=3 downto 0 dor:=r*256+p^[i+4];Result:=r;end;

function TNtxRO.GetCount(p:PBuf):Word;
begin
Result:=p^[1]*256+p^[0];end;

function TNtxRO.Seek(const s:ShortString;fl:boolean):boolean;
var r:boolean;
p,q:PBuf;nx:integer;begin r:=False;
with TTraceRec(tr.items[tr.Count-1]) dobeginp:=GetPage(h,pg);while cn<=GetCount(p)+1 dobeginq:=GetItem(p);if (cn>GetCount(p))or(s<GetString(q,length(s))) or(fl and (s=GetString(q,length(s)))) thenbeginnx:=GetLink(q);if nx<>0 thenbeginLoad(nx);r:=Seek(s,fl);end;Result:=r or (s=GetString(q,length(s)));exit;end;Inc(cn);end;end;Result:=False;end;

function TNtxRO.Find(const s:ShortString):boolean;
var r:boolean;
begin
if
h<=0 thenbeginResult:=False;exit;end;rc:=0;csize:=0;r:=False;while Changed dobeginClear;Load(GetRoot);if length(s)>10 then fs:=Copy(s,1,10)else fs:=s;R:=Seek(s,True);end;Result:=r;end;

function TNtxRO.Load(N:integer):PBuf;
var it:TTraceRec;
r:PBuf;begin r:=nil;
if h>0 thenbeginwith tr dobeginit:=TTraceRec.Create(N,1);Add(it);end;r:=GetPage(h,N);end;Result:=r;end;

procedure TNtxRO.Clear;
var it:TTraceRec;
begin
while
tr.Count>0 dobeginit:=TTraceRec(tr.Items[0]);tr.Delete(0);it.Free;end;end;

function TNtxRO.Pop:PBuf;
var r:PBuf;
it:TTraceRec;begin r:=nil;
with tr doif Count>1 thenbeginit:=TTraceRec(Items[Count-1]);Delete(Count-1);it.Free;it:=TTraceRec(Items[Count-1]);r:=GetPage(h,it.pg)end;Result:=r;end;

function TNtxRO.Changed:boolean;
var i:integer;
r:boolean;begin r:=False;
if h>0 thenbegini:=GetEmpty;if i<>empty then r:=True;empty:=i;i:=GetSize;if i<>csize then r:=True;csize:=i;end;Result:=r;end;

constructor TNtxRO.Open(nm:ShortString);
begin
Error:=False;h:=FileOpen(nm,fmOpenRead or fmShareDenyNone);if h>0 thenbeginfs:='';FileSeek(h,12,0);FileRead(h,isz,2);FileSeek(h,14,0);FileRead(h,ksz,2);FileSeek(h,18,0);FileRead(h,max,2);FileSeek(h,20,0);FileRead(h,hlf,2);empty:=-1;csize:=-1;DosFl:=True;tr:=TList.Create;end else Error:=True;end;

destructor TNtxRO.Destroy;
begin
if
h>0 thenbeginFileClose(h);Clear;tr.Free;FreeHandle(h);end;inherited Destroy;end;

function TNtxRO.GetRoot:integer;
var r:integer;
begin r:=-1;
if h>0 thenbeginFileSeek(h,4,0);FileRead(h,r,4);end;Result:=r;end;

function TNtxRO.GetEmpty:integer;
var r:integer;
begin r:=-1;
if h>0 thenbeginFileSeek(h,8,0);FileRead(h,r,4);end;Result:=r;end;

function TNtxRO.GetSize:integer;
var r:integer;
begin r:=0;
if h>0 then r:=FileSeek(h,0,2);Result:=r;end;

constructor TTraceRec.Create(p:integer;c:SmallInt);
begin
pg:=p;cn:=c;end;

function GetPage(h,fs:integer):PBuf; {Протестировать отдельно}
var i,j,mn:integer;
q:PBuf;begin
mn:=10000; j:=0;for i:=1 to MaxPgs doif (Cache[i].Handle=h) and(Cache[i].Offset=fs) thenbeginj:=i;if Cache[i].Countr<10000 thenInc(Cache[i].Countr);end;if j=0 thenbeginfor i:=1 to MaxPgs doif Cache[i].Handle=0 then j:=i;if j=0 thenfor i:=1 to MaxPgs doif Cache[i].Countr<=mn thenbeginmn:=Cache[i].Countr;j:=i;end;Cache[j].Countr:=0;mn:=0;end;q:=PBuf(@(Buf[(j-1)*1024+1]));if mn=0 thenbeginFileSeek(h,fs,0);Cache[j].Length:=FileRead(h,q^,1024);end;Cache[j].Handle:=h;Cache[j].Offset:=fs;Result:=q;end;

procedure FreeHandle(h:integer);
var i:integer;
begin
for
i:=1 to MaxPgs doif Cache[i].Handle=h thenCache[i].Handle:=0;end;

function DosToWin(const ss:ShortString):ShortString;
var r:ShortString;
i:integer;begin r:='';
for i:=1 to length(ss) doif ss[i] in [chr($80)..chr($9F)] then r:=r+chr(ord(ss[i])-$80+$C0)else if ss[i] in [chr($A0)..chr($AF)] then r:=r+chr(ord(ss[i])-$A0+$C0)else if ss[i] in [chr($E0)..chr($EF)] then r:=r+chr(ord(ss[i])-$E0+$D0)else if ss[i] in [chr($61)..chr($7A)] then r:=r+chr(ord(ss[i])-$61+$41)else if ss[i] in [chr($F0)..chr($F1)] then r:=r+chr($C5)else r:=r+ss[i];Result:=r;end;
function WinToDos(const ss:ShortString):ShortString;
var r:ShortString;
i:integer;begin r:='';
for i:=1 to length(ss) doif ss[i] in [chr($C0)..chr($DF)] then r:=r+chr(ord(ss[i])-$C0+$80)else if ss[i] in [chr($E0)..chr($FF)] then r:=r+chr(ord(ss[i])-$E0+$80)else if ss[i] in [chr($F0)..chr($FF)] then r:=r+chr(ord(ss[i])-$F0+$90)else if ss[i] in [chr($61)..chr($7A)] then r:=r+chr(ord(ss[i])-$61+$41)else if ss[i] in [chr($D5), chr($C5)] then r:=r+chr($F0)else r:=r+ss[i];Result:=r;end;

end.

[000975]




Содержание  Назад