我在网上找到一个程序，可以做为一个转发中心，将所有请求送到这里后，它有能力
将这一请求发到适当的服务器。不过，这个程序是用TSocketConnection做的，我还不
如何将它改为DCOM的。以下是它的部分源代码：
//------------------------------------------------------------------------------
//
// Programm : ovrMIDASwr (MIDAS interface wrapper, calls router)
//
// v 1.01 09/1999 Freeware
//
// by Al-dr Petroff, APetrov@ase.ru
// ASE Group (Advanced System Engineering)
// http://www.ase.ru/
// (Full english version of our ovrMIDAS platform is under construction)
//
//------------------------------------------------------------------------------
// MIDAS 3 only (Delphi 5)
//------------------------------------------------------------------------------
//
// This program perfoms some OleEnterprise features
// for SocketsConnections (MIDAS):
// 1. All clients can points to only this one RemoteServer
// (this RemoteServer hold its Global Object repository in simple inifile)
// 2. Clients can communicate with any selected RemoteServer
// in two ways:
// a. continue communicate with ovrMIDASWr as with desired RemoteServer
// - this way allows to bypass some network restrictions and
// can switch before different TDispatchConnection types.
// - you can also obtain chained interface for direct operation
// b. obtain from ovrMIDASWr actual addres of desired RemoteServer
// and set own direct connection with RemoteServer.
//
// 3. RemoteServers being started can inform ovrMIDASWr about its new
// actual location or substitute another RemoteServers
// 4. Kills on-place-depending problems (debug, installation, support ...)
// 5. Optionally can fully support ObjectBrokers model.
// 6. Optionally can offer additional centalizaed monitor/proxy functions
// (access control, ping, trace etc) .
// 7. Optionally can offer many others simple benefits.
//
// !!! it do
es support users chained Ole methods calls.
//
//
// For example, you can put ovrMIDASWr on web server, and points
// all your clients to it - now you can communicate with desired
// RemoteServer behind the firewall. All required installation
// is only one ovrMIDASWr.exe file (size about 490K).
//
// As TDispatchConnection on client side TShConnection or TOverConnection
// recommended. They can transport chained interfaces. Or you can
// store returned chained interface to local variable.
//
// See ini file for more information.
//
//
// Is a very simple programm. Top effect with ovrMIDAS platform.
// 28/09/1999 by Al-dr Petroff APetrov@ase.ru
//
unit MIDASWrs;
interface
uses
Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
DBClient, MIDASWr_TLB, Stdvcl, Forms, Db, MConnect, SConnect, IniFiles;
// ExtCtrls;
type // !!! inherits from TDataModule, not TRemoteDataModule
// TRemoteDatamodule fails with "provider'*' not exported"
TMIDASWr_ = class(TDataModule, IMIDASWr)
Link: TSocketConnection;
private
{ Private declarations }
protected
class procedure UpdateRegistry(Register: Boolean;
const ClassID, ProgID: string);
override;
procedure CheckLink;//internal use
function CheckChainedIsWrapper(DC : TDispatchConnection) : boolean;
public
{ Public declarations }
// basic MIDAS API calls substitution
function AS_ApplyUpdates(const ProviderName: WideString;
Delta: OleVariant;
MaxErrors: Integer;
out ErrorCount: Integer;
var OwnerData: OleVariant): OleVariant;
safecall;
function AS_DataRequest(const ProviderName: WideString;
Data: OleVariant): OleVariant;
safecall;
procedure AS_Execute(const ProviderName: WideString;
const CommandText: WideString;
var Params, OwnerData: OleVariant);
safecall;
function AS_GetProviderNames: OleVariant;
safecall;
function AS_GetParams(const ProviderName: WideString;
var Ownerdata: OleVariant): OleVariant;
safecall;
function AS_GetRecords(const ProviderName: WideString;
Count: Integer;
out RecsOut: Integer;
Options: Integer;
const CommandText: WideString;
var Params, OwnerData:OleVariant): OleVariant;
safecall;
function AS_RowRequest(const ProviderName: WideString;
Row: OleVariant;
RequestType: Integer;
var OwnerData: OleVariant): OleVariant;
safecall;
// set connection with desired RemoteServer (from its Repository)
// AS_DataRequest('*',[<ServerAlias>]):VariantInterface
// so after this call you can use chained IAppServer directly
// for example, add in TXXXConnection.onAfterConnect on client side line as_DataRequest('*',['MyServer'])
// and alldo
ne.
function do
Link(AServerAlias : string;
ReturnInterface : boolean=false;
ALink : TSocketConnection=nil) : OleVariant;
//adds/updates RemoteServer info in repository
// AS_DataRequesr('=',[<ServerAlias>,<ServerInformation>])
procedure SetLink(AServerAlias : string;
Settings : OleVariant);
//returns actual location of desired RemoteServer
// AS_DataRequesr('*',[<ServerAlias>]):<ServerInformation>
function GetLink(AServerAlias : string) : OleVariant;
end;
implementation
{$R *.DFM}
function TMIDASWr_.AS_ApplyUpdates(const ProviderName: WideString;
Delta: OleVariant;
MaxErrors: Integer;
out ErrorCount: Integer;
var OwnerData: OleVariant): OleVariant;
begin
// just redirects
Result:=Link.GetServer.AS_ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
end;
function TMIDASWr_.AS_DataRequest(const ProviderName: WideString;
Data: OleVariant): OleVariant;
begin
case ProviderName[1] of
//return interface of chained app server for MasterConnection (Link)
'*' : Result:=DoLink(Data[0],Data[1],Link);
//return current connection attributes for required app server
'?' : Result:=GetLink(Data[0]);//GetLink
//set current connection attributes for required app server
'=' : SetLink(Data[0],Data[1]);//SetLink
//setting connection with some additional chained app server and return it's interface
//here you can share some remoted interfaces in single connection
'@' : Result:=DoLink(Data[0],true);
else
begin
CheckLink;
Result:=Link.GetServer.AS_DataRequest(ProviderName, Data);
end
end;
end;
procedure TMIDASWr_.AS_Execute(const ProviderName, CommandText: WideString;
var Params, OwnerData: OleVariant);
begin
CheckLink;
Link.GetServer.AS_Execute(ProviderName, CommandText, Params, OwnerData);
end;
function TMIDASWr_.AS_GetParams(const ProviderName: WideString;
var Ownerdata: OleVariant): OleVariant;
begin
CheckLink;
Result:=Link.GetServer.AS_GetParams(ProviderName,OwnerData);
end;
function TMIDASWr_.AS_GetProviderNames: OleVariant;
begin
CheckLink;
Result:=Link.GetServer.AS_GetProviderNames;
end;
function TMIDASWr_.AS_GetRecords(const ProviderName: WideString;
Count: Integer;
out RecsOut: Integer;
Options: Integer;
const CommandText: WideString;
var Params,
OwnerData: OleVariant): OleVariant;
begin
CheckLink;
Result:=Link.GetServer.AS_GetRecords(ProviderName,Count,RecsOut,Options,CommandText,Params,OwnerData);
end;
function TMIDASWr_.AS_RowRequest(const ProviderName: WideString;
Row: OleVariant;
RequestType: Integer;
var OwnerData: OleVariant): OleVariant;
begin
CheckLink;
Result:=Link.GetServer.AS_RowRequest(ProviderName,Row,RequestType,OwnerData);
end;
class procedure TMIDASWr_.UpdateRegistry(Register: Boolean;
const ClassID, ProgID: string);
begin
if Register then
begin
inherited UpdateRegistry(Register, ClassID, ProgID);
EnableSocketTransport(ClassID);
EnableWebTransport(ClassID);
RegisterPooled(ClassId,16,10);
end else
begin
DisableSocketTransport(ClassID);
DisableWebTransport(ClassID);
UnRegisterPooled(ClassId);
inherited UpdateRegistry(Register, ClassID, ProgID);
end;
end;
function TMIDASWr_.DoLink(AServerAlias: string;
ReturnInterface : boolean=false;
ALink : TSocketConnection=nil) : OleVariant;
var ServerSect : string[40];
S : String;
wLink : TSocketConnection;
begin
// just reads server settings from inf file,
// using global defaults in common section
// create connection component if nedeed
Result:=null;
if Assigned(ALink)
then
wLink:=ALink
else
wLink:=TSocketConnection.Create(Self);
wLink.Connected:=false;
S:=ChangeFileExt(ParamStr(0),'.ini');
with TIniFile.Create(S)do
try
if AServerAlias=''
then
ServerSect:=ReadString('Common','Default','')
else
ServerSect:=AServerAlias;
wLink.Host:='';
wLink.Address:=ReadString(ServerSect,'Address',ReadString('Common','Address',''));
wLink.InterceptGUID:=ReadString(ServerSect,'InterceptGUID',ReadString('Common','InterceptGUID',''));
wLink.Address:=ReadString(ServerSect,'Address',ReadString('Common','Address',''));
wLink.ServerName:=ReadString(ServerSect,'ServerName',ReadString('Common','ServerName',''));
wLink.ServerGUID:=ReadString(ServerSect,'ServerGUID',ReadString('Common','ServerGUID',''));
wLink.Port:=ReadInteger(ServerSect,'Port',ReadInteger('Common','Port',211));
wLink.SupportCallbacks:=ReadBool(ServerSect,'SupportCallbacks',ReadBool('Common','SupportCallbacks',true));
S:=ReadString(ServerSect,'Host',ReadString('Common','Host',''));
if (S<>'') and (wLink.Address='') then
wLink.Host:=S;
finally
free
end;
if ReturnInterface then
begin
wLink.Connected:=true;
if CheckChainedIsWrapper(wLink) //immidiate chained request for multi chained interfaces
then
Result:=wLink.GetServer.AS_DataRequest('@',VarArrayOf([AServerAlias, true]))
else
Result:=wLink.AppServer;
end;
end;
procedure TMIDASWr_.CheckLink;
begin
// sets default connection if needed
if Link.Connected then
exit;
if Link.Port<0 then
do
Link('');
Link.Connected:=true;
end;
function TMIDASWr_.GetLink(AServerAlias: string) : OleVariant;
var ServerSect : string[40];
S : String;
begin
// packs desired repository section into OleVariant data
// format: [[<PropertyName>,<PropertyValue>],...]
S:=ChangeFileExt(ParamStr(0),'.ini');
with TIniFile.Create(S)do
try
if AServerAlias=''
then
ServerSect:=ReadString('Common','Default','')
else
ServerSect:=AServerAlias;
Result:=VarArrayOf([
VarArrayOf(['Address',ReadString(ServerSect,'Address',ReadString('Common','Address','127.0.0.1'))]),
VarArrayOf(['InterceptGUID',ReadString(ServerSect,'InterceptGUID',ReadString('Common','InterceptGUID',''))]),
VarArrayOf(['ServerName',ReadString(ServerSect,'ServerName',ReadString('Common','ServerName',''))]),
VarArrayOf(['ServerGUID',ReadString(ServerSect,'ServerGUID',ReadString('Common','ServerGUID',''))]),
VarArrayOf(['ReadInteger',ReadString(ServerSect,'Port',ReadString('Common','Port','211'))]),
VarArrayOf(['SupportCallbacks',ReadString(ServerSect,'SupportCallbacks',ReadString('Common','SupportCallbacks','1'))]),
VarArrayOf(['Host',ReadString(ServerSect,'Host',ReadString('Common','Host',''))])
]);
finally
free
end
end;
procedure TMIDASWr_.SetLink(AServerAlias: string;
Settings : OleVariant);
var ServerSect : string[40];
S : String;
I : Integer;
begin
//writes/update actual RemoteServer settings
S:=ChangeFileExt(ParamStr(0),'.ini');
with TIniFile.Create(S)do
try
if AServerAlias=''
then
ServerSect:=ReadString('Common','Default','')
else
ServerSect:=AServerAlias;
try EraseSection(ServerSect) except end;
for I:=0 to VarArrayHighBound(Settings,1)do
if not VarIsNull(Settings
[1]) and
(string(Settings[1])<>'')
then
WriteString(ServerSect,Settings[0],Settings[1]);
finally
free
end
end;
// that'all
function TMIDASWr_.CheckChainedIsWrapper(DC: TDispatchConnection): boolean;
// the simplest
var I : IMidasWr;
begin
DC.GetServer.QueryInterface( IMidasWr,I);
Result:=Assigned(I);
I:=nil;
end;
initialization
TComponentFactory.Create(ComServer, TMIDASWr_,
Class_MIDASWr_, ciMultiInstance, tmApartment);
end.
