rmd_midas.pas

这是一个功能强大

end;

procedure TRMDSocketConnection.SetHost(Value: string);
begin
  FSocketConnection.Host := Value;
end;

function TRMDSocketConnection.GetInterceptGUID: string;
begin
  Result := FSocketConnection.InterceptGUID;
end;

procedure TRMDSocketConnection.SetInterceptGUID(Value: string);
begin
  FSocketConnection.InterceptGUID := Value;
end;

function TRMDSocketConnection.GetPort: Integer;
begin
  Result := FSocketConnection.Port;
end;

procedure TRMDSocketConnection.SetPort(Value: Integer);
begin
  FSocketConnection.Port := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDClientDataSet }

constructor TRMDClientDataSet.Create;
begin
  inherited Create;
  BaseName := 'ClientDataSet';
  FBmpRes := 'RMD_CLIENTDATASET';

  FTable := TClientDataSet.Create(RMDialogForm);
  DataSet := FTable;
end;

destructor TRMDClientDataSet.Destroy;
begin
  inherited Destroy;
end;

function TRMDClientDataSet.GetPropValue(aObject: TObject; aPropName: string;
  var aValue: Variant; Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'CLIENTDATASET' then
    aValue := O2V(FTable)
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

procedure TRMDClientDataSet.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FFixupList['RemoteServer'] := RMReadString(aStream);
  FFixupList['ProviderName'] := RMReadString(aStream);
  FTable.CommandText := RMReadString(aStream);
  FTable.PacketRecords := RMReadInt32(aStream);
end;

procedure TRMDClientDataSet.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, RemoteServer);
  RMWriteString(aStream, FTable.ProviderName);
  RMWriteString(aStream, FTable.CommandText);
  RMWriteInt32(aStream, FTable.PacketRecords);
end;

function TRMDClientDataSet.GetRemoteServer: string;
begin
  Result := '';
  if FTable.RemoteServer <> nil then
  begin
    Result := FTable.RemoteServer.Name;
    if FTable.RemoteServer.Owner <> FTable.Owner then
      Result := FTable.RemoteServer.Owner.Name + '.' + Result;
  end;
end;

procedure TRMDClientDataSet.SetRemoteServer(Value: string);
var
  d: TComponent;
begin
  FTable.Active := False;
  d := RMFindComponent(FTable.Owner, Value);
  if d is TCustomRemoteServer then
  begin
    FTable.Active := False;
    FTable.RemoteServer := TCustomRemoteServer(d);
  end;
end;

function TRMDClientDataSet.GetProviderName: string;
begin
  Result := FTable.ProviderName;
end;

procedure TRMDClientDataSet.SetProviderName(Value: string);
begin
  FTable.Active := False;
  FTable.ProviderName := Value;
end;

function TRMDClientDataSet.GetCommandText: string;
begin
  Result := FTable.CommandText;
end;

procedure TRMDClientDataSet.SetCommandText(Value: string);
begin
  FTable.CommandText := Value;
end;

function TRMDClientDataSet.GetPacketRecords: Integer;
begin
  Result := FTable.PacketRecords;
end;

procedure TRMDClientDataSet.SetPacketRecords(Value: Integer);
begin
  FTable.PacketRecords := Value;
end;

procedure TRMDClientDataSet.GetIndexNames(sl: TStrings);
begin
  try
    if FTable.ProviderName <> '' then
    begin
      FTable.GetIndexNames(sl);
    end;
  except
  end;
end;

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

type
  THackRemoveServer = class(TCustomRemoteServer)
  end;

procedure TRMDClientDataSet.AfterLoaded;
begin
  try
    RemoteServer := FFixupList['RemoteServer'];
    ProviderName := FFixupList['ProviderName'];
  except;
  end;

  inherited AfterLoaded;
end;

function TRMDClientDataSet.GetDatabaseName: string;
begin
  Result := '';
end;

procedure TRMDClientDataSet.SetDatabaseName(const Value: string);
begin
end;

function TRMDClientDataSet.GetTableName: string;
begin
  Result := '';
end;

procedure TRMDClientDataSet.SetTableName(Value: string);
begin
end;

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

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

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

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

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

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

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

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

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

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


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
type
  TRMDDComConnection_ServerNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TRMDDComConnection_ObjectBrokerEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TRMDSocketConnection_ServerNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TRMDClientDataSet_RemoteServerEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TRMDClientDataSet_ProviderNameEditor = class(TELStringPropEditor)
  private
    FProviderNames: TStringList;
    procedure GetOneProviderName(const s: string);
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDDComConnection_ServerNameEditor }

function TRMDDComConnection_ServerNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TRMDDComConnection_ServerNameEditor.GetValues(AValues: TStrings);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    GetMIDASAppServerList(sl, '');
    sl.Sort;
    aValues.Assign(sl);
  finally
    sl.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDDComConnection_ObjectBrokerEditor }

function TRMDDComConnection_ObjectBrokerEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TRMDDComConnection_ObjectBrokerEditor.GetValues(AValues: TStrings);
begin
  try
    RMGetComponents(RMDialogForm, TCustomObjectBroker, AValues, nil);
  finally
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDSocketConnection_ServerNameEditor }

function TRMDSocketConnection_ServerNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TRMDSocketConnection_ServerNameEditor.GetValues(AValues: TStrings);
var
  lSocketConnection: TSocketConnection;
  sl: TStringList;
  tmp: OleVariant;
  i, liCount: Integer;
begin
  lSocketConnection := TRMDSocketConnection(GetInstance(0)).FSocketConnection;
  sl := TStringList.Create;
  try
    tmp := THackSocketConnection(lSocketConnection).GetServerList;
    if tmp <> Null then
    begin
      liCount := VarArrayDimCount(tmp);
      for i := 0 to liCount do
      begin
        aValues.Add(tmp[i]);
      end;
    end;
  finally
    sl.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDClientDataSet_RemoteServerEditor }

function TRMDClientDataSet_RemoteServerEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TRMDClientDataSet_RemoteServerEditor.GetValues(AValues: TStrings);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    RMGetComponents(RMDialogForm, TCustomRemoteServer, sl, nil);
    sl.Sort;
    aValues.Assign(sl);
  finally
    sl.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDClientDataSet_ProviderNameEditor }

function TRMDClientDataSet_ProviderNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TRMDClientDataSet_ProviderNameEditor.GetOneProviderName(const s: string);
begin
  FProviderNames.Add(s);
end;

procedure TRMDClientDataSet_ProviderNameEditor.GetValues(AValues: TStrings);
var
  lClientDataSet: TClientDataSet;
begin
  lClientDataSet := TRMDClientDataSet(GetInstance(0)).FTable;
  if lClientDataSet.RemoteServer <> nil then
  begin
    FProviderNames := TStringList.Create;
    try
      THackRemoveServer(lClientDataSet.RemoteServer).GetProviderNames(GetOneProviderName);
      aValues.Assign(FProviderNames);
    finally
      FProviderNames.Free;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

const
	cReportMachine = 'RMD_midas';

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass(cReportMachine, TRMDDCOMConnection, 'TRMDDCOMConnection');
    AddClass(cReportMachine, TRMDSocketConnection, 'TRMDSocketConnection');
    AddClass(cReportMachine, TRMDClientDataSet, 'TRMDClientDataSet');
  end;
end;

initialization
//  RMRegisterControl(TRMDDComConnection, 'RMD_DCOMCONNECTIONCONTROL', RMLoadStr(rmRes + 2497));
//  RMRegisterControl(TRMDSocketConnection, 'RMD_SOCKETCONNECTIONCONTROL', RMLoadStr(rmRes + 2498));
//  RMRegisterControl(TRMDClientDataSet, 'RMD_CLIENTDATASETCONTROL', RMLoadStr(rmRes + 2496));
  RMRegisterControls('MIDAS', 'RMD_MIDASPATH', True,
    [TRMDDComConnection, TRMDSocketConnection, TRMDClientDataSet],
    ['RMD_DCOMCONNECTIONCONTROL', 'RMD_SOCKETCONNECTIONCONTROL', 'RMD_CLIENTDATASETCONTROL'],
    [RMLoadStr(rmRes + 2497), RMLoadStr(rmRes + 2498), RMLoadStr(rmRes + 2496)]);

  RMRegisterPropEditor(TypeInfo(string), TRMDDComConnection, 'ServerName', TRMDDComConnection_ServerNameEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDDComConnection, 'ObjectBroker', TRMDDComConnection_ObjectBrokerEditor);

  RMRegisterPropEditor(TypeInfo(string), TRMDSocketConnection, 'ObjectBroker', TRMDDComConnection_ObjectBrokerEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDSocketConnection, 'ServerName', TRMDSocketConnection_ServerNameEditor);

  RMRegisterPropEditor(TypeInfo(string), TRMDClientDataSet, 'RemoteServer', TRMDClientDataSet_RemoteServerEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDClientDataSet, 'ProviderName', TRMDClientDataSet_ProviderNameEditor);

  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);
finalization
{$ENDIF}
end.