rmd_bde.pas

中小企业管理系统------ ERP系统原代码

{*****************************************}
{                                         }
{           Report Machine v2.0           }
{             Wrapper for BDE             }
{                                         }
{*****************************************}

unit RMD_BDE;

interface

{$I RM.INC}

{$IFDEF DM_BDE}
uses
  Windows, Classes, SysUtils, Forms, Dialogs, ExtCtrls, StdCtrls, Controls, DB,
  DBTables, RM_Class, RMD_DBWrap
{$IFDEF Delphi6}, Variants{$ENDIF};

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

 { TRMDBDEDatabase }
  TRMDBDEDatabase = class(TRMNonVisualControl)
  private
    FDatabase: TDatabase;
    procedure PropEditor(Sender: TObject);
    procedure _GetAliasNames(Sender: TObject);
    procedure _GetDriverNames(Sender: TObject);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Pars: array of 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: TDatabase read FDatabase;
  end;

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

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

  { TRMDBDEQuery}
  TRMDBDEQuery = class(TRMDQuery)
  private
    FQuery: TQuery;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Pars: array of 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;

    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;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  published
  end;

  { TDBEditForm }
  TRMDFormBDEDBProp = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    cmbAliasName: TComboBox;
    Label2: TLabel;
    cmbDriverName: TComboBox;
    Label3: TLabel;
    memDatabaseParams: TMemo;
    btnDefaultsParam: TButton;
    btnClearParam: TButton;
    btnOK: TButton;
    btnCancel: TButton;
    Label4: TLabel;
    edtDBName: TEdit;
    btnPath: TButton;
    procedure cmbAliasNameChange(Sender: TObject);
    procedure cmbAliasNameDropDown(Sender: TObject);
    procedure cmbDriverNameChange(Sender: TObject);
    procedure cmbDriverNameDropDown(Sender: TObject);
    procedure btnDefaultsParamClick(Sender: TObject);
    procedure btnClearParamClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnPathClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FDatabase: TDatabase;
    function Edit: Boolean;
    procedure Localize;
  end;
{$ENDIF}

implementation

{$IFDEF DM_BDE}
{$R *.DFM}
{$R RMD_BDE.RES}

uses BdeConst, BDE, RM_Utils, RM_CmpReg, RM_Const, RM_DsgCtrls;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDBDEDatabase}

constructor TRMDBDEDatabase.Create;
begin
  inherited Create;
  FDatabase := TDataBase.Create(RMDialogForm);
  Component := FDatabase;
  BaseName := 'Database';

  BmpRes := 'RMD_BDEDB';
  Flags := Flags or flDontUndo;
end;

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

procedure TRMDBDEDatabase._GetAliasNames(Sender: TObject);
var
  liProp: PRMPropRec;
begin
  liProp := PropRec['AliasName'];
  Session.GetAliasNames(liProp^.Enum);
  liProp^.Enum.Sort;
end;

procedure TRMDBDEDatabase._GetDriverNames(Sender: TObject);
var
  liProp: PRMPropRec;
begin
  liProp := PropRec['DriverName'];
  Session.GetDriverNames(liProp^.Enum);
  liProp^.Enum.Sort;
end;

procedure TRMDBDEDatabase.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('AliasName', '', [Null], _GetAliasNames);
  AddProperty('Connected', [rmdtBoolean], nil);
  AddProperty('DatabaseName', [rmdtString], nil);
  AddEnumProperty('DriverName', '', [Null], _GetDriverNames);
  AddProperty('LoginPrompt', [rmdtBoolean], nil);
  AddProperty('Params', [rmdtHasEditor, rmdtOneObject], PropEditor);
  AddProperty('Params.Count', [], nil);
end;

procedure TRMDBDEDatabase.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'DATABASENAME' then
    FDatabase.DatabaseName := Value
  else if Index = 'DRIVERNAME' then
    FDatabase.DriverName := Value
  else if Index = 'LOGINPROMPT' then
    FDatabase.LoginPrompt := Value
  else if Index = 'CONNECTED' then
    FDatabase.Connected := Value
  else if Index = 'ALIASNAME' then
    FDatabase.AliasName := Value
  else if Index = 'PARAMS' then
    FDatabase.Params.Text := Value
end;

function TRMDBDEDatabase.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 = 'DRIVERNAME' then
    Result := FDatabase.DriverName
  else if Index = 'LOGINPROMPT' then
    Result := FDatabase.LoginPrompt
  else if Index = 'CONNECTED' then
    Result := FDatabase.Connected
  else if Index = 'ALIASNAME' then
    Result := FDatabase.AliasName
  else if Index = 'PARAMS.COUNT' then
    Result := FDatabase.Params.Count
  else if Index = 'PARAMS' then
    Result := FDatabase.Params.Text
end;

function TRMDBDEDatabase.DoMethod(const MethodName: string; Pars: array of Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Pars);
  if Result = Null then
    Result := LinesMethod(FDataBase.Params, MethodName, 'PARAMS', Pars[0], Pars[1], Pars[2]);
end;

procedure TRMDBDEDatabase.LoadFromStream(Stream: TStream);
var
  s: string;
begin
  inherited LoadFromStream(Stream);
  FDatabase.DatabaseName := RMReadString(Stream);
  s := RMReadString(Stream);
  if s <> '' then
    FDatabase.AliasName := s;
  s := RMReadString(Stream);
  if s <> '' then
    FDatabase.DriverName := s;
  FDatabase.LoginPrompt := RMReadBoolean(Stream);
  RMReadMemo(Stream, FDatabase.Params);
  FDatabase.Connected := RMReadBoolean(Stream);
end;

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

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

procedure TRMDBDEDatabase.PropEditor(Sender: TObject);
begin
  RMDesigner.BeforeChange;
  with TRMDFormBDEDBProp.Create(Application) do
  begin
    try
      FDatabase := Self.FDatabase;
      if Edit then
        RMDesigner.AfterChange;
    finally
      Free;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDBDETable}

constructor TRMDBDETable.Create;
begin
  inherited Create;
  FTable := TTable.Create(RMDialogForm);
  DataSet := FTable;

  Component := FTable;
  BaseName := 'Table';
  BmpRes := 'RMD_BDETABLE';
end;

procedure TRMDBDETable.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
end;

procedure TRMDBDETable.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
end;

procedure TRMDBDETable.GetDatabases(sl: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    Session.GetAliasNames(liStringList);
    liStringList.Sort;
    sl.Assign(liStringList);
  finally
  	liStringList.Free;
  end;
end;

procedure TRMDBDETable.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;

procedure TRMDBDETable.GetTableNames(sl: TStrings);
var
  liStringList: TStringList;
begin
  if FTable.DatabaseName <> '' then
  begin
    liStringList := TStringList.Create;
    try
      Session.GetTableNames(FTable.DatabaseName, '', True, False, liStringList);
      liStringList.Sort;
      sl.Assign(liStringList);
    finally
      liStringList.Free;
    end;
  end;
end;

procedure TRMDBDETable.SetPropValue(Index: string; Value: Variant);
var
  d: TDataset;
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) as TDataSet;
    FTable.MasterSource := RMGetDataSource(FTable.Owner, 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