unit BlobDB;
interface
uses
Classes;
type
TBloblDB =
class
private
fData: TStream;
public
// Z.B. Mit einem FileStream instantiieren, z.B:
// MyFileStream := TFileStream.Create('MyFormularData.DAT', fmOpenReadWrite);
// MyBlobDB := TBlobDB.Create (MyFileStream);
constructor Create(aStream: TStream);
// Inhaltsverzeichnis: Name|<Blob-Größe>
Procedure ReadContents (aDirInfo : TStrings);
// Daten unter dem Namen speichern
procedure ReadData(aName: AnsiString; aData: TStream);
// Daten unter dem Namen überschreiben bzw. anhängen
procedure WriteData(aName: AnsiString; aData: TStream);
// Daten unter dem Namen entfernen
procedure DeleteData(aName: AnsiString);
// Ermitteln, ob unter dem Namen Daten vorhanden sind
Function DataExists (aBame: AnsiString) : Boolean;
end;
implementation
uses
SysUtils;
type
{(*}
TBlobHeader =
record
Name: AnsiString;
DataSize: Integer;
function LoadFromStream(aStream: TStream) : Boolean;
procedure SaveToStream(aStream: TStream);
end;
{*)}
{ TBlobHeader }
function TBlobHeader.LoadFromStream(aStream: TStream): Boolean;
var
iLen: Integer;
begin
if aStream.Position >= aStream.Size - 1
then
Result := False
else begin
Result := True;
aStream.ReadBuffer(iLen, SizeOf(iLen));
setLength(
Name, iLen);
if iLen > 0
then
aStream.
Read(
Name[1], iLen);
aStream.
Read(DataSize, SizeOf(DataSize));
end;
end;
procedure TBlobHeader.SaveToStream(aStream: TStream);
var
iLen: Integer;
begin
iLen := Length(
Name);
aStream.WriteBuffer(iLen, SizeOf(iLen));
aStream.WriteBuffer(
Name[1], iLen);
aStream.
Write(DataSize, SizeOf(DataSize));
end;
{ TBloblDB }
constructor TBloblDB.Create(aStream: TStream);
begin
fData := aStream;
end;
function TBloblDB.DataExists(aBame: AnsiString): Boolean;
var
blobHeader: TBlobHeader;
begin
fData.Position := 0;
while blobHeader.LoadFromStream(fData)
do
if blobHeader.
Name = aName
then begin
Result := True;
Exit;
end
else
fData.Position := fData.Position + blobHeader.DataSize;
Result := False;
end;
procedure TBloblDB.DeleteData(aName: AnsiString);
var
tmpStream: TMemoryStream;
blobHeader: TBlobHeader;
begin
tmpStream := TMemoryStream.Create;
Try
fData.Position := 0;
while blobHeader.LoadFromStream(fData)
do
if blobHeader.
Name <> aName
then begin
blobHeader.SaveToStream(tmpStream);
tmpStream.CopyFrom(fData, blobHeader.DataSize)
end
else
fData.Position := fData.Position + blobHeader.DataSize;
fData.Position := 0;
fData.CopyFrom(tmpStream, 0);
finally
tmpStream.Free;
End;
end;
procedure TBloblDB.ReadContents(aDirInfo: TStrings);
var
blobHeader: TBlobHeader;
begin
fData.Position := 0;
aDirInfo.Clear;
while blobHeader.LoadFromStream(fData)
do Begin
aDirInfo.Add(Format('
%s|%d',[blobHeader.
Name, blobHeader.DataSize]));
fData.Position := fData.Position + blobHeader.DataSize;
End;
end;
procedure TBloblDB.ReadData(aName: AnsiString; aData: TStream);
var
blobHeader: TBlobHeader;
begin
fData.Position := 0;
while blobHeader.LoadFromStream(fData)
do
if blobHeader.
Name = aName
then begin
aData.CopyFrom(fData, blobHeader.DataSize);
Exit;
end
else
fData.Position := fData.Position + blobHeader.DataSize;
raise EResNotFound.CreateFmt('
Could not find: %s', [aName]);
end;
procedure TBloblDB.WriteData(aName: AnsiString; aData: TStream);
var
blobHeader: TBlobHeader;
begin
DeleteData(aName);
blobHeader.
Name := aName;
blobHeader.DataSize := aData.Size;
blobHeader.SaveToStream(fData);
aData.Position := 0;
fData.CopyFrom(aData, aData.Size);
end;
end.