rmd_ibx.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{           Report Machine v1.0           }
{   Wrapper for Interbase Express(IBX)    }
{                                         }
{*****************************************}

unit RMD_IBX;

interface

{$I RM.INC}
{$IFDEF DM_IBX}
uses
  Classes, SysUtils, Graphics, Forms, ExtCtrls, DB, IBTable, IBQuery, IBDatabase,
  StdCtrls, Controls, Dialogs, RMD_DBWrap, RM_Class
{$IFDEF Delphi6}, Variants{$ENDIF};

type
  TRMDIBXComponents = class(TComponent) // fake component
  end;

  TRMDIBDatabase = class(TRMNonVisualControl)
  private
    FDatabase: TIBDatabase;
    FTransaction: TIBTransaction;
    procedure PropEditor(Sender: TObject);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    procedure ShowEditor; override;
    property Database: TIBDatabase read FDatabase;
  end;

 { TRMDIBTable }
  TRMDIBTable = class(TRMDTable)
  private
    FTable: TIBTable;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;

    function GetDatabases: string; override;
    function GetTableNames: string; override;
    procedure GetIndexNames(sl: TStrings); override;
  public
    constructor Create; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  end;

  { TRMDIBQuery}
  TRMDIBQuery = class(TRMDQuery)
  private
    FQuery: TIBQuery;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;

    function GetParamName(Index: Integer): string; override;
    function GetParamType(Index: Integer): TFieldType; override;
    procedure SetParamType(Index: Integer; Value: TFieldType); override;
    function GetParamKind(Index: Integer): TRMParamKind; override;
    procedure SetParamKind(Index: Integer; Value: TRMParamKind); override;
    function GetParamText(Index: Integer): string; override;
    procedure SetParamText(Index: Integer; Value: string); override;
    function GetParamValue(Index: Integer): Variant; override;
    procedure SetParamValue(Index: Integer; Value: Variant); override;

    function GetDatabases: string; override;
    procedure GetTableNames(DB: string; Strings: TStrings); override;
    procedure GetTableFieldNames(const DB, TName: string; sl: TStrings); override;
  public
    constructor Create; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  published
  end;

 { TForm2 }
  TRMDFormIBXPropEdit = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    btnOK: TButton;
    btnCancel: TButton;
    rdbLocal: TRadioButton;
    rdbRemote: TRadioButton;
    edtServer: TEdit;
    cmbProtocol: TComboBox;
    Label3: TLabel;
    edtDatabase: TEdit;
    Label4: TLabel;
    edtUser: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    memParam: TMemo;
    edtPassword: TEdit;
    Label7: TLabel;
    edtSQLRole: TEdit;
    btnBrowse: TButton;
    OpenDialog1: TOpenDialog;
    lblServer: TStaticText;
    lblProtocol: TStaticText;
    procedure btnBrowseClick(Sender: TObject);
    procedure rdbLocalClick(Sender: TObject);
    procedure edtUserExit(Sender: TObject);
    procedure edtPasswordExit(Sender: TObject);
    procedure edtSQLRoleExit(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FDatabase: TIBDatabase;
    procedure Localize;
  public
    { Public declarations }
  end;

{$ENDIF}
implementation

{$IFDEF DM_IBX}
uses RM_CmpReg, RM_utils, RM_Const;

{$R *.DFM}
{$R RMD_IBX.RES}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDIBDatabase}

constructor TRMDIBDatabase.Create;
begin
  inherited Create;
  FDatabase := TIBDataBase.Create(RMDialogForm);
  FTransaction := TIBTransaction.Create(RMDialogForm);
  FDatabase.DefaultTransaction := FTransaction;
  Component := FDatabase;
  BaseName := 'IBDatabase';
  Bmp.LoadFromResourceName(hInstance, 'RMD_IBXDB');
  Flags := Flags or flDontUndo;
end;

destructor TRMDIBDatabase.Destroy;
begin
  if Assigned(RMDialogForm) then
  begin
    FTransaction.Free;
    FDatabase.Free;
  end;
  inherited Destroy;
end;

procedure TRMDIBDatabase.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Connected', [rmdtBoolean], nil);
  AddProperty('DatabaseName', [rmdtString], PropEditor);
  AddProperty('LoginPrompt', [rmdtBoolean], nil);
  AddProperty('Params', [], nil);
  AddProperty('Params.Count', [], nil);
  AddProperty('SQLDialect', [rmdtInteger], nil);
end;

procedure TRMDIBDatabase.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'DATABASENAME' then
    FDatabase.DatabaseName := Value
  else if Index = 'LOGINPROMPT' then
    FDatabase.LoginPrompt := Value
  else if Index = 'CONNECTED' then
  begin
    FDatabase.Connected := Value;
    if Assigned(FDataBase.DefaultTransaction) then
      FDataBase.DefaultTransaction.Active := Value;
  end
  else if Index = 'PARAMS' then
    FDatabase.Params.Text := Value
  else if Index = 'SQLDIALECT' then
    FDatabase.SQLDialect := Value
end;

function TRMDIBDatabase.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'DATABASENAME' then
    Result := FDataBase.DatabaseName
  else if Index = 'LOGINPROMPT' then
    Result := FDataBase.LoginPrompt
  else if Index = 'CONNECTED' then
    Result := FDataBase.Connected
  else if Index = 'PARAMS.COUNT' then
    Result := FDatabase.Params.Count
  else if Index = 'PARAMS' then
    Result := FDatabase.Params.Text
  else if Index = 'SQLDIALECT' then
    Result := FDataBase.SQLDialect
end;

function TRMDIBDatabase.DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if Result = Null then
    Result := LinesMethod(FDataBase.Params, MethodName, 'PARAMS', Par1, Par2, Par3);
end;

procedure TRMDIBDatabase.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FDatabase.DatabaseName := RMReadString(Stream);
  FDatabase.LoginPrompt := RMReadBoolean(Stream);
  FDatabase.SQLDialect := RMReadInteger(Stream);
  RMReadMemo(Stream, FDatabase.Params);
  FDatabase.Connected := RMReadBoolean(Stream);
end;

procedure TRMDIBDatabase.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteString(Stream, FDatabase.DatabaseName);
  RMWriteBoolean(Stream, FDatabase.LoginPrompt);
  RMWriteInteger(Stream, FDatabase.SQLDialect);
  RMWriteMemo(Stream, FDatabase.Params);
  RMWriteBoolean(Stream, FDatabase.Connected);
end;

procedure TRMDIBDatabase.ShowEditor;
begin
  PropEditor(nil);
end;

procedure TRMDIBDatabase.PropEditor(Sender: TObject);
begin
  with TRMDFormIBXPropEdit.Create(Application) do
  begin
    try
      FDatabase := Self.FDatabase;
      ShowModal;
    finally
      Free;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDIBTable}

constructor TRMDIBTable.Create;
begin
  inherited Create;
  FTable := TIBTable.Create(RMDialogForm);
  DataSet := FTable;

  Component := FTable;
  BaseName := 'IBTable';
  Bmp.LoadFromResourceName(hInstance, 'RMD_IBXTABLE');
end;

function TRMDIBTable.GetDatabases: string;
var
  i: Integer;
  sl: TStringList;
begin
  Result := '';
  sl := TStringList.Create;
  RMGetComponents(RMDialogForm, TIBDatabase, sl, nil);
  sl.Sort;
  for i := 0 to sl.Count - 1 do
    Result := Result + sl[i] + ';';
  sl.Free;
end;

procedure TRMDIBTable.GetIndexNames(sl: TStrings);
var
  i: integer;
begin
  try
    if (Length(FTable.TableName) > 0) and (FTable.IndexDefs <> nil) then
    begin
      FTable.IndexDefs.Update;
      for i := 0 to FTable.IndexDefs.Count - 1 do
      begin
        if FTable.IndexDefs[i].Name <> '' then
          sl.Add(FTable.IndexDefs[i].Name);
      end;
    end;
  except
  end;
end;

function TRMDIBTable.GetTableNames: string;
var
  i: Integer;
  sl: TStringList;
begin
  Result := '';
  if FTable.Database <> nil then
  begin
    sl := TStringList.Create;
    try
      try
        FTable.DataBase.GetTableNames(sl, False);
        sl.Sort;
        for i := 0 to sl.Count - 1 do
          Result := Result + sl[i] + ';';
      except;
      end;
    finally
      sl.Free;
    end;
  end;
end;

procedure TRMDIBTable.SetPropValue(Index: string; Value: Variant);
var
  d: TComponent;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'INDEXNAME' then
    FTable.IndexName := Value
  else if Index = 'MASTERSOURCE' then
  begin
    d := RMFindComponent(FTable.Owner, Value);
    FTable.MasterSource := RMGetDataSource(FTable.Owner, TDataSet(d));
  end
  else if Index = 'MASTERFIELDS' then
    FTable.MasterFields := Value
  else if Index = 'TABLENAME' then
  begin
    FTable.Close;
    FTable.TableName := Value;
  end
  else if index = 'DATABASE' then
  begin
    FTable.Close;
    d := RMFindComponent(FTable.Owner, Value);
    FTable.Database := TIBDatabase(d);
  end;
end;

function TRMDIBTable.GetPropValue(Index: string): Variant;

  function RMGetDataBaseName(Owner: TComponent; d: TIBDatabase): string;
  begin
    Result := '';
    if d <> nil then
    begin
      Result := d.Name;
      if d.Owner <> Owner then
        Result := d.Owner.Name + '.' + Result;
    end;
  end;

begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'INDEXNAME' then
    Result := FTable.IndexName