连接本机的数据库是可以的，连接局域网的其他台机子的数据库就不行，代码如下：
//****************************数据对象**************************************
unit CommonDOImpl;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
MtsRdm, Mtx, SystemM_TLB, Provider, DB, ADODB,Variants;
type
TCommonDO = class(TMtsDataModule, ICommonDO)
Adoconn_Common: TADOConnection;
Adoqry_ExeSQL: TADOQuery;
dsp_ExeSQL: TDataSetProvider;
Adoqry_Common: TADOQuery;
dsp_Common: TDataSetProvider;
procedure MtsDataModuleActivate(Sender: TObject);
procedure MtsDataModuleDeactivate(Sender: TObject);
procedure MtsDataModuleCreate(Sender: TObject);
private
{ Private declarations }
protected
class procedure UpdateRegistry(Register: Boolean;
const ClassID, ProgID: string);
override;
function GetDataBySql(const SqlText: WideString): OleVariant;
safecall;
function GetOneBySql(const SqlText: WideString;
out MsgError: WideString): OleVariant;
safecall;
public
{ Public declarations }
end;
var
CommonDO: TCommonDO;
implementation
{$R *.DFM}
class procedure TCommonDO.UpdateRegistry(Register: Boolean;
const ClassID, ProgID: string);
begin
if Register then
begin
inherited UpdateRegistry(Register, ClassID, ProgID);
EnableSocketTransport(ClassID);
EnableWebTransport(ClassID);
end else
begin
DisableSocketTransport(ClassID);
DisableWebTransport(ClassID);
inherited UpdateRegistry(Register, ClassID, ProgID);
end;
end;
function TCommonDO.GetDataBySql(const SqlText: WideString): OleVariant;
begin
try
Adoqry_ExeSQL.Close;
Adoqry_ExeSQL.SQL.Clear;
Adoqry_ExeSQL.SQL.Add(SqlText);
Adoqry_ExeSQL.Open;
Result := dsp_ExeSQL.Data;
SetComplete;
Except
SetAbort;
end;
end;
function TCommonDO.GetOneBySql(const SqlText: WideString;
out MsgError: WideString): OleVariant;
var
i : Integer;
begin
try
Adoqry_ExeSQL.Close;
Adoqry_ExeSQL.SQL.Clear;
Adoqry_ExeSQL.SQL.Add(SqlText);
Adoqry_ExeSQL.Open;
if Adoqry_ExeSQL.RecordCount=0 then
Raise Exception.Create('没有找到合适的记录');
if Adoqry_ExeSQL.RecordCount>1 then
Raise Exception.Create('没有找到合适的记录');
Result := VarArrayCreate([0,Adoqry_ExeSQL.RecordCount-1],VarVariant);
for i := 0 to Adoqry_ExeSQL.RecordCount - 1do
// Iterate
Result := Adoqry_ExeSQL.Fields.Value;
SetComplete;
Except
on E: Exceptiondo
begin
MsgError := E.Message;
SetAbort;
end;
end;
end;
procedure TCommonDO.MtsDataModuleActivate(Sender: TObject);
begin
Adoconn_Common.Connected := True;
end;
procedure TCommonDO.MtsDataModuleDeactivate(Sender: TObject);
begin
Adoconn_Common.Connected := False;
end;
procedure TCommonDO.MtsDataModuleCreate(Sender: TObject);
var
FileName : array[0..255] of Char;
SystemPath : string;
begin
GetModuleFileName(hInstance , FileName , 255);
SystemPath := ExtractFilePath(FileName);
try
Adoconn_Common.Connected := False;
Adoconn_Common.ConnectionString := 'FILE NAME='+SystemPath+'Data.udl';
Except
on e: Exceptiondo
begin
Application.HandleException(Sender);
Raise;
end;
end;
end;
initialization
TComponentFactory.Create(ComServer, TCommonDO,
Class_CommonDO, ciMultiInstance, tmApartment);
end.
//****************************业务对象**************************************
unit SystemMBOImpl;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ActiveX, Mtsobj, Mtx, ComObj, SystemM_TLB, StdVcl;
type
TSystemMBO = class(TMtsAutoObject, ISystemMBO)
private
ICommonDObject : ICommonDO;
protected
//通用库
function GetDataBySql(const SqlText: WideString): OleVariant;
safecall;
function GetOneBySql(const SqlText: WideString;
out MsgError: WideString): OleVariant;
safecall;
end;
implementation
uses ComServ;
function TSystemMBO.GetDataBySql(const SqlText: WideString): OleVariant;
begin
try
OleCheck(ObjectContext.CreateInstance(CLASS_CommonDO,IID_ICommonDO,
ICommonDObject));
Result := ICommonDObject.GetDataBySql(SqlText);
SetComplete;
except
SetAbort;
Raise;
end;
end;
function TSystemMBO.GetOneBySql(const SqlText: WideString;
out MsgError: WideString): OleVariant;
begin
try
OleCheck(ObjectContext.CreateInstance(CLASS_CommonDO,IID_ICommonDO,
ICommonDObject));
Result := ICommonDObject.GetOneBySql(SqlText,MsgError);
SetComplete;
except
SetAbort;
Raise;
end;
end;
initialization
TAutoObjectFactory.Create(ComServer, TSystemMBO, Class_SystemMBO,
ciMultiInstance, tmApartment);
end.
