...mit ADO zu einer AccessDB verbinden und BlobStream schreiben?

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADODB, DB, DBTables, ComObj;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function ConnectToADODB(var Query: TADOQuery; ConnectStr: String): Boolean; Overload;
function UpdateBlob(Connection: TADOConnection; Spalte: String; Tabelle: String; Where: String; var ms: TMemoryStream): Boolean;
procedure ShowEOleException(AExc: EOleException; Query: String);

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Query: TADOQuery;
  ms: TMemoryStream;
  ConnectStr: String;
begin
  ms := TMemoryStream.Create;
  ms.LoadFromFile('d:\a.txt');
  Query := TADOQuery.Create(nil);

  // You must connect to AccessDB first.
  // See: Query.Connection, TADOConection or Query.ConnectionString

  //my function to connect to DB
  ConnectStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + // provider for Access2000
                'Data Source=C:\db1.mdb;' + // databasefile
                'Mode=ReadWrite|Share Deny None;' + // set to ReadWrite
                'Persist Security Info=False';
  if not ConnectToADODB(Query, ConnectStr) then
   ShowMessage('Connecting to DB failed.');

  // data is my row and email the table
  UpdateBlob(Query.Connection, 'blobfieldname', 'Tabelle1', 'id=1', ms);
  ms.Free;

  // disconnect from DB
  Query.Connection.Close;

  Query.Free;
end;

function ConnectToADODB(var Query: TADOQuery; ConnectStr: String): Boolean; Overload;
begin
  Query.Connection := TADOConnection.Create(nil);
  Query.Connection.LoginPrompt := True;
  Query.Connection.ConnectionString := ConnectStr;
  Query.Connection.Open;
  result := Query.Connection.Connected;
end;

function UpdateBlob(Connection: TADOConnection; Spalte: String; Tabelle: String; Where: String; var ms: TMemoryStream): Boolean;
var
  BlobField: TBlobField;
  Table: TADOTable;
begin
  result := True;
  try
    ms.Seek(0, soFromBeginning);
    Table := TADOTable.Create(nil);
    Table.Connection := Connection;
    Table.TableName := Tabelle;
    Table.Filtered := False;
    // Set Filter like SQL-Command '... WHERE id=1'
    Table.Filter := Where;
    Table.Filtered := True;
    Table.Open;
    Table.First;

    if not Table.FieldByName(Spalte).IsBlob then
     Raise EOleException.Create('The field ' + Spalte + ' is not a blob-field.', S_FALSE, 'ITSQL.UpdateBlob', '', 0);

    BlobField := TBlobField(Table.FieldByName(Spalte));
    Table.Edit;
    BlobField.LoadFromStream(ms);
    Table.Post;
    Table.Free;
  except
    on E: EOleException do
    begin
      ShowEOleException(E, 'UPDATE BLOB FROM: SELECT ' + Spalte + ' FROM ' + Tabelle + ' WHERE ' + Where);
      result := False;
    end;
  end;
end;

procedure ShowEOleException(AExc: EOleException; Query: String);
var
  ErrShowFrm: TForm;
  Memo: TMemo;
begin
  ErrShowFrm := TForm.Create(nil);
  ErrShowFrm.Position := poScreenCenter;
  ErrShowFrm.Width := 640;
  ErrShowFrm.Height := 480;
  Memo := TMemo.Create(ErrShowFrm);
  Memo.Parent := ErrShowFrm;
  Memo.Align := alClient;

  Memo.Lines.Clear;
  Memo.Lines.Add('Message: ' + AExc.Message);
  Memo.Lines.Add('   Source: ' + AExc.Source);
  Memo.Lines.Add('   ClassName: ' + AExc.ClassName);
  Memo.Lines.Add('   Error Code: ' + IntToStr(AExc.ErrorCode));
  Memo.Lines.Add('   Query: ' + Query);

  ErrShowFrm.ShowModal;
  Memo.Free;
  ErrShowFrm.Free;
end;

end.

printed from
www.swissdelphicenter.ch
developers knowledge base