delphi的万能数据库操作

好多人都抱怨delphi没有提供一个可以把任意数据放入数据库的控件,虽然说用代码实现也不难,但是有控件会更方便,这次我终于还是抽出空来做了 这么个控件,以后就可以直接拖放了。它支持把任意数据类型写入数据库,也可以从数据库读出到流,或是直接保存为文件。另外,我加了一些对常用图像的处理, 保存jpg或是gif格式的图像很方便,并且可以直接显示到image上。

unit RaDBOLE;

interface

uses
  SysUtils, Classes, DB, DBTables, JPEG, ExtCtrls, GIFCtrl;

type
  TImageType = (itBMP, itJPG, itGIF, itOther);
  TOnSaveData = procedure(Sender: TObject) of object;
  TOnLoadData = procedure(Sender: TObject) of object;
  TOnShowImage = procedure(Sender: TObject; ImageType: TImageType) of object;

type
  TRaDBOLE = class(TComponent)
  private
    fDataSet: TDataSource;
    fDataField: string;
    fImage: TImage;
    fGifImage: TRxGIFAnimator;
    fOnSaveData: TOnSaveData;
    fOnLoadData: TOnLoadData;
    fOnShowImage: TOnShowImage;
  protected

  public
    constructor Create(AOwner: TComponent); override;
    {保存到数据库}
    function SaveToDatabase(AFileName: string): boolean;
    {追加到数据库}
    function AppendToDatabase(AFileName: string): boolean;
    {从数据库读出到流}
    function LoadToStream(var AStream: TStream): boolean;
    {从数据库读出到文件}
    function LoadToFile(AFileName: string): boolean;
    {读取图片}
    procedure GetImage;
  published
    property DataSet: TDataSource read fDataSet write fDataSet;
    property DataField: string read fDataField write fDataField;
    property Image: TImage read fImage write fImage;
    property GifImage: TRxGIFAnimator read fGifImage write fGifImage;
    property OnSaveData: TOnSaveData read fOnSaveData write fOnSaveData;
    property OnLoadData: TOnLoadData read fOnLoadData write fOnLoadData;
    property OnShowImage: TOnShowImage read fOnShowImage write fOnShowImage;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Rarnu Components', [TRaDBOLE]);
end;

{ TRaDBOLE }

function TRaDBOLE.AppendToDatabase(AFileName: string): boolean;
var
  mm: tmemorystream;
begin
  result := True;
  mm := tmemorystream.Create;
  mm.LoadFromFile(AFileName);
  mm.Position := 0;
  try
    fDataSet.DataSet.Append;
    tblobfield(fDataSet.DataSet.FieldByName(fDataField)).LoadFromStream(mm);
    fDataSet.DataSet.Post;
  except
    result := False;
  end;
  mm.Free;
  if Assigned(OnSaveData) then
    OnSaveData(Self);
end;

constructor TRaDBOLE.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fDataSet := nil;
  fDataField := '';
  fImage := nil;
end;

procedure TRaDBOLE.GetImage;
var
  ww: tmemorystream;
  JPEG: TJPEGImage;
  IT: TImageType;
begin
  if fImage = nil then Exit;
  ww := tmemorystream.Create;
  tblobfield(fDataSet.DataSet.FieldByName(fDataField)).SaveToStream(ww);
  try
    fImage.Picture.Assign(fDataSet.DataSet.FieldByName(fDataField));
    IT := itBMP;
  except
    try
      JPEG := TJPEGImage.Create;
      JPEG.Assign(fDataSet.DataSet.FieldByName(fDataField));
      fImage.Picture.Assign(JPEG);
      IT := itJPG;
    except
      try
        if fGifImage = nil then Exit;
        fGifImage.Image.Assign(fDataSet.DataSet.FieldByName(fDataField));
        IT := itGIF;
      except
        IT := itOther;
      end;
    end;
  end;
  //fImage.Picture.Graphic.LoadFromStream(ww);
  ww.Free;
  if Assigned(OnShowImage) then
    OnShowImage(Self, IT);
end;

function TRaDBOLE.LoadToFile(AFileName: string): boolean;
var
  tt: tmemorystream;
begin
  result := True;
  tt := tmemorystream.Create;
  try
    tblobfield(fDataSet.DataSet.FieldByName(fDataField)).SaveToStream(tt);
    tt.Position := 0;
    tt.SaveToFile(AFileName);
  except
    result := False;
  end;
  tt.Free;
  if Assigned(OnLoadData) then
    OnLoadData(Self);
end;

function TRaDBOLE.LoadToStream(var AStream: TStream): boolean;
var
  tt: tmemorystream;
begin
  result := True;
  tt := tmemorystream.Create;
  try
    tblobfield(fDataSet.DataSet.FieldByName(fDataField)).SaveToStream(tt);
    tt.Position := 0;
    AStream := tt;
  except
    result := False;
  end;
  tt.Free;
  if Assigned(OnLoadData) then
    OnLoadData(Self);
end;

function TRaDBOLE.SaveToDatabase(AFileName: string): boolean;
var
  mm: tmemorystream;
begin
  result := True;
  mm := tmemorystream.Create;
  mm.LoadFromFile(AFileName);
  mm.Position := 0;
  try
    fDataSet.Edit;
    tblobfield(fDataSet.DataSet.FieldByName(fDataField)).LoadFromStream(mm);
    fDataSet.DataSet.Post;
  except
    result := False;
  end;
  mm.Free;
  if Assigned(OnSaveData) then
    OnSaveData(Self);
end;

end.

一个使用ADO连接池的示例,演示了TADOStoredProc动态参数的使用,带重连机制 =================== unit UnitDemo; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm2 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; //数据库服务器 gDBServer: String = '127.0.0.1'; //数据库名称 gDBName: String = 'master'; //数据库用户名 gDBUser: String = 'sa'; //密码 gDBPass: String = '2001'; implementation {$R *.dfm} uses ADODB, UnitADOConnectionPool; const CreateSQL = 'create procedure TestMyPool (@type sysname) '#13#10+ 'as'#13#10+ 'select * from sysobjects where xtype=@type'#13#10+ 'return @@rowcount'; DeleteSQL = 'if Exists(select 1 from sysobjects where xtype=N''P'' and name=N''TestMyPool'')'#13#10+ ' drop procedure TestMyPool'; var gPoolMan: TADOConnPoolMan = Nil; procedure TForm2.Button1Click(Sender: TObject); var ADOObject:TADOConnPoolObject; ADOStoredProc:TADOStoredProc; Running :Integer; I: Integer; begin //取得一个存储过程资源(含一数据库有效连接) ADOObject := gPoolMan.CreateSP('TestMyPool'); if ADOObject = Nil then //取得资源失败 Exit; try ADOStoredProc := ADOObject.ExecObject as TADOStoredProc; Running := 2;//允许重试(两次)操作,以便在操作失败之后达到重连 while Running>0 do begin Dec(Running); if ADOObject.NeedRefresh then begin//判断是否有重连标志(比如数据库断开等,可能需要进行重连) if Not ADOObject.Reconnect then Exit; ADOObject.NeedRefresh := Not ADOStoredProc.Parameters.Refresh; if ADOObject.NeedRefresh then Exit; end; for I := 1(*Zero is the *Result* Parameter*) to ADOStoredProc.Parameters.Count - 1 do begin //========================= //传递参数 ADOStoredProc.Parameters.Items[I].Value := 'U'; //========================= end; if Running 0 then try //执行存储过程 ADOStoredProc.Open; //执行存储过程成功,退出循环进入后续的数据处理 break; except On E:Exception do begin //执行失败非程序级的异常通常有两种可能: //1.数据库连接断开 //2.自适合的参数传递当中可能存储过程已更新,参与不一致 //设置重连标志 ADOObject.NeedRefresh := True; //=================== //这里记录数据库操作失败日志 //=================== end; end; Exit; end; //========================== //从ADOStoredProc当中读取记录 ShowMessage(IntToStr(ADOStoredProc.Parameters.ParamByName('Result').Value)); //========================== //关闭存储对象的资源 ADOStoredProc.Close; finally //调用结束,释放资源 ADOObject.Free; end; end; procedure TForm2.FormCreate(Sender: TObject); var ADOConn:TADOConnection; begin (****************BEGIN*******************) (*注:仅为测试准备 *) //初始化测试环境 ADOConn := Nil; if Not TADOConnPoolMan.ConnectADO( gDBServer,gDBUser,gDBPass,gDBName,true,ADOConn) then Exit; try ADOConn.Execute(DeleteSQL); ADOConn.Execute(CreateSQL); finally try ADOConn.Close; except end; ADOConn.Free; end; (*****************END********************) //初始化连接池 gPoolMan := TADOConnPoolMan.Create(gDBServer,gDBUser,gDBPass,gDBName,true); end; procedure TForm2.FormDestroy(Sender: TObject); var ADOConn:TADOConnection; begin //释放连接池 if Assigned(gPoolMan) then gPoolMan.Free; (****************BEGIN*******************) (*注:仅为测试准备 *) //清理测试环境 ADOConn := Nil; if Not TADOConnPoolMan.ConnectADO( gDBServer,gDBUser,gDBPass,gDBName,true,ADOConn) then Exit; try ADOConn.Execute(DeleteSQL); finally try ADOConn.Close; except end; ADOConn.Free; end; (*****************END********************) end; end.
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值