udbdump.pas

Delphi/BCB 各种版本都支持的Excel 读写控件.一成功应用在N个项目中 .

unit UDbDump;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActnList, ComCtrls, ToolWin, ImgList, Db, DBTables,
  UExcelAdapter, OLEAdapter, Grids, DBGrids, ExtCtrls, StdCtrls,
  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
  UFlexcelReport, UCustomFlexCelReport;

type
  TMain = class(TForm)
    ImageList3: TImageList;
    ImageList2: TImageList;
    ImageList1: TImageList;
    ToolBar: TToolBar;
    btnGo: TToolButton;
    btnClose: TToolButton;
    ActionList: TActionList;
    ActionExport: TAction;
    ActionExit: TAction;
    Ds: TQuery;
    OLEAdapter: TOLEAdapter;
    ToolButton1: TToolButton;
    ActionRunSQL: TAction;
    Panel1: TPanel;
    Splitter1: TSplitter;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    edSQL: TMemo;
    Splitter2: TSplitter;
    Panel2: TPanel;
    LbAlias: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Report: TFlexCelReport;
    procedure ActionExitExecute(Sender: TObject);
    procedure ActionExportExecute(Sender: TObject);
    procedure ActionRunSQLExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    function GetCurrentDate: variant;
    function GetDsName: variant;
    function GetCurrentSQL: variant;
    { Private declarations }
  public
    { Public declarations }
  published
    property DsName: variant read GetDsName;
    property CurrentDate: variant read GetCurrentDate;
    property CurrentSQL: variant read GetCurrentSQL;
  end;

var
  Main: TMain;

implementation

{$R *.DFM}
function SkipCR(const s: string): string;
var
  i:integer;
begin
  SetLength(Result, Length(s));
  for i:=1 to length(s) do if s[i]<#32 then Result[i]:=' ' else Result[i]:=s[i];
end;

procedure TMain.ActionExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TMain.ActionExportExecute(Sender: TObject);
begin
  ActionRunSQL.Execute;
  Ds.DisableControls;
  try
    Report.Run;
  finally
    Ds.EnableControls;
  end;
end;

function TMain.GetCurrentDate: variant;
begin
  Result:= double(Now); //Dates should be passed as numbers, and the corresponding cell in excel have Date format.
end;

function TMain.GetCurrentSQL: variant;
begin
  Result:= SkipCR(Ds.SQL.Text);
end;

function TMain.GetDsName: variant;
begin
  Result:=Ds.Database.DatabaseName;
end;

procedure TMain.ActionRunSQLExecute(Sender: TObject);
begin
  Ds.Close;
  Ds.DatabaseName:= LbAlias.Text;
  Ds.SQL:=edSQL.Lines;
  Ds.Open;
end;

procedure TMain.FormCreate(Sender: TObject);
var
  StrList: TStringList;
  i: integer;
begin
  Session.Active:=true;
  StrList:=TStringList.Create;
  try
    Session.GetDatabaseNames(StrList);
    LbAlias.Items.Assign(StrList);
    for i:=0 to LbAlias.Items.Count-1 do
      if LbAlias.Items[i]='DBDEMOS' then LbAlias.ItemIndex:=i;
  finally
    FreeAndNil(StrList);
  end; //finally
end;

end.