dxbloblist.pas

Well known and usefull component for delphi 7

unit DXBlobList;

interface

///////////////////////////////////////////////////////////////////////////////
// Component: TDXBlobList
//    Author: G.E. Ozz Nixon Jr. ([e-mail])
// ============================================================================
///////////////////////////////////////////////////////////////////////////////

uses
   Classes;

type
  TDXBlobListItem = class(TCollectionItem)
  private
    FBookMark:Integer;
    FField:Integer;
    FModified:Boolean;
    FMemory:Pointer;
    FMemorySize:Cardinal;
  public
    property Field :Integer read FField write FField;
    property Modified :Boolean read FModified write FModified;
    property Memory:Pointer read FMemory write FMemory;
    property MemorySize:Cardinal read FMemorySize write FMemorySize;
    function Size :Integer;
    constructor Create(Collection: TCollection); override;
    Destructor Destroy; override;
  end;

  TDXBlobList = class(TCollection)
   private
    FNextID:Integer;
    procedure SetFieldItem(Index: Integer; Value: TDXBlobListItem);
    function GetFieldItem(Index: Integer): TDXBlobListItem;
    function Lookup(BookMark, TheField:Integer):Integer;
    function GetNextOpenID: Integer;
   public
    function Add: TDXBlobListitem;
    constructor Create;
    procedure LoadFromStream(Stream :TMemoryStream);
    procedure SaveToStream(Stream :TMemoryStream);
    procedure BlobDelete(BookMark, TheField :Integer);
    procedure BlobModifiedSet(BookMark, TheField :Integer; IsModified :Boolean);
    procedure AddBlob(BookMark, TheField :Integer; M :TMemoryStream);
    function GetBlob(BookMark, TheField :Integer):TMemoryStream;
    procedure SetBlob(M :TMemoryStream; BookMark, Field :Integer);
    function AddBlobAutoInc(M :TMemoryStream; TheField :Integer) :Integer;
    function ExistsAndModified(BookMark, TheField :Integer) :Boolean;
    procedure ResetNextId;
    property Items[Index: Integer]: TDXBlobListItem read GetFieldItem write SetFieldItem;
    procedure SetModified(Value :Boolean);
   end;

implementation

Uses
   DXString;

constructor TDXBlobListItem.Create(Collection :TCollection);
begin
   inherited Create(Collection);
   FBookMark:=-1;
   Field:=-1;
   Modified:=False;
   Memory:=Nil;
   MemorySize:=0;
end;

Destructor TDXBlobListItem.Destroy;
begin
   If MemorySize>0 then Begin
      FreeMem(Memory,MemorySize);
      MemorySize:=0;
   End;
   inherited Destroy;
end;

{ TDXBlobList }

Constructor TDXBlobList.Create;
begin
   inherited Create(TDXBlobListItem);
   FNextID:=0;
end;

procedure TDXBlobList.SetFieldItem(Index :Integer; Value :TDXBlobListItem);
begin
   inherited Items[Index].Assign(Value);
end;

function TDXBloblist.GetFieldItem(Index :Integer): TDXBlobListItem;
begin
   Result:=TDXBloblistItem(inherited Items[Index]);
end;

function TDXBlobList.Add: TDXBlobListitem;
begin
   Result:=TDXBlobListItem(inherited Add);
end;

function TDXBlobList.AddBlobAutoInc(M:TMemoryStream;TheField:Integer):Integer;
Var
   Id:Integer;
   QuickCount:Integer;

begin
   Id:=GetNextOpenID;
   Add;
   QuickCount:=Count-1;
   Items[QuickCount].FBookMark:=Id;
   Items[QuickCount].Field:=TheField;
   Result:=Items[QuickCount].FBookMark;
   If Assigned(M) then Begin
      Items[QuickCount].MemorySize:=M.Size;
      GetMem(Items[QuickCount].FMemory,M.Size);
      FastMove(M.Memory^,Items[QuickCount].FMemory^,M.Size);
   End
   Else
      Items[QuickCount].MemorySize:=0;
end;

function TDXBlobList.GetNextOpenID: Integer;
begin
   inc(FNextID);
   Result:=FNextid;
   if Count=0 then exit;
   while Items[Count-1].FBookMark = Result do inc(Result);
end;

procedure TDXBlobList.BlobModifiedSet(BookMark, TheField :Integer; IsModified :Boolean);
var
   i:Integer;
   
begin
   for i:=0 to Count-1 do
      with Items[i] do
         if (FBookMark=BookMark) and (Field=TheField) then begin
            Items[i].Modified:=IsModified;
            exit;
         end;
end;

procedure TDXBlobList.BlobDelete(BookMark, TheField :Integer);
var
   i:Integer;

begin
   for i:=0 to Count-1 do
      with Items[i] do
         if (FBookMark = BookMark) and (Field = TheField) then begin
            Items[i].Free;
            exit;
         end;
end;

procedure TDXBlobList.LoadFromStream(Stream: TMemoryStream);
var
   ASize,TheSize:LongInt;
   AField,ABookmark:Integer;
   TmpStream:TMemoryStream;

begin
   Clear;
   Stream.Position:=0;
   TheSize:=Stream.Size-SizeOf(FNextId);
   TmpStream:=TMemoryStream.Create;
try
   while Stream.Position <> TheSize do begin
      Stream.ReadBuffer(ASize, SizeOf(ASize));
      Stream.ReadBuffer(AField, SizeOf(AField));
      Stream.ReadBuffer(ABookmark, SizeOf(ABookMark));
      TmpStream.Clear;
      if ASize > 0 then TmpStream.CopyFrom(Stream, ASize);
      AddBlob(ABookmark, AField, TmpStream);
   end;
   Stream.ReadBuffer(FNextId, SizeOf(FNextId));
finally
   TmpStream.Free;
end;
end;

procedure TDXBlobList.SaveToStream(Stream: TMemoryStream);
var
   i,ASize:LongInt;

begin
   Stream.Clear;
   for i:=0 to Count-1 do begin
      ASize:=Items[i].MemorySize;
      Stream.WriteBuffer(ASize, SizeOf(ASize));
      Stream.WriteBuffer(Items[i].Field, SizeOf(Items[i].Field));
      Stream.WriteBuffer(Items[i].FBookmark, SizeOf(Items[i].FBookmark));
      Stream.WriteBuffer(Items[i].Memory^,ASize);
   end;
   Stream.WriteBuffer(FNextId, SizeOf(FNextId));
   Stream.Position:=0;
end;

procedure TDXBlobList.AddBlob(BookMark, TheField :Integer; M :TMemoryStream);
begin
   Add;
   with Items[count - 1] do begin
      FBookMark:=BookMark;
      Field:=TheField;
      FMemorySize:=M.Size;
      GetMem(FMemory,M.Size);
      FastMove(M.Memory^,FMemory^,M.Size);
   end;
end;

function TDXBlobList.GetBlob(BookMark, TheField :Integer) :TMemoryStream;
var
   spot:Integer;

begin
   Result:=nil;
   spot:=Lookup(BookMark, TheField);
   if (spot<0) or (Items[Spot].MemorySize<1) then exit;
   Result:=TMemoryStream.Create;
   Result.WriteBuffer(Items[Spot].Memory^,Items[Spot].MemorySize);
end;

procedure TDXBlobList.SetBlob(M :TMemoryStream; BookMark, Field: Integer);
var
   Spot:Integer;

begin
   spot:=Lookup(BookMark, Field);
   if spot<0 then exit;
   If Items[Spot].MemorySize>0 then Begin
      FreeMem(Items[Spot].FMemory,Items[Spot].MemorySize);
   End;
   Items[Spot].MemorySize:=M.Size;
   GetMem(Items[Spot].FMemory,M.Size);
   FastMove(M.Memory^,Items[Spot].FMemory^,M.Size);
   Items[spot].Modified:=True;
end;

function TDXBlobList.Lookup(BookMark, TheField: Integer): Integer;
var
   i:Integer;

begin
   Result:=-1;
   for i:=0 to count-1 do
      with items[i] do
         if (FBookMark=BookMark) and (Field=TheField) then begin
            Result:=i;
            exit;
         end;
end;

function TDXBlobList.ExistsAndModified(BookMark, TheField :Integer): Boolean;
var
   spot:Integer;

begin
   Result:=False;
   spot:=lookup(BookMark, TheField);
   if spot<0 then exit;
   Result:=Items[spot].Modified
end;

procedure TDXBlobList.SetModified(Value :Boolean);
var
   i:Integer;
begin
   for i:=0 to Count-1 do Items[i].Modified:=Value;
end;

procedure TDXBlobList.ResetNextId;
begin
   FNextID:=0;
end;

function TDXBlobListItem.Size: Integer;
begin
   Result:=FMemorySize;
end;

end.