rmd_midas.pas

这是一个功能强大

{*****************************************}
{                                         }
{           Report Machine 2.0           }
{       Wrapper for Diamond Access        }
{                                         }
{*****************************************}

unit RMD_midas;

interface

{$I RM.INC}
{$IFDEF DM_MIDAS}
uses
  Classes, SysUtils, Forms, ExtCtrls, DB, Controls, StdCtrls, DBClient, MConnect,
  SConnect, RM_Class, RM_Dataset, RMD_DBWrap, RM_Parser, RM_Common
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

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

  { TRMDDCOMConnection }
  TRMDDCOMConnection = class(TRMDialogComponent)
  private
    FFixupList: TRMVariables;
    FDCOMConnection: TDCOMConnection;
    function GetComputerName: string;
    procedure SetComputerName(Value: string);
    function GetConnected: Boolean;
    procedure SetConnected(Value: Boolean);
    function GetLoginPrompt: Boolean;
    procedure SetLoginPrompt(Value: Boolean);
    function GetObjectBroker: string;
    procedure SetObjectBroker(Value: string);
    function GetServerGUID: string;
    procedure SetServerGUID(Value: string);
    function GetServerName: string;
    procedure SetServerName(Value: string);
  protected
    procedure AfterChangeName; override;
    procedure AfterLoaded; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
  published
    property ComputerName: string read GetComputerName write SetComputerName;
    property Connected: Boolean read GetConnected write SetConnected;
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt;
    property ObjectBroker: string read GetObjectBroker write SetObjectBroker;
    property ServerGUID: string read GetServerGUID write SetServerGUID;
    property ServerName: string read GetServerName write SetServerName;
    property DCOMConnection: TDCOMConnection read FDCOMConnection;
  end;

  { TRMDSocketConnection }
  TRMDSocketConnection = class(TRMDialogComponent)
  private
    FFixupList: TRMVariables;
    FSocketConnection: TSocketConnection;

    function GetAddress: string;
    procedure SetAddress(Value: string);
    function GetConnected: Boolean;
    procedure SetConnected(Value: Boolean);
    function GetLoginPrompt: Boolean;
    procedure SetLoginPrompt(Value: Boolean);
    function GetObjectBroker: string;
    procedure SetObjectBroker(Value: string);
    function GetServerGUID: string;
    procedure SetServerGUID(Value: string);
    function GetServerName: string;
    procedure SetServerName(Value: string);
    function GetHost: string;
    procedure SetHost(Value: string);
    function GetInterceptGUID: string;
    procedure SetInterceptGUID(Value: string);
    function GetPort: Integer;
    procedure SetPort(Value: Integer);
  protected
    procedure AfterChangeName; override;
    procedure AfterLoaded; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
  published
    property Address: string read GetAddress write SetAddress;
    property Connected: Boolean read GetConnected write SetConnected;
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt;
    property ObjectBroker: string read GetObjectBroker write SetObjectBroker;
    property ServerGUID: string read GetServerGUID write SetServerGUID;
    property ServerName: string read GetServerName write SetServerName;
    property Host: string read GetHost write SetHost;
    property InterceptGUID: string read GetInterceptGUID write SetInterceptGUID;
    property Port: Integer read GetPort write SetPort;
    property SocketConnection: TSocketConnection read FSocketConnection;
  end;

  { TRMDClientDataSet }
  TRMDClientDataSet = class(TRMDTable)
  private
    FTable: TClientDataSet;

    function GetRemoteServer: string;
    procedure SetRemoteServer(Value: string);
    function GetProviderName: string;
    procedure SetProviderName(Value: string);
    function GetCommandText: string;
    procedure SetCommandText(Value: string);
    function GetPacketRecords: Integer;
    procedure SetPacketRecords(Value: Integer);
  protected
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;

    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 GetIndexFieldNames: string; override;
    procedure SetIndexFieldNames(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 GetIndexDefs: TIndexDefs; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure AfterLoaded; override;

    property ClientDataSet: TClientDataSet read FTable;
  published
    property RemoteServer: string read GetRemoteServer write SetRemoteServer;
    property ProviderName: string read GetProviderName write SetProviderName;
    property CommandText: string read GetCommandText write SetCommandText;
    property PacketRecords: Integer read GetPacketRecords write SetPacketRecords;
    property IndexName;
  end;
{$ENDIF}

implementation

{$IFDEF DM_MIDAS}
{$R RMD_MIDAS.RES}

uses RM_Const, RM_utils, RM_PropInsp, RM_Insp;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDDCOMConnection }

constructor TRMDDCOMConnection.Create;
begin
  inherited Create;
  BaseName := 'DCOMConnection';
  FBmpRes := 'RMD_DCOMConnection';

  DontUndo := True;
  FDCOMConnection := TDCOMConnection.Create(RMDialogForm);
  FFixupList := TRMVariables.Create;
  FComponent := FDCOMConnection;
end;

destructor TRMDDCOMConnection.Destroy;
begin
  FFixupList.Free;
  if Assigned(RMDialogForm) then
  begin
    FDCOMConnection.Free;
    FDCOMConnection := nil;
  end;

  inherited Destroy;
end;

procedure TRMDDCOMConnection.AfterChangeName;
begin
  FDCOMConnection.Name := Name;
end;

procedure TRMDDCOMConnection.AfterLoaded;
begin
  try
    ObjectBroker := FFixupList['ObjectBroker'];
  except;
  end;

  inherited AfterLoaded;
end;

procedure TRMDDCOMConnection.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FDCOMConnection.ComputerName := RMReadString(aStream);
  FDCOMConnection.LoginPrompt := RMReadBoolean(aStream);
  FDCOMConnection.ServerGUID := RMReadString(aStream);
  FDCOMConnection.ServerName := RMReadString(aStream);
  FFixupList['ObjectBroker'] := RMReadString(aStream);
end;

procedure TRMDDCOMConnection.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, FDCOMConnection.ComputerName);
  RMWriteBoolean(aStream, FDCOMConnection.LoginPrompt);
  RMWriteString(aStream, FDCOMConnection.ServerGUID);
  RMWriteString(aStream, FDCOMConnection.ServerName);
  RMWriteString(aStream, ObjectBroker);
end;

function TRMDDCOMConnection.GetComputerName: string;
begin
  Result := FDCOMConnection.ComputerName;
end;

procedure TRMDDCOMConnection.SetComputerName(Value: string);
begin
  FDCOMConnection.ComputerName := Value;
end;

function TRMDDCOMConnection.GetConnected: Boolean;
begin
  Result := FDCOMConnection.Connected;
end;

procedure TRMDDCOMConnection.SetConnected(Value: Boolean);
begin
  FDCOMConnection.Connected := Value;
end;

function TRMDDCOMConnection.GetLoginPrompt: Boolean;
begin
  Result := FDCOMConnection.LoginPrompt;
end;

procedure TRMDDCOMConnection.SetLoginPrompt(Value: Boolean);
begin
  FDCOMConnection.LoginPrompt := Value;
end;

function TRMDDCOMConnection.GetObjectBroker: string;
begin
  Result := '';
  if FDCOMConnection.ObjectBroker <> nil then
  begin
    Result := FDCOMConnection.ObjectBroker.Name;
    if FDCOMConnection.ObjectBroker.Owner <> FDCOMConnection.Owner then
      Result := FDCOMConnection.ObjectBroker.Owner.Name + '.' + Result;
  end;
end;

procedure TRMDDCOMConnection.SetObjectBroker(Value: string);
var
  d: TComponent;
begin
  d := RMFindComponent(FDCOMConnection.Owner, Value);
  if d is TCustomObjectBroker then
    FDCOMConnection.ObjectBroker := TCustomObjectBroker(d);
end;

function TRMDDCOMConnection.GetServerGUID: string;
begin
  Result := FDCOMConnection.ServerGUID;
end;

procedure TRMDDCOMConnection.SetServerGUID(Value: string);
begin
  FDCOMConnection.ServerGUID := Value;
end;

function TRMDDCOMConnection.GetServerName: string;
begin
  Result := FDCOMConnection.ServerName;
end;

procedure TRMDDCOMConnection.SetServerName(Value: string);
begin
  FDCOMConnection.ServerName := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDSocketConnection }

constructor TRMDSocketConnection.Create;
begin
  inherited Create;
  BaseName := 'SocketConnection';
  FBmpRes := 'RMD_SocketConnection';

  DontUndo := True;
  FSocketConnection := TSocketConnection.Create(RMDialogForm);
  FComponent := FSocketConnection;
  FFixupList := TRMVariables.Create;
end;

destructor TRMDSocketConnection.Destroy;
begin
  FFixupList.Free;
  if Assigned(RMDialogForm) then
  begin
    FreeAndNil(FSocketConnection);
  end;

  inherited Destroy;
end;

procedure TRMDSocketConnection.AfterChangeName;
begin
  FSocketConnection.Name := Name;
end;

procedure TRMDSocketConnection.AfterLoaded;
begin
  try
    ObjectBroker := FFixupList['ObjectBroker'];
  except;
  end;

  inherited AfterLoaded;
end;

procedure TRMDSocketConnection.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FSocketConnection.Address := RMReadString(aStream);
  FSocketConnection.LoginPrompt := RMReadBoolean(aStream);
  FSocketConnection.ServerGUID := RMReadString(aStream);
  FSocketConnection.ServerName := RMReadString(aStream);
  FFixupList['ObjectBroker'] := RMReadString(aStream);
  FSocketConnection.Host := RMReadString(aStream);
  FSocketConnection.InterceptGUID := RMReadString(aStream);
  FSocketConnection.Port := RMReadInt32(aStream);
end;

procedure TRMDSocketConnection.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, FSocketConnection.Address);
  RMWriteBoolean(aStream, FSocketConnection.LoginPrompt);
  RMWriteString(aStream, FSocketConnection.ServerGUID);
  RMWriteString(aStream, ServerName);
  RMWriteString(aStream, ObjectBroker);
  RMWriteString(aStream, FSocketConnection.Host);
  RMWriteString(aStream, FSocketConnection.InterceptGUID);
  RMWriteInt32(aStream, FSocketConnection.Port);
end;

type
  THackSocketConnection = class(TSocketConnection)
  end;

function TRMDSocketConnection.GetAddress: string;
begin
  Result := FSocketConnection.Address;
end;

procedure TRMDSocketConnection.SetAddress(Value: string);
begin
  FSocketConnection.Address := Value;
end;

function TRMDSocketConnection.GetConnected: Boolean;
begin
  Result := FSocketConnection.Connected;
end;

procedure TRMDSocketConnection.SetConnected(Value: Boolean);
begin
  FSocketConnection.Connected := Value;
end;

function TRMDSocketConnection.GetLoginPrompt: Boolean;
begin
  Result := FSocketConnection.LoginPrompt;
end;

procedure TRMDSocketConnection.SetLoginPrompt(Value: Boolean);
begin
  FSocketConnection.LoginPrompt := Value;
end;

function TRMDSocketConnection.GetObjectBroker: string;
begin
  Result := '';
  if FSocketConnection.ObjectBroker <> nil then
  begin
    Result := FSocketConnection.ObjectBroker.Name;
    if FSocketConnection.ObjectBroker.Owner <> FSocketConnection.Owner then
      Result := FSocketConnection.ObjectBroker.Owner.Name + '.' + Result;
  end;
end;

procedure TRMDSocketConnection.SetObjectBroker(Value: string);
var
  d: TComponent;
begin
  d := RMFindComponent(FSocketConnection.Owner, Value);
  if d is TCustomObjectBroker then
    FSocketConnection.ObjectBroker := TCustomObjectBroker(d);
end;

function TRMDSocketConnection.GetServerGUID: string;
begin
  Result := FSocketConnection.ServerGUID;
end;

procedure TRMDSocketConnection.SetServerGUID(Value: string);
begin
  FSocketConnection.ServerGUID := Value;
end;

function TRMDSocketConnection.GetServerName: string;
begin
  Result := FSocketConnection.ServerName;
end;

procedure TRMDSocketConnection.SetServerName(Value: string);
begin
  FSocketConnection.ServerName := Value;
end;

function TRMDSocketConnection.GetHost: string;
begin
  Result := FSocketConnection.Host;