Image in Access Datenbank speichern

[uwe12]

es kommt nur append. ich habe hier mal meinen gesamten quelltext.

Delphi-Quellcode:

function JpegStartsInBlob(PicField:TBlobField):integer;
var
 bS     : TADOBlobStream;
 buffer : Word;
 hx     : string;
begin
 Result := -1;
 bS := TADOBlobStream.Create(PicField, bmRead);
 try
  while (Result = -1) and (bS.Position + 1 < bS.Size) do begin
   bS.ReadBuffer(buffer, 1);
   hx:=IntToHex(buffer,2);
   if hx = 'FF' then begin
     bS.ReadBuffer(buffer, 1);
     hx:=IntToHex(buffer,2);
     if hx = 'D8' then Result := bS.Position - 2
     else if hx = 'FF' then bS.Position := bS.Position-1;
   end;//if
  end;//while
 finally
  bS.Free
 end; //try
end;


procedure TForm1.ADOTable1AfterScroll(DataSet: TDataSet);
var
  bS : TADOBlobStream;
  Pic : TJpegImage;
 begin
 if AdoTable1.FieldByName('Bild').AsString <> '' then
 begin
  bS := TADOBlobStream.Create(AdoTable1Bild, bmRead);
  try
    bS.Seek(JpegStartsInBlob(AdoTable1Bild), soFromBeginning);
    Pic:=TJpegImage.Create;
    try
     Pic.LoadFromStream(bS);
     ADOImage.Picture.Graphic:=Pic;
    finally
     Pic.Free;
    end;
  finally
    bS.Free
  end;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if openpicturedialog1.Execute then
begin
  AdoImage.Picture.LoadFromFile(openpicturedialog1.FileName);  
end;
end;
      
procedure TForm1.Button2Click(Sender: TObject);
var 
  blob: TAdoBlobStream; 
  fs:TMemorystream; 
begin 
  AdoTable1.edit;
  blob := TADOBlobStream.Create(AdoTable1Bild, bmwrite);
  try    
    fs := TMemorystream.create();
    ADOImage.Picture.Bitmap.SaveToStream(fs);
    fs.Seek(0, soFromBeginning);
    try 
      blob.CopyFrom(fs, fs.Size);
    finally
      AdoTable1.post;
      fs.Free; 
    end; 
  finally
    blob.Free;
  end;  
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Adotable1.Append;
end;

procedure TForm1.FormCreate(Sender: TObject);
var sDBPath, sCons: string;
begin
sDBPath := 'O:\adopic\Datenbank1.mdb';
sCons := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + sDBPath + ';Persist Security Info=False';
ADOTable1.Active:=True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ADOTable1.Active:=False;
end;

end.