www.pudn.com > GOOGLE.rar > 2_5.pas, change:2002-01-14,size:10363b


type 
	TaaRecordStreamCache = class(TaaRecordStream) 
	private 
		FCache : TList; 
		FLRU   : integer; 
	protected 
		procedure rscDestroyCache; 
		procedure rscCreateCache(aCacheSize : integer); 
		function  rscGetNextLRU : integer; 
	public 
		constructor Create(aStream : TStream; aCreateNew : boolean; 
			aRecLen : integer; aCaCheSize : integer); 
		constructor CreateFile(const aFileName : string; 
			aCreateNew : boolean; aRecLen : integer; 
			aCacheSize : integer); 
		destructor Destroy : override; 
		function  Add(const aRec) : integer; override; 
		procedure Delete(aRecNum : integer); override; 
		function  Read(aRecNum : integer; var aRec) : boolean;override; 
		procedure Write(aRecNum : integer; var aRec);override; 
	end; 
type 
	TCacheFlag = ( 			{possible cache item attributes...} 
		cfCacheRecUnused,	{..item is unused} 
		cfCacheRecClean,	{..record read, but unchanged} 
		cfCacheRecDirty,	{..record should be written} 
		cfCacheDelete );	{..record should be deleted} 
	PCacheItem = ^TCacheItem; 
	TCacheItem = packed record 
		ciRecNum : integer; 
		ciRecord : PChar; 
		ciLRU    : integer; 
		ciFlag   : TCacheFlag; 
	end; 
 
constructor TaaRecordStreamCache.Create(aStream : TStream; 
	aCreateNew : boolean; aRecLen : integer; aCacheSize : integer); 
begin 
	{create the ancestor} 
	inherited Create(aStream , aCreateNew , aRecLen); 
	{create the record cache} 
	rscCreateCache(aCacheSize); 
end; 
 
constructor TaaRecordStreamCache.CreateFile(const aFileName : string; 
	aCreateNew : boolean; aRecLen : integer; aCacheSize : integer); 
begin 
	{create the ancestor} 
	inherited CreateFile(aFileName , aCreateNew , aRecLen); 
	{create the record cache} 
	rscCreateCache(aCacheSize); 
end; 
 
destructor TaaRecordStreamCache.Destroy; 
begin 
	{if cache exists, flush any remaining pages to the stream} 
	if (FCache <> nil) then 
		rscDestroyCache; 
	{destroy the ancestor} 
	inherited Destroy; 
end; 
 
function TaaRecordStreamCache.Add(const aRec) : integer; 
var 
	i 	   : integer; 
	Item       : PCacheItem; 
	MinLRU	   : integer; 
	MinLRYItem : integer; 
begin 
	{we'll be looking for a deleted item so we can reuse it, 
		if there are no deleted records, we'll reuse the least  
		recently used item instead; initialize for the loop} 
	MinLRU := MaxLongInt; 
	MinLRUItem := 0; 
	{find a deleted record in the cache} 
	for i := 0 to pred(FCache.Count) do begin 
		{get the item} 
		Item := PCacheItem(FCache.List^[i]); 
		{if the item is deleted...} 
		if (Item^.ciFlag = cfCacheRecDelete) then begin 
			{copy the record over} 
			Move(aRec , Item^.ciRecord^ , RecordLength); 
			{mark the item} 
			Item^.ciFlag := cfCacheRecDirty; 
			Item^.ciLRU := rscGetNextLRU; 
			{return the reused record number} 
			Result := Item^.ciRecNum; 
			{we're done} 
			Exit; 
		end; 
		{check for the least recently used item} 
		if (Item^.ciLRU < MinLRU) then begin 
			MinLRU := Item^.ciLRU; 
			MinLRUItem := 1; 
		end; 
	end; 
	{if we reach this point, there were no deleted items in the cache; 
	however, during the search we made a note of the least recently used 
	item so we'll reuse it} 
	{get the least recently item} 
	Item := PCacheItem(FCache.List^[MinLRUItem]); 
	{if it indicates that the record must be written, do so} 
	if (Item^.ciFlag = cfCacheRecDirty) then 
		inherited Write(Item^.ciRecNum, Item^.ciRecord^); 
	{add the new record to the stream} 
	Result := inherited Add(aRec); 
	{set the cache item to our record} 
	Item^.ciRecNum := Result; 
	Move(aRec , Item^.ciRecord^ , RecordLength); 
	Item^.ciFlag := cfCacheRecClean; 
	Item^.ciLRU := rscGetNextLRU; 
end; 
 
procedure TaaRecordStreamCache.Delete(aRecNum : integer); 
var 
	i     : integer; 
	Item  : PCacheItem; 
begin 
	{find the record number in the cache} 
	for i := 0 to pred(FCache.Count) do begin 
		{get the item} 
		Item := PCacheItem(FCache.List^[i]); 
		{if the item is the record we want...} 
		if (Item^.ciRecNum = aRecNum) then begin 
			{validation check} 
			Assert(Item^.ciFlag <> cfCacheRecUnused) and 
				(Item^.ciFlag <> cfCacheRecDelete), 
				'TaaRecordStreamCache : found Item with invalid ' +  
				'flag in cache'); 
			{mark the item as to be deleted} 
			Item^.ciFlag := cfCacheRecDelete; 
			{we're done} 
			Exit; 
		end; 
	end; 
	{if we reach this point, the item is not present in the cache; 
		so instead we'll delete it directly from the stream} 
	inherited Delete(aRecNum); 
end; 
 
function TaaRecordStreamCache.Read(aRecNum : integer; 
	var aRec) : boolean; 
var 
	i          : integer; 
	Item       : PCacheItem; 
	MinLRU     : integer; 
	MinLRUItem : integer; 
begin 
	{we're going to search for the least recently used item in 
		the cache just in case; initialize the variables for that} 
	MinLRU := MacLongInt; 
	MinLRUItem := 0; 
	{find the record number in the cache} 
	for i := 0 to pred(FCache.Count) do begin 
		{get the item} 
		Item := PCacheItem(FCache.List^[i]); 
		{if the item is the record we want...} 
		if (Item^.ciRecNum = aRecNum) then begin 
			{validation check} 
			Assert(Item^.ciFlag <> cfCacheRecUnused) and 
				(Item^.ciFlag <> cfCacheRecDelete), 
				'TaaRecordStreamCache.Read : found Item with ' +  
				'invalid flag in cache'); 
			{return whether the record is active ot not} 
			Result := (Item^.ciFlag <> cfCacheRecDelete); 
			{get the record and update the cache , if required} 
			if Result then begin 
				Move(Item^.ciRecord^ , aRec , RecordLength); 
				Item^.ciLRU := rscGetNextLRU; 
			end; 
			{we're done} 
			Exit; 
		end; 
		{check for the least recently used item} 
		if (Item^.ciLRU < MinLRU) then begin 
			MinLRU := Item^.ciLRU; 
			MinLRUItem := i; 
		end; 
	end; 
	{if we reach this point, the item is not present in the cache; 
		howeverm, during the search we made a note of the 
		least recently used item so we'll reuse it} 
	{get the least recently item} 
	Item := PCacheItem(FCache.List^[MinLRUItem]); 
	{if it indicates that the record must be written or delete, do so} 
	if (Item^.ciFlag = cfCacheRecDirty) then 
		inherited Write(Item^.ciRecNum, Item^.ciRecord^) 
	{if the item indicates that the record needs to be delete, do it} 
	else if (Item^.ciflag = cfCacherecDelete) then 
		Inherited Delete(Item^.ciRecNum); 
	{read the record from the stream} 
	Result := inherited Read(aRecNum , aRec); 
	{if the record was read (ie, wasn't deleted) set the cache item to 
		our record} 
	if Result then begin 
		Item^.ciRecNum := aRecNum; 
		Move(aRec , Item^.ciRecord^ , RecordLength ); 
		Item^.ciFlag := cfCacheRecClean; 
		Item^.CiLRU := rscGetNextLRU; 
	end 
	{otherwise, set the cache item to unused} 
	else begin 
		Item^.ciRecNum := cUnuseRecord; 
		Item^.ciFlag := cfCacheUnused; 
		Item^.ciLRU := 0; 
	end; 
end; 
 
procedure TaaRecordStreamCache.rscCreateCache( aCacheSize : integer); 
var 
	i    : integer; 
	item : PCacheItem; 
begin 
	{the cache is a list of simple records, each record having a  
		record number, a pointer to the record, and a flag 
		detailing information about the record (unused, clean, 
		dirty, to be deleted)} 
	Assert(aCacheSize > 0, 
		'TaaRecordStreamCache.rscCreateCache: the cache size ' + 
		'should be greater than zero'); 
	{create the cache} 
	FCache := TList.Create; 
	(fill the cache with unused items) 
	for i := 0 to pred(aCacheSzie) do begin 
		New(Item); 
		Item^.ciRecNum := cUnusedRecord; 
		GetMem(Item^.ciRecord, RecordLength); 
		Item^.ciFlag := cfCacheUnused; 
		Item.ciLRU := 0; 
		FCache.Add(Item); 
	end; 
end; 
 
procedure TaaRecordStreamCache.rscDestroyCache; 
var 
	i    : integer; 
	Item : PCacheItem; 
begin 
	{for each item in the cache...} 
	for i := to pred(FCache.Count) do begin 
		{get the item} 
		Item := PCacheItem(FCache.List^[i]); 
		{if the item is dirty, write the data to the stream} 
		if (Item^.ciFlag = cfCacheRecDirty) then 
			inherited Write(Item^.ciRecNum , Item^.ciRecord^) 
		{if the item indicates that the record needs to be 
			deleted, do it} 
		else if (Item^.ciFlag = cfCacheRecDelete) then 
			inherited Delete(Item^.ciRecNum); 
		{free the item} 
		FreeMem(Item^.ciRecord, RecordLength); 
		Dispose(Item); 
	end; 
	{now all the data has benn flushed and all cache items 
		deallocated, free the cache} 
	FCache.Free; 
end; 
 
function TaaRecordStreamCache.rscgetNextLRU : integer; 
var 
	i    : integer; 
	item : PCacheItem; 
begin 
	{if the maximum LRU value has benn reached, reset all LRU values 
		in the cache and then set the overal LRU to zero} 
	if (FLRU = MaxLongInt) then begin 
		for i := 0 to pred(FCache.Count) do begin 
			Item := PCacheItem(FCache.List^[i]); 
			Item^.ciLRU := 0; 
		end; 
		FLRU := 0; 
	end; 
	{return the next LRU} 
	inc(FLRU); 
	Result := FLRU; 
end; 
 
procedure TaaRecordStreamCache.Write(aRecNum : integer; var aRec); 
var 
	i          : integer; 
	Item       : PCacheItem; 
	MinLRU     : integer; 
	MinLRUItem : integer; 
begin 
	{we're going to search for the least recently used item in the cache 
		just in case; initialize the variables for that} 
	MinLRU := MaxLongInt; 
	MinLRUItem := 0; 
	{find the record number in the cache} 
	for i := 0 to pred(FCache.Cout) do begin 
		{get the item} 
		Item := PCacheItem(FCache.List^[i]); 
		{if the item is the record we want...} 
		if (Item^.ciRecNum = aRecnum) then begin 
			{validation check} 
			Assert(Item^.ciFlag <> cfCacheRecUnused) and 
				(Item^.ciFlag <> cfCacheRecDelete), 
				'TaaRecordStreamCache.Write : found Item with ' +  
				'invalid flag in cache'); 
			{copy the record over} 
		Move(aRec , Item^.ciRecord^. RecordLength); 
		{mark the item} 
		Item^.ciFlag := cfCacheRecDirty; 
		Item^.ciLRU := rscGetNextLRU; 
		{we're done} 
		Exit; 
		{check for the least recently used item} 
		if (Item^.ciLRU < MinLRU) then begin 
			MinLRU := Item^.ciLRU; 
			MinLRUItem := 1; 
		end; 
	end; 
	{if we reach this point, the item is not present in the cache; 
		however, during the search we made a note of the least 
		recently used item so we'll reuse it} 
	{get the least recently item} 
	Item := PCacheItem(FCache.List^[MinLRUItem]); 
	{if it indicates that the record must be written or deleted, do so} 
	if (Item^.ciflsg = cfCacheRecDirty) then 
		inherited Delete(Item^.ciRecNum); 
	{set the item to our record} 
	Item^.ciRecNum := aRecNum; 
	Move(aRec , Item^.ciRecord^ , RecordLength); 
	Item^.ciFlag := cfCacheRecDirty; 
	Item^.ciLRU := rscGetNextLRU; 
end;