Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 810
  • Last Modified:

How to save the OleContainer content into MS Access database

Hi,

I have a OleContainer and I want save  this OleContainer content into MS Access blobfield.

When I update it I use following source:

  TempStream   := TMemoryStream.Create;
  OleContainer1.SaveToStream(TempStream);
  self.Query1.ParamByName('BLOB').LoadFromStream(TempStream,ftBlob);
  self.Query1.ExecSQL;
  TempStream.Free;

And when I load it

  TempBlobStream := TBlobStream.Create(Query2.FieldByName('BLOB') as TBlobField , bmRead);
  OleContainer1.LoadFromStream(TempBlobStream);
  TempBlobStream.Free;

This source is working in Oracle and Interbase Corectly,
but if i want to use in MS Access it is not working.
For Example :
The OleContainer content a Excel file which size more than 0.5 Mbyte.

I get a next exception : "Access violation ... in modul "ole32.dll".. ".

If you know what is the problem Please answer this question.
0
lemez
Asked:
lemez
1 Solution
 
Rusty_KnightCommented:
This example DBContainer components. It Work Fine.
-------------- CUT --------------------------------
unit DBOLEContainer2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtnrs, DB, DBCtrls;

type
  TDBOleContainer2 = class(TOleContainer)
  private
    FDataLink: TFieldDataLink;
    FAutoDisplay: Boolean;
    FFocused: Boolean;
    FObjectLoaded: Boolean;
    FDummy:integer;
    FFromActivate:boolean;
    procedure DataChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure SetAutoDisplay(Value: Boolean);
    procedure SetFocused(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure DoDeactivate(Sender:TObject);
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure LoadObject; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
    function InsertObjectDialog:boolean;
    procedure DestroyObject;
    procedure Modify;
  published
    { Published declarations }
    property DataSource:TDataSource read GetDataSource write SetDataSource;
    property DataField:string read GetDataField write SetDataField;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
    property AutoActivate:integer read FDummy;
  end;

procedure Register;

implementation

const
  Signature:integer=-525465623;

constructor TDBOLEContainer2.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  inherited AutoActivate:=aaDoubleClick;
  ControlStyle:=ControlStyle+[csReplicatable];
  FAutoDisplay:=True;
  FDataLink:=TFieldDataLink.Create;
  FDataLink.Control:=Self;
  FDataLink.OnDataChange:=DataChange;
  FDataLink.OnUpdateData:=UpdateData;
  OnDeactivate:=DoDeactivate;
end;

destructor TDBOLEContainer2.Destroy;
begin
  FDataLink.Free;
  FDataLink:=nil;
  inherited Destroy;
end;

procedure TDBOLEContainer2.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then DataChange(Self);
end;

procedure TDBOLEContainer2.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) and (FDataLink<>nil) and
    (AComponent=DataSource) then DataSource:=nil;
end;

procedure TDBOLEContainer2.DoDeactivate(Sender:TObject);
begin
  if Modified then begin
    if not FDataLink.Editing then FDataLink.Edit;
    FDataLink.Modified;
  end;
end;

function TDBOLEContainer2.GetDataSource:TDataSource;
begin
  Result:=FDataLink.DataSource;
end;

procedure TDBOLEContainer2.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource:=Value;
  if Value<>nil then Value.FreeNotification(Self);
end;

function TDBOLEContainer2.GetDataField:string;
begin
  Result:=FDataLink.FieldName;
end;

procedure TDBOLEContainer2.SetDataField(const Value: string);
begin
  FDataLink.FieldName:=Value;
end;

function TDBOLEContainer2.GetReadOnly:Boolean;
begin
  Result:=FDataLink.ReadOnly;
end;

procedure TDBOLEContainer2.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly:=Value;
  if Value then inherited AutoActivate:=aaDoubleClick else inherited AutoActivate:=aaManual;
end;

function TDBOLEContainer2.GetField:TField;
begin
  Result:=FDataLink.Field;
end;

procedure TDBOLEContainer2.LoadObject;
var
  Stream:TMemoryStream;
  N:integer;
begin
  if not FObjectLoaded and Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then begin
    inherited DestroyObject;
    Stream:=nil;
    try
      Stream:=TMemoryStream.Create; {Creation memory stream and saving content from database}
      TBlobField(FDataLink.Field).SaveToStream(Stream);
      Stream.Seek(0,soFromBeginning);
      if Stream.Size>4 then begin   {if size<4 then bad field - even though signature was not entered}
        Stream.Read(N,sizeof(N));
        if N=Signature then LoadFromStream(Stream);
      end;
      if Assigned(Stream) then begin
        Stream.Free;
        Stream:=nil;
      end;
      FObjectLoaded:=True;
    except
      on E:exception do begin
        if Assigned(Stream) then Stream.Free;
        MessageDlg(E.Message,mtError,[mbOK],0);
      end;
    end;
    Modified:=False;
  end;
end;

procedure TDBOLEContainer2.DataChange(Sender: TObject);
begin
  if (FDataLink.Field <>nil) then if FDataLink.Field.IsBlob then begin
    if FAutoDisplay or (FDataLink.Editing and FObjectLoaded) then begin
      FObjectLoaded:=False;
      LoadObject;
    end else begin
      FObjectLoaded:=False;
    end;
  end;
  if HandleAllocated then RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
end;

procedure TDBOLEContainer2.UpdateData(Sender: TObject);
var
  Stream:TMemoryStream;
begin
  {Read OLE data from container}
  if FDataLink.Field.IsBlob then begin
    Stream:=nil;
    try
      Stream:=TMemoryStream.Create;
      Stream.Write(Signature,sizeof(Signature));
      if Assigned(OleObjectInterface) then SaveToStream(Stream);
      Stream.Seek(0,soFromBeginning);
      TBlobField(FDataLink.Field).LoadFromStream(Stream);
      if Assigned(Stream) then begin
        Stream.Free;
        Stream:=nil;
      end;
      Modified:=False;
    except
      on E:exception do begin
        if Assigned(Stream) then Stream.Free;
        MessageDlg(E.Message,mtError,[mbOK],0);
      end;
    end;
  end;
end;

procedure TDBOLEContainer2.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused:=Value;
    if not Assigned(FDataLink.Field) or not FDataLink.Field.IsBlob then
      FDataLink.Reset;
  end;
end;

procedure TDBOLEContainer2.CMEnter(var Message: TCMEnter);
begin
  if FFromActivate then begin
    inherited;
    Exit;
  end;
  SetFocused(True);
  inherited;
end;

procedure TDBOLEContainer2.CMExit(var Message: TCMExit);
begin
  if FFromActivate then begin
    inherited;
    Exit;
  end;
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  SetFocused(False);
  inherited;
end;

procedure TDBOLEContainer2.SetAutoDisplay(Value: Boolean);
begin
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay:=Value;
    if Value then LoadObject;
  end;
end;

procedure TDBOLEContainer2.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  if Assigned(OleObjectInterface) then try
    FFromActivate:=True;
    FDataLink.Edit;
    inherited;
    FDataLink.Modified;
  finally
    FFromActivate:=False;
  end else try
    FFromActivate:=True;
    FObjectLoaded:=True;
    FDataLink.Edit;
    if inherited InsertObjectDialog then FDataLink.Modified;
  finally
    FFromActivate:=False;
  end;
end;

procedure TDBOLEContainer2.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

function TDBOLEContainer2.InsertObjectDialog:boolean;
begin
  Result:=False;
  try
    FFromActivate:=True;
    FObjectLoaded:=True;
    FDataLink.Edit;
    Result:=inherited InsertObjectDialog;
    if Result then FDataLink.Modified;
  finally
    FFromActivate:=False;
  end;
end;

procedure TDBOleContainer2.DestroyObject;
begin
  FDataLink.Edit;
  inherited DestroyObject;
  FDataLink.Modified;
  Invalidate;
end;

procedure Register;
begin
  RegisterComponents('COMUTILS', [TDBOleContainer2]);
end;

procedure TDBOleContainer2.Modify;
begin
 FDataLink.Modified;
end;

end.


--------------- CUT ----------------------------
0
 
lemezAuthor Commented:
Thank you,

but I don't know how is it working?
I set the DataSource property and DataField and AutoDisplay=true.

After I insert the excel file to the DBOleContainer2 and call the the query.post method I get a next excpetion "Invalid blob length".
Perhaps did i something wrong?
0
 
Rusty_KnightCommented:
Example of USE
1. Step. Run at Acess SQL:"create table test
(DATA OleObject)"
2. This is code of test project
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, DBCtrls, DB, ADODB, OleCtnrs, DBOLEContainer2,
  ComCtrls, ToolWin;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    DataSource1: TDataSource;
    DBNavigator1: TDBNavigator;
    DBOleContainer21: TDBOleContainer2;
    ToolBar1: TToolBar;
    OpenDialog1: TOpenDialog;
    ToolButton1: TToolButton;
    procedure ToolButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ToolButton1Click(Sender: TObject);
var
 i:integer;
begin
 if OpenDialog1.Execute then begin
   for i:=0 to pred(OpenDialog1.Files.Count) do begin
    ADOTable1.Append;
    DBOleContainer21.CreateObjectFromFile(OpenDialog1.Files[i],False);
    DBOleContainer21.Modify;
    DBOleContainer21.DataSource.DataSet.Post;
   end;
  end;
end;

end.

3. Test Application
3.1. Run Application. DoubleClick on DBOleContainer. After insert object clic on POST button or NEXT or Prev. OLE object will be saved.

3.2. Another Method. Click on button. On Dialog select some files and click OK. All files (OLE) will be saved in Access.
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Rusty_KnightCommented:
I Import DOC file with size ~4MB
0
 
lemezAuthor Commented:
Thank you Rusty_Knight.

The different my application and your I used BDE component and not ADO.
Now it is working fine.
0
 
CleanupPingCommented:
lemez:
This old question needs to be finalized -- accept an answer, split points, or get a refund.  For information on your options, please click here-> http:/help/closing.jsp#1 
EXPERTS:
Post your closing recommendations!  No comment means you don't care.
0
 
kacorretiredCommented:
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area for this question:
       to accept Rusty_Knight's answer
Please leave any comments here within the next seven days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!

Some days and here is the Christmas Time. I wish good luck and good health for you all and for your loved ones

kacor
EE Cleanup Volunteer
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now