rmd_ado.pas

这是一个功能强大

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

unit RMD_ADO;

interface

{$I RM.INC}
{$IFDEF DM_ADO}
uses
  Windows, Classes, SysUtils, Graphics, Forms, ExtCtrls, DB, ADODB, ADOInt,
  StdCtrls, Controls, RM_Class, RMD_DBWrap
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

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

  TRMDADODatabase = class(TRMDialogComponent)
  private
    FDatabase: TADOConnection;

    function GetConnected: Boolean;
    procedure SetConnected(Value: Boolean);
    function GetConnectionString: WideString;
    procedure SetConnectionString(Value: WideString);
    function GetLoginPrompt: Boolean;
    procedure SetLoginPrompt(Value: Boolean);
    function GetCursorLocation: TCursorLocation;
    procedure SetCursorLocation(Value: TCursorLocation);
  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: TADOConnection read FDatabase;
    property Connected: Boolean read GetConnected write SetConnected;
    property ConnectionString: WideString read GetConnectionString write SetConnectionString;
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt;
    property CursorLocation: TCursorLocation read GetCursorLocation write SetCursorLocation;
  end;

 { TRMDADOTable }
  TRMDADOTable = class(TRMDTable)
  private
    FTable: TADOTable;
  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;
    function GetIndexFieldNames: string; override;
    procedure SetIndexFieldNames(Value: string); override;

    procedure GetIndexNames(sl: TStrings); override;
    function GetIndexDefs: TIndexDefs; override;
  public
    constructor Create; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
  published
    property IndexName;
  end;

  { TRMDADOQuery }
  TRMDADOQuery = class(TRMDQuery)
  private
    FQuery: TADOQuery;
  protected
    function GetParamCount: Integer; override;
    function GetSQL: string; override;
    procedure SetSQL(Value: 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;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
  published
  	property DataSource;
  end;

 { TConnEditForm }
  TRMDFormADOConnEdit = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    SourceofConnection: TGroupBox;
    UseDataLinkFile: TRadioButton;
    UseConnectionString: TRadioButton;
    DataLinkFile: TComboBox;
    Browse: TButton;
    ConnectionString: TEdit;
    Build: TButton;
    procedure FormCreate(Sender: TObject);
    procedure BuildClick(Sender: TObject);
    procedure BrowseClick(Sender: TObject);
    procedure SourceButtonClick(Sender: TObject);
  private
    procedure Localize;
  public
    function Edit(var ConnStr: WideString): boolean;
  end;

  //lxj
var
  theThirdConnection: TAdoConnection;
{$ENDIF}
implementation

{$IFDEF DM_ADO}
uses RM_Const, RM_Common, RM_utils, RM_PropInsp, RM_Insp;

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

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDADODatabase}

constructor TRMDADODatabase.Create;
begin
  inherited Create;
  BaseName := 'ADODatabase';
  FBmpRes := 'RMD_ADODB';

  DontUndo := True;
  FDatabase := TADOConnection.Create(RMDialogForm);
  FComponent := FDatabase;
end;

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

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

procedure TRMDADODatabase.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  ConnectionString := RMReadString(aStream);
  LoginPrompt := RMReadBoolean(aStream);
  CursorLocation := TCursorLocation(RMReadByte(aStream));
  Connected := RMReadBoolean(aStream);
end;

procedure TRMDADODatabase.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, ConnectionString);
  RMWriteBoolean(aStream, LoginPrompt);
  RMWriteByte(aStream, Byte(CursorLocation));
  RMWriteBoolean(aStream, Connected);
end;

procedure TRMDADODatabase.ShowEditor;
var
  InitialConnStr: WideString;
  tmp: TRMDFormADOConnEdit;
begin
  tmp := TRMDFormADOConnEdit.Create(nil);
  try
    InitialConnStr := FDatabase.ConnectionString;
    if tmp.Edit(InitialConnStr) then
    begin
      RMDesigner.BeforeChange;
      FDatabase.Connected := FALSE;
      FDatabase.ConnectionString := InitialConnStr;
      RMDesigner.AfterChange;
    end;
  finally
    tmp.Free;
  end;
end;

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

procedure TRMDADODatabase.SetConnected(Value: Boolean);
begin
  FDatabase.Connected := Value;
end;

function TRMDADODatabase.GetConnectionString: WideString;
begin
  Result := FDatabase.ConnectionString;
end;

procedure TRMDADODatabase.SetConnectionString(Value: WideString);
begin
  FDatabase.Connected := False;
  FDatabase.ConnectionString := Value;
end;

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

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

function TRMDADODatabase.GetCursorLocation: TCursorLocation;
begin
  Result := FDatabase.CursorLocation;
end;

procedure TRMDADODatabase.SetCursorLocation(Value: TCursorLocation);
begin
  FDatabase.CursorLocation := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDADOTable}

constructor TRMDADOTable.Create;
begin
  inherited Create;
  BaseName := 'ADOTable';
  FBmpRes := 'RMD_ADOTABLE';

  FTable := TADOTable.Create(RMDialogForm);
  DataSet := FTable;
  FComponent := FTable;
  FIndexBased := False;
end;

procedure TRMDADOTable.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FTable.CursorLocation := TCursorLocation(RMReadByte(aStream));
end;

procedure TRMDADOTable.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteByte(aStream, Byte(FTable.CursorLocation));
end;

procedure TRMDADOTable.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 TRMDADOTable.GetIndexDefs: TIndexDefs;
begin
  Result := FTable.IndexDefs;
end;

function TRMDADOTable.GetIndexFieldNames: string;
begin
  Result := FTable.IndexFieldNames;
end;

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

function TRMDADOTable.GetDatabaseName: string;
begin
  Result := '';
  if FTable.Connection <> nil then
  begin
    Result := FTable.Connection.Name;
      //lxj
    if (FTable.Connection.Owner <> nil) and (FTable.Connection.Owner <> FTable.Owner) then
      Result := FTable.Connection.Owner.Name + '.' + Result;
  end;
end;

procedure TRMDADOTable.SetDatabaseName(const Value: string);
var
  liComponent: TComponent;
begin
  FTable.Close;
  liComponent := RMFindComponent(FTable.Owner, Value);
    //lxj
  if (liComponent = nil) and (theThirdConnection <> nil) and (theThirdConnection.Name = Value) then
    liComponent := theThirdConnection;

  if (liComponent <> nil) and (liComponent is TADOConnection) then
    FTable.Connection := TADOConnection(liComponent)
  else
    FTable.Connection := nil;  
end;

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

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

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

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

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

procedure TRMDADOTable.SetIndexName(Value: string);
begin
  FTable.IndexName := Value;
end;

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

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

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

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

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDADOQuery}

constructor TRMDADOQuery.Create;
begin
  inherited Create;
  BaseName := 'ADOQuery';
  FBmpRes := 'RMD_ADOQUERY';

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

procedure TRMDADOQuery.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FQuery.CursorLocation := TCursorLocation(RMReadByte(aStream));
end;

procedure TRMDADOQuery.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteByte(aStream, Byte(FQuery.CursorLocation));