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 Delphi6}, Variants{$ENDIF};

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

  TRMDADODatabase = class(TRMNonVisualControl)
  private
    FDatabase: TADOConnection;
    procedure PropEditor(Sender: TObject);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): 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: TADOConnection read FDatabase;
  end;

 { TRMDADOTable }
  TRMDADOTable = class(TRMDTable)
  private
    FTable: TADOTable;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    procedure GetIndexNames(sl: TStrings); override;

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

  { TRMDADOQuery }
  TRMDADOQuery = class(TRMDQuery)
  private
    FQuery: TADOQuery;
  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 DefineProperties; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  published
  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_CmpReg, RM_utils;

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

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

constructor TRMDADODatabase.Create;
begin
  inherited Create;
  FDatabase := TADOConnection.Create(RMDialogForm);
  Component := FDatabase;
  BaseName := 'ADODatabase';
  BmpRes := 'RMD_ADODB';
  Flags := Flags or flDontUndo;

  RMConsts['clUseClient'] := clUseClient;
  RMConsts['clUseServer'] := clUseServer;
end;

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

procedure TRMDADODatabase.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Connected', [rmdtBoolean], nil);
  AddProperty('DatabaseName', [rmdtString, rmdtHasEditor], PropEditor);
  AddProperty('LoginPrompt', [rmdtBoolean], nil);
  AddEnumProperty('CursorLocation',
    'clUseClient;clUseServer', [clUseClient, clUseServer], nil);
end;

procedure TRMDADODatabase.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'DATABASENAME' then
  begin
  	if FDatabase.Connected then FDatabase.Close;
    FDatabase.ConnectionString := Value;
  end
  else if Index = 'LOGINPROMPT' then
    FDatabase.LoginPrompt := Value
  else if Index = 'CONNECTED' then
    FDatabase.Connected := Value
  else if Index = 'CURSORLOCATION' then
    FDatabase.CursorLocation := Value
end;

function TRMDADODatabase.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'DATABASENAME' then
    Result := FDatabase.ConnectionString
  else if Index = 'LOGINPROMPT' then
    Result := FDatabase.LoginPrompt
  else if Index = 'CONNECTED' then
    Result := FDatabase.Connected
  else if Index = 'CURSORLOCATION' then
    Result := FDatabase.CursorLocation
end;

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

procedure TRMDADODatabase.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteString(Stream, FDatabase.ConnectionString);
  RMWriteBoolean(Stream, FDatabase.LoginPrompt);
  RMWriteBoolean(Stream, FDatabase.Connected);
  RMWriteByte(Stream, Byte(FDatabase.CursorLocation));
end;

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

procedure TRMDADODatabase.PropEditor(Sender: TObject);
var
  InitialConnStr: WideString;
begin
  with TRMDFormADOConnEdit.Create(Application) do
  begin
    try
      InitialConnStr := FDatabase.ConnectionString;
      if Edit(InitialConnStr) then
      begin
        FDatabase.Connected := FALSE;
        FDatabase.ConnectionString := InitialConnStr;
        RMDesigner.AfterChange;
      end;
    finally
      Free;
    end;
  end;
end;

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

constructor TRMDADOTable.Create;
begin
  inherited Create;
  FTable := TADOTable.Create(RMDialogForm);
  DataSet := FTable;

  Component := FTable;
  BaseName := 'ADOTable';
  BmpRes := 'RMD_ADOTABLE';
end;

procedure TRMDADOTable.GetDatabases(sl: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    RMGetComponents(RMDialogForm, TADOConnection, liStringList, nil);
    //lxj
    if theThirdConnection <> nil then
      liStringList.Add(theThirdConnection.Name);
    liStringList.Sort;
    sl.Assign(liStringList);
  finally
    liStringList.Free;
  end;
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;

procedure TRMDADOTable.GetTableNames(sl: TStrings);
var
  liStringList: TStringList;
begin
  if FTable.Connection <> nil then
  begin
    liStringList := TStringList.Create;
    try
      FTable.Connection.GetTableNames(liStringList);
      liStringList.Sort;
      sl.Assign(liStringList);
    finally
      liStringList.Free;
    end;
  end;
end;

procedure TRMDADOTable.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('CursorLocation', 'clUseClient;clUseServer', [clUseClient, clUseServer], nil);
end;

procedure TRMDADOTable.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);
    //lxj
    if (d = nil) and (theThirdConnection <> nil) and (theThirdConnection.Name = Value) then
      d := theThirdConnection;
    FTable.Connection := TADOConnection(d);
  end
  else if Index = 'CURSORLOCATION' then
    FTable.CursorLocation := Value
end;

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

  function GetDataBase(Owner: TComponent; d: TADOConnection): string;
  begin
    Result := '';
    if d <> nil then
    begin
      Result := d.Name;
      //lxj
      if (d.Owner <> nil) and (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
  else if Index = 'MASTERSOURCE' then
    Result := RMGetDataSetName(FTable.Owner, FTable.MasterSource)
  else if Index = 'MASTERFIELDS' then
    Result := FTable.MasterFields
  else if Index = 'TABLENAME' then