rmd_ibx.pas

这是一个功能强大

{*****************************************}
{                                         }
{           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 USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

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

  TRMDIBDatabase = class(TRMDialogComponent)
  private
    FDatabase: TIBDatabase;
    FTransaction: TIBTransaction;

    function GetConnected: Boolean;
    procedure SetConnected(Value: Boolean);
    function GetDatabaseName: string;
    procedure SetDatabaseName(Value: string);
    function GetLoginPrompt: Boolean;
    procedure SetLoginPrompt(Value: Boolean);
    function GetSQLDialect: Integer;
    procedure SetSQLDialect(Value: Integer);
    function GetParams: string;
    procedure SetParams(Value: string);
  protected
    procedure AfterChangeName; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure ShowEditor; override;
  published
    property Database: TIBDatabase read FDatabase;
    property Connected: Boolean read GetConnected write SetConnected;
    property DatabaseName: string read GetDatabaseName write SetDatabaseName;
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt;
    property SQLDialect: Integer read GetSQLDialect write SetSQLDialect;
    property Params: string read GetParams write SetParams;
  end;

 { TRMDIBTable }
  TRMDIBTable = class(TRMDTable)
  private
    FTable: TIBTable;
  protected
    function GetTableName: string; override;
    procedure SetTableName(Value: string); override;
    function GetFilter: string; override;
    procedure SetFilter(Value: string); override;
    function GetIndexName: string; override;
    procedure SetIndexName(Value: string); override;
    function GetMasterFields: string; override;
    procedure SetMasterFields(Value: string); override;
    function GetMasterSource: string; override;
    procedure SetMasterSource(Value: string); override;
    function GetDatabaseName: string; override;
    procedure SetDatabaseName(const Value: string); override;
    procedure GetIndexNames(sl: TStrings); override;
    function GetIndexFieldNames: string; override;
    procedure SetIndexFieldNames(Value: string); override;

    function GetIndexDefs: TIndexDefs; override;
  public
    constructor Create; override;
  published
    property IndexName;
  end;

  { TRMDIBQuery}
  TRMDIBQuery = class(TRMDQuery)
  private
    FQuery: TIBQuery;
  protected
    function GetParamCount: Integer; override;
    function GetSQL: string; override;
    procedure SetSQL(aSql: string); override;
    function GetFilter: string; override;
    procedure SetFilter(Value: string); override;
    function GetDatabaseName: string; override;
    procedure SetDatabaseName(const Value: string); override;
    function GetDataSource: string; override;
    procedure SetDataSource(Value: string); 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;

    procedure GetDatabases(sl: TStrings); override;
    procedure GetTableNames(DB: string; Strings: TStrings); override;
    procedure GetTableFieldNames(const DB, TName: string; sl: TStrings); override;
  public
    constructor Create; override;
  published
  	property DataSource;
  end;

 { TRMDFormIBXPropEdit }
  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_Common, RM_utils, RM_Const, RM_PropInsp, RM_Insp;

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

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

constructor TRMDIBDatabase.Create;
begin
  inherited Create;
  BaseName := 'IBDatabase';
  FBmpRes := 'RMD_IBXDB';

  FDatabase := TIBDataBase.Create(RMDialogForm);
  FTransaction := TIBTransaction.Create(RMDialogForm);
  FDatabase.DefaultTransaction := FTransaction;
  DontUndo := True;
  FComponent := FDatabase;
end;

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

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

procedure TRMDIBDatabase.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, FDatabase.DatabaseName);
  RMWriteBoolean(aStream, FDatabase.LoginPrompt);
  RMWriteInt32(aStream, FDatabase.SQLDialect);
  RMWriteMemo(aStream, FDatabase.Params);
  RMWriteBoolean(aStream, FDatabase.Connected);
end;

procedure TRMDIBDatabase.ShowEditor;
var
  tmp: TRMDFormIBXPropEdit;
begin
  tmp := TRMDFormIBXPropEdit.Create(nil);
  try
    tmp.FDatabase := Self.FDatabase;
    if tmp.ShowModal = mrOK then
    begin
      RMDesigner.BeforeChange;
    end;
  finally
    tmp.Free;
  end;
end;

function TRMDIBDatabase.GetConnected: Boolean;
begin
  Result := FDatabase.Connected;
end;

procedure TRMDIBDatabase.SetConnected(Value: Boolean);
begin
  FDatabase.Connected := Value;
  if Assigned(FDataBase.DefaultTransaction) then
    FDataBase.DefaultTransaction.Active := Value;
end;

function TRMDIBDatabase.GetDatabaseName: string;
begin
  Result := FDatabase.DatabaseName;
end;

procedure TRMDIBDatabase.SetDatabaseName(Value: string);
begin
  FDatabase.DatabaseName := Value;
end;

function TRMDIBDatabase.GetLoginPrompt: Boolean;
begin
  Result := FDatabase.LoginPrompt;
end;

procedure TRMDIBDatabase.SetLoginPrompt(Value: Boolean);
begin
  FDatabase.LoginPrompt := Value;
end;

function TRMDIBDatabase.GetSQLDialect: Integer;
begin
  Result := FDatabase.SQLDialect;
end;

procedure TRMDIBDatabase.SetSQLDialect(Value: Integer);
begin
  FDatabase.SQLDialect := Value;
end;

function TRMDIBDatabase.GetParams: string;
begin
  Result := FDatabase.Params.Text;
end;

procedure TRMDIBDatabase.SetParams(Value: string);
begin
  FDatabase.Params.Text := Value;
end;

procedure TRMDIBDatabase.AfterChangeName;
begin
  FDatabase.Name := Name;
end;

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

constructor TRMDIBTable.Create;
begin
  inherited Create;
  BaseName := 'IBTable';
  FBmpRes := 'RMD_IBXTABLE';

  FTable := TIBTable.Create(RMDialogForm);
  DataSet := FTable;
  FComponent := FTable;
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.GetIndexFieldNames: string;
begin
  Result := FTable.IndexFieldNames;
end;

procedure TRMDIBTable.SetIndexFieldNames(Value: string);
begin
  FTable.IndexFieldNames := Value;
end;

function TRMDIBTable.GetIndexDefs: TIndexDefs;
begin
  Result := FTable.IndexDefs;
end;

function TRMDIBTable.GetDatabaseName: string;
begin
  Result := '';
  if FTable.Database <> nil then
  begin
    Result := FTable.Database.Name;
    if FTable.Database.Owner <> FTable.Owner then
      Result := FTable.Database.Owner.Name + '.' + Result;
  end;
end;

procedure TRMDIBTable.SetDatabaseName(const Value: string);
var
  liComponent: TComponent;
begin
  FTable.Close;
  liComponent := RMFindComponent(FTable.Owner, Value);
  if (liComponent <> nil) and (liComponent is TIBDatabase) then
    FTable.Database := TIBDatabase(liComponent)
  else
    FTable.Database := nil;
end;

function TRMDIBTable.GetTableName: string;
begin
  Result := FTable.TableName;
end;

procedure TRMDIBTable.SetTableName(Value: string);
begin
  FTable.Active := False;
  FTable.TableName := Value;
end;

function TRMDIBTable.GetFilter: string;
begin
  Result := FTable.Filter;
end;

procedure TRMDIBTable.SetFilter(Value: string);
begin
  FTable.Active := False;
  FTable.Filter := Value;
  FTable.Filtered := Value <> '';
end;

function TRMDIBTable.GetIndexName: string;
begin
  Result := FTable.IndexName;
end;

procedure TRMDIBTable.SetIndexName(Value: string);
begin
  FTable.Active := False;
  FTable.IndexName := Value;
end;

function TRMDIBTable.GetMasterFields: string;
begin
  Result := FTable.MasterFields;
end;

procedure TRMDIBTable.SetMasterFields(Value: string);
begin
  FTable.MasterFields := Value;
end;

function TRMDIBTable.GetMasterSource: string;
begin
  Result := RMGetDataSetName(FTable.Owner, FTable.MasterSource)
end;

procedure TRMDIBTable.SetMasterSource(Value: string);
var
  liComponent: TComponent;
begin
  liComponent := RMFindComponent(FTable.Owner, Value);
  if (liComponent <> nil) and (liComponent is TDataSet) then
    FTable.MasterSource := RMGetDataSource(FTable.Owner, TDataSet(liComponent))
  else
    FTable.MasterSource := nil;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDIBQuery}

constructor TRMDIBQuery.Create;
begin
  inherited Create;
  BaseName := 'IBQuery';
  FBmpRes := 'RMD_IBXQUERY';

  FQuery := TIBQuery.Create(RMDialogForm);
  DataSet := FQuery;
  FComponent := FQuery;
end;

procedure TRMDIBQuery.GetDatabases(sl: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    RMGetComponents(RMDialogForm, TIBDatabase, liStringList, nil);
    liStringList.Sort;
    sl.Assign(liStringList);
  finally
    liStringList.Free;
  end;
end;