聊點基本功，就是“如何在DLL中活用Interface”
<Code 1>
{-----------------------------------------------------------------------------
  Unit: dmBaseModule
  Author:    Aleyn.wu
  Date:      2002-05-12
  Descript: Base Module Interface
-----------------------------------------------------------------------------}
unit dmBaseModule;

interface

uses
  Classes, SysUtils, Variants, hmOleDataSet, hmOleVariant;

type
  IBaseOle = interface;

IBaseService = interface
    ['{D40CB2CF-23FF-4C41-BB7E-C9FCD28AE7E7}']

//GetSqlLanguage  取得SQL语句
    function GetSqlLanguage(Index: integer; var Params, Body: WideString): Boolean; stdcall;

//InTranstion 服务层是否已经为事务中
    function InTranstion: WordBool; stdcall;

//GetInfo 取得服务层信息
    function GetInfo: WideString; stdcall;

procedure ShowMessage(Msg: WideString); stdcall;
    procedure OpenQuery(Sql: WideString); stdcall;
    procedure CloseQuery; stdcall;

//Execute 让服务层执行SQL语句
    procedure Execute(Sql: WideString); stdcall;

//GetFieldNames 取得某个表(Table)的所有栏位名称(FieldName)
    procedure GetFieldNames(TableName: WideString; var FieldNames: WideString); stdcall;

//BeginTrans 服务层开始事务
    procedure BeginTrans; stdcall;

//CommitTrans 服务层提交事务
    procedure CommitTrans; stdcall;

//RollbackTrans 服务层事务回滚（取消事务）
    procedure RollbackTrans; stdcall;

//ApplyUpdates　直接用Delta更新数据
    procedure ApplyUpdates(const Delta: OleVariant; TableName, KeyField: WideString); stdcall;

//ApplyUpdatesWithOle　 通知服务层 Delta已经在服务层的OleParam里，
    //                      名称为DeltaName 更新方式和ApplyUpdates一样
    procedure ApplyUpdatesWithOle(const DeltaName, TableName, KeyField: WideString); stdcall;

//ApplyUpdatesRecordInfo　
    procedure ApplyUpdatesRecordInfo(const DeltaName, TableName, KeyField: WideString); stdcall;

//ApplyUpdatesWithOle　 通知服务层 Delta已经在服务层的某一个DataSet里，
    //                      序号为DataSet 更新方式和ApplyUpdates一样
    procedure ApplyUpdatesWithDataSet(const DataSet: integer; TableName, KeyField: WideString); stdcall;

//ReceiveDataWithDefault 通知服务层，数据已经准备好，在缺省的Query里，请直接返回给客户。
    procedure ReceiveDataWithDefault; stdcall;

//ReceiveDataWithCustom 通知服务层，数据已经准备好，在OleParam里，请返回给客户。
    procedure ReceiveDataWithCustom; stdcall;

//ReceiveDataWithResult 通知服务层，数据在DLL函数中定义，请返回给客户。
    procedure ReceiveDataWithResult; stdcall;

//ReceiveDataWithNoData 通知服务层，DLL函数没有可返回的数据。
    procedure ReceiveDataWithNoData; stdcall;

//RaiseError 通知服务层产生一个异常信息给客户
    procedure RaiseError(Msg: WideString); stdcall;

//DropTable　通知服务层删除一个表格（实际上也是执行SQL删除表格语句）
    procedure DropTable(TableName: WideString); stdcall;

//AssignQueryToDataSet 通知服务层 缺省的Query需要从其它DataSet取得数据
    //             DataSetIndex:DataSet的序号
    //             DataSetField:DataSet Field Name
    //             QueryField :Query FieldName
    procedure AssignQueryToDataSet(DataSetIndex: integer; DataSetField, QueryField: WideString); stdcall;

//AssignQueryToDataSet 通知服务层 其它DataSet需要从缺省的Query取得数据
    procedure AssignDataSetToQuery(DataSetIndex: integer; DataSetField, QueryField: WideString); stdcall;

//从服务层取得一个16位的惟一键字串
    function UniKey: WideString; stdcall;

//取得服务层缺省Query的接口
    function GetQuery: IHMOleADOQuery; stdcall;

//取得服务层其它ClientDataSet的接口
    function GetDataSet(Index: integer): IHMOleClientDataSet; stdcall;

//取得服务层返回参数的接口（OLE格式）
    function GetOle: IBaseOle; stdcall;

//取得服务层客户参数接口（OleVariant格式）
    function GetParams: IHMOleVariant; stdcall;

//取务服务层刚刚执行的SQL语句所参生的记录总数
    function GetRecordsAffected: integer; stdcall;

property RecordsAffected: integer read GetRecordsAffected;
    property Query: IHMOleADOQuery read GetQuery;
    property DataSet[index: integer]: IHMOleClientDataSet read GetDataSet;
    property Ole: IBaseOle read GetOle;
    property Params: IHMOleVariant read GetParams;

end;

IBaseDataModule = interface
    ['{0CEF4911-3E0C-4AC9-AAD7-69CA907E3979}']

//取得本规则模块的信息
    function GetModuleInfo: WideString; stdcall;

//取得或设置服务层接口
    function GetBaseService: IBaseService; stdcall;
    procedure SetBaseService(const Value: IBaseService); stdcall;

//取得或设置本规则模块的序号
    function GetModule(): integer; stdcall;
    procedure SetModule(const value: integer); stdcall;

//服务层调用本规则的总入口
    function Operation(var Data, Msg: OleVariant): WordBool; stdcall;

// LoadOleParam暂时不用
    procedure LoadOleParam(const Param: OleVariant); stdcall;

property BaseService: IBaseService read GetBaseService write SetBaseService;
    property Module: integer read GetModule write SetModule;
    property ModuleInfo: WideString read GetModuleInfo;
  end;

IDataModuleInfo = interface
    ['{B1B99EE8-E0B5-475C-9E21-92E6B416065E}']
    function GetModuleName: WideString; stdcall;
    function GetVersion: Widestring; stdcall;
    function GetDesignner: Widestring; stdcall;
    function GetMemo: Widestring; stdcall;
    function GetLastUpdate: WideString; stdcall;
    function GetModuleIndex: Integer; stdcall;
    property ModuleIndex: Integer read GetModuleIndex;
  end;

IBaseOle = interface
    procedure AddDspAsName(Name: WideString); stdcall;
    procedure Clear; stdcall;
    function GetValue(Name: WideString): OleVariant; stdcall;
    procedure SetValue(Name: WideString; Value: OleVariant); stdcall;
    property Value[Name: WideString]: OleVariant read GetValue write SetValue;
  end;

implementation

end.

<code 2>

unit dmBaseService;

interface
uses
  Classes, Windows, SysUtils, Variants, dmBaseModule, hmUniKey, hmMemTools, DB,
  hmSqlTools, hmOleDataSet, hmOleVariant, hmDateTools;

type
  TReceiveDataType = (rdDefault, rdCustom, rdResult, rdNoData);
  TServiceState = (srStart, srStop, srPause);

type
  TSafeInterfacedObject = class(TObject, IUnknown)
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: integer; stdcall;
    function _Release: integer; stdcall;
  end;

type
  TBaseOle = class;

TBaseService = class(TSafeInterfacedObject, IBaseService)
  private
    FParent: TComponent;
    FOle: TBaseOle;
    FReceiveDataType: TReceiveDataType;
    function GetReceiveDataType: TReceiveDataType;
  protected
    procedure InnerApplyUpdates(TableName, KeyField: WideString); stdcall;
    procedure InnerApplyUpdates2(TableName, KeyField: WideString); stdcall;
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
    procedure Reset;
    function GetSqlLanguage(Index: integer; var Params, Body: WideString): Boolean; stdcall;
    function InTranstion: WordBool; stdcall;
    function GetInfo: WideString; stdcall;
    procedure ShowMessage(Msg: WideString); stdcall;
    procedure OpenQuery(Sql: WideString); stdcall;
    procedure CloseQuery; stdcall;
    procedure Execute(Sql: WideString); stdcall;
    procedure GetFieldNames(TableName: WideString; var FieldNames: WideString); stdcall;
    procedure BeginTrans; stdcall;
    procedure CommitTrans; stdcall;
    procedure RollbackTrans; stdcall;
    procedure ApplyUpdates(const Delta: OleVariant; TableName, KeyField: WideString); stdcall;
    procedure ApplyUpdatesWithOle(const DeltaName, TableName, KeyField: WideString); stdcall;
    procedure ApplyUpdatesRecordInfo(const DeltaName, TableName, KeyField: WideString); stdcall;
    procedure ApplyUpdatesWithDataSet(const DataSet: integer; TableName, KeyField: WideString); stdcall;
    procedure ReceiveDataWithDefault; stdcall;
    procedure ReceiveDataWithCustom; stdcall;
    procedure ReceiveDataWithResult; stdcall;
    procedure ReceiveDataWithNoData; stdcall;
    procedure RaiseError(Msg: WideString); stdcall;
    procedure DropTable(TableName: WideString); stdcall;
    procedure AssignQueryToDataSet(DataSetIndex: integer; DataSetField, QueryField: WideString); stdcall;
    procedure AssignDataSetToQuery(DataSetIndex: integer; DataSetField, QueryField: WideString); stdcall;
    function UniKey: Widestring; stdcall;
    function GetQuery: IHMOleADOQuery; stdcall;
    function GetDataSet(Index: integer): IHMOleClientDataSet; stdcall;
    function GetOle: IBaseOle; stdcall;
    function GetParams: IHMOleVariant; stdcall;
    function GetRecordsAffected: integer; stdcall;
    property ReceiveDataType: TReceiveDataType read GetReceiveDataType;
  end;

TBaseOle = class(TSafeInterfacedObject, IBaseOle)
  private
    FParent: TComponent;
  protected
    procedure AddDspAsName(Name: WideString); stdcall;
    procedure Clear; stdcall;
    function GetValue(Name: WideString): OleVariant; stdcall;
    procedure SetValue(Name: WideString; Value: OleVariant); stdcall;
  public
    constructor Create(AOwner: TComponent);
  end;

type
  TCreateDataModule = function(const BaseService: IBaseService): IBaseDataModule; stdcall;
  TCreateDataModuleInfo = function(): IDataModuleInfo; stdcall;

PModuleLibrary = ^TModuleLibrary;
  TModuleLibrary = record
    ModuleIndex: Integer;
    LibHandle: THandle;
    CreateDataModule: TCreateDataModule;
    CreateDataModuleInfo: TCreateDataModuleInfo;
    ModuleState: TServiceState;
    FileName: pChar;
  end;

implementation

uses DataServer_form, swModuleIndex;

{ TSafeInterfacedObject }

function TSafeInterfacedObject._AddRef: integer;
begin
  Result := -1;
end;

function TSafeInterfacedObject._Release: integer;
begin
  Result := -1;
end;

function TSafeInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
const
  E_NOINTERFACE = $80004002;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := -1; {E_NOINTERFACE}
end;

{ TBaseService }

constructor TBaseService.Create(AOwner: TComponent);
begin
  inherited Create;
  FParent := AOwner;
  FReceiveDataType := rdNoData;
  FOle := TBaseOle.Create(AOwner);
end;

destructor TBaseService.Destroy;
begin
  FOle.Free;
  inherited;
end;

procedure TBaseService.BeginTrans;
begin
  (FParent as TDataServer2).Connection.BeginTrans;
end;

procedure TBaseService.CloseQuery;
begin
  (FParent as TDataServer2).Query.Close;
end;

procedure TBaseService.CommitTrans;
begin
  (FParent as TDataServer2).Connection.CommitTrans;
end;

procedure TBaseService.Execute(Sql: WideString);
begin
  //(FParent as TDataServer2).Cmd.CommandText := Sql;
  (FParent as TDataServer2).Cmd.Execute(Sql);
end;

procedure TBaseService.GetFieldNames(TableName: WideString;
  var FieldNames: WideString);
var
  FieldList: TStringList;
begin
  FieldList := TStringList.Create;
  (FParent as TDataServer2).Connection.GetFieldNames(TableName, FieldList);
  FieldNames := FieldList.Text;
  FieldList.Free;
end;

function TBaseService.GetInfo: WideString;
begin
  Result := 'ClassName:' + (FParent as TDataServer2).ClassName + ';ComponentName:' + (FParent as TDataServer2).Name;
end;

function TBaseService.GetSqlLanguage(Index: integer; var Params,
  Body: WideString): Boolean;
begin
  with (FParent as TDataServer2) do
    begin
      SqlLang.Close;
      SqlLang.SQL.Text := 'Select * from Func..sqlClient where sq_StoreKey=' + inttostr(Index);
      SqlLang.Open;
      if (SqlLang.Active) and (SqlLang.RecordCount > 0) then
        begin
          Params := SqlLang['sq_Param'];
          Body := SqlLang['sq_Body'];
          Result := True;
        end
      else
        Result := False;
    end;
end;

function TBaseService.InTranstion: WordBool;
begin
  Result := (FParent as TDataServer2).Connection.InTransaction;
end;

procedure TBaseService.OpenQuery(Sql: WideString);
begin
  with (FParent as TDataServer2) do
    begin
      Query.Close;
      Query.SQL.Text := Sql;
    end; // with
end;

procedure TBaseService.RaiseError(Msg: WideString);
begin
  raise Exception.Create(Msg);
end;

procedure TBaseService.ReceiveDataWithCustom;
begin
  FReceiveDataType := rdCustom;
end;

procedure TBaseService.ReceiveDataWithDefault;
begin
  FReceiveDataType := rdDefault;
end;

procedure TBaseService.ReceiveDataWithResult;
begin
  FReceiveDataType := rdResult;
end;

procedure TBaseService.RollbackTrans;
begin
  (FParent as TDataServer2).Connection.RollbackTrans;
end;

procedure TBaseService.ShowMessage(Msg: WideString);
begin
  //(FParent as TDataServer2).Memo1.Lines.Add(Msg);
end;

function TBaseService.GetReceiveDataType: TReceiveDataType;
begin
  Result := FReceiveDataType;
end;

procedure TBaseService.Reset;
begin
  FReceiveDataType := rdNoData;
end;

function TBaseService.GetQuery: IHMOleADOQuery;
begin
  Result := (FParent as TDataServer2).Query.IDataSet;
end;

procedure TBaseService.ReceiveDataWithNoData;
begin
  FReceiveDataType := rdNoData;
end;

function TBaseService.UniKey: Widestring;
begin
  Result := hmUniKey.UniKey((FParent as TDataServer2).UKI);
end;

function TBaseService.GetRecordsAffected: integer;
begin
  Result := (FParent as TDataServer2).Cmd.RecordsAffected;
end;

procedure TBaseService.DropTable(TableName: WideString);
begin
  (FParent as TDataServer2).Cmd.Execute('Drop Table ' + TableName);
end;

procedure TBaseService.AssignQueryToDataSet(DataSetIndex: integer; DataSetField, QueryField: WideString); stdcall;
begin
  with (FParent as TDataServer2) do
    case DataSetIndex of //
      0: Pub1[DataSetField] := Query[QueryField];
      1: Pub2[DataSetField] := Query[QueryField];
      2: Pub3[DataSetField] := Query[QueryField];
    else
      raise Exception.Create('(GetDataSet)Pub DataSet Out Bound');
    end; // case
end;

procedure TBaseService.AssignDataSetToQuery(DataSetIndex: integer; DataSetField, QueryField: WideString); stdcall;
begin
  with (FParent as TDataServer2) do
    case DataSetIndex of //
      0: Query[QueryField] := Pub1[DataSetField];
      1: Query[QueryField] := Pub2[DataSetField];
      2: Query[QueryField] := Pub3[DataSetField];
    else
      raise Exception.Create('(GetDataSet)Pub DataSet Out Bound');
    end; // case
end;

function TBaseService.GetOle: IBaseOle;
begin
  Result := FOle;
end;

procedure TBaseService.ApplyUpdatesWithOle(const DeltaName, TableName, KeyField: WideString);
var
  Flag: boolean;
begin

with (FParent as TDataServer2) do
    begin
      if VarIsNull(OleParams[DeltaName]) then exit;
      cdsDelta.Close;
      cdsDelta.Data := OleParams[DeltaName];
      Flag := cdsDelta.FindField('SYS_STATUS') <> nil;
    end; // with
  if Flag then
    InnerApplyUpdates2(TableName, KeyField)
  else
    InnerApplyUpdates(TableName, KeyField);
end;

procedure TBaseService.ApplyUpdates(const Delta: OleVariant; TableName, KeyField: WideString);
var
  Flag: Boolean;
begin
  if VarIsNull(Delta) then exit;
  with (FParent as TDataServer2) do
    begin
      cdsDelta.Close;
      cdsDelta.Data := Delta;
      Flag := cdsDelta.FindField('SYS_STATUS') <> nil;
    end; // with
  if Flag then
    InnerApplyUpdates2(TableName, KeyField)
  else
    InnerApplyUpdates(TableName, KeyField);
end;

function TBaseService.GetDataSet(Index: integer): IHMOleClientDataSet;
begin
  with (FParent as TDataServer2) do
    case Index of //
      0: Result := Pub1.IDataSet;
      1: Result := Pub2.IDataSet;
      2: Result := Pub3.IDataSet;
    else
      raise Exception.Create('(GetDataSet)Pub DataSet Out Bound');
    end; // case
end;

function TBaseService.GetParams: IHMOleVariant;
begin
  Result := (FParent as TDataServer2).OleParams;
end;

procedure TBaseService.InnerApplyUpdates(TableName, KeyField: WideString);
var
  i: integer;
  s1, s2: string;
  CmdStr: string;
  FieldList: TStringList;
begin
  with (FParent as TDataServer2) do
    begin
      FieldList := TStringList.Create;
      Connection.GetFieldNames(TableName, FieldList);
      if not cdsDelta.Active then cdsDelta.Open;
      for i := 1 to FieldList.Count do
        if cdsDelta.FindField(FieldList[i - 1]) <> nil then
          cdsDelta.FindField(FieldList[i - 1]).Tag := 1;
      FieldList.Free;
      if cdsDelta.RecordCount > 0 then
        begin
          cdsDelta.First;
          s1 := '';
          s2 := '';
          while not cdsDelta.Eof do
            begin
              CmdStr := '';
              case cdsDelta.UpdateStatus of
                usUnmodified:
                  begin
                    s2 := VarToSql(cdsDelta[KeyField]);
                  end;
                usModified:
                  begin
                    s1 := '';
                    for i := 1 to cdsDelta.FieldCount do
                      if (not cdsDelta.Fields[i - 1].IsNull) and (cdsDelta.Fields[i - 1].Tag = 1) then
                        begin
                          if s1 = '' then
                            s1 := Trim(cdsDelta.Fields[i - 1].FieldName) + ' = ' + VarToSql(cdsDelta.Fields[i - 1].Value)
                          else
                            s1 := s1 + ',' + Trim(cdsDelta.Fields[i - 1].FieldName) + ' = ' + VarToSql(cdsDelta.Fields[i - 1].Value);
                        end;
                    if s1 <> '' then
                      begin
                        CmdStr := 'Update ' + TableName + ' Set ' + s1 + ' Where ' + KeyField + ' = ' + s2;
                      end;
                  end;
                usInserted:
                  begin
                    s1 := '';
                    s2 := '';
                    for i := 1 to cdsDelta.FieldCount do
                      if (not cdsDelta.Fields[i - 1].IsNull) and (cdsDelta.Fields[i - 1].Tag = 1) then
                        begin
                          if s1 = '' then
                            begin
                              s1 := Trim(cdsDelta.Fields[i - 1].FieldName);
                              s2 := VarToSql(cdsDelta.Fields[i - 1].Value);
                            end
                          else
                            begin
                              s1 := s1 + ',' + Trim(cdsDelta.Fields[i - 1].FieldName);
                              s2 := s2 + ',' + VarToSql(cdsDelta.Fields[i - 1].Value);
                            end;
                        end;
                    if s1 <> '' then
                      begin
                        CmdStr := 'Insert into ' + TableName + '(' + s1 + ') Values (' + s2 + ')';
                      end;
                  end;
                usDeleted:
                  begin
                    s2 := VarToSql(cdsDelta[KeyField]);
                    CmdStr := 'Delete ' + TableName + ' Where ' + KeyField + ' = ' + s2;
                  end;
              end;
              if CmdStr <> '' then Cmd.Execute(CmdStr);
              cdsDelta.Next;
            end;
          cdsDelta.First;
          cdsDelta.EmptyDataSet;
          cdsDelta.Close;
        end;
    end;
end;

procedure TBaseService.ApplyUpdatesWithDataSet(const DataSet: integer; TableName, KeyField: WideString);
var
  Flag: boolean;
begin
  with (FParent as TDataServer2) do
    begin
      cdsDelta.Close;
      case DataSet of //
        0: cdsDelta.Data := Pub1.Data;
        1: cdsDelta.Data := Pub2.Data;
        2: cdsDelta.Data := Pub3.Data;
      else
        raise Exception.Create('(ApplyUpdatesWithDataSet) Out of DataSet Index')
      end; // case
      Flag := cdsDelta.FindField('SYS_STATUS') <> nil;
    end; // with
  if Flag then
    InnerApplyUpdates2(TableName, KeyField)
  else
    InnerApplyUpdates(TableName, KeyField);
end;

procedure TBaseService.ApplyUpdatesRecordInfo(const DeltaName, TableName, KeyField: WideString);
var
  s1, s2: string;
  CmdStr: string;
  Flag: Boolean;
  UpdateStatus: TUpdateStatus;
begin
  with (FParent as TDataServer2) do
    begin
      if VarIsNull(OleParams[DeltaName]) then exit;
      cdsDelta.Close;
      cdsDelta.Data := OleParams[DeltaName];
      cdsDelta.Open;
      if cdsDelta.RecordCount > 0 then
        begin
          cdsDelta.First;
          s1 := '';
          s2 := '';
          Flag := cdsDelta.FindField('SYS_STATUS') <> nil;

while not cdsDelta.Eof do
            begin
              CmdStr := '';
              if Flag then
                UpdateStatus := cdsDelta.UpdateStatus
              else
                UpdateStatus := TUpdateStatus(cdsDelta.IV['SYS_STATUS']);
              case UpdateStatus of
                usUnmodified:
                  begin
                    s2 := VarToSql(cdsDelta[KeyField]);
                  end;
                usModified:
                  begin
                    if Flag then s2 := VarToSql(cdsDelta[KeyField]);
                    s1 := 'ri_ModifyPsn = ' + VarToSql(OleParams['UserID']);
                    s1 := s1 + ', ri_ModifyDate = ' + ToSqlStr(DateToStr(Today));
                    CmdStr := 'Update dlgRecordInfo Set ' + s1 + ' Where ri_UniKey = ' + s2;
                  end;
                usInserted:
                  begin
                    s1 := 'ri_UniKey';
                    s1 := s1 + ', ri_TableName';
                    s1 := s1 + ', ri_CreatePsn ';
                    s1 := s1 + ', ri_CreateDate ';
                    s1 := s1 + ', ri_ModifyPsn ';
                    s1 := s1 + ', ri_ModifyDate ';
                    s2 := VarToSql(cdsDelta[KeyField]);
                    s2 := s2 + ',' + VarToSql(Uppercase(TableName));
                    s2 := s2 + ',' + VarToSql(OleParams['UserID']);
                    s2 := s2 + ',' + ToSqlStr(DateToStr(Today));
                    s2 := s2 + ',' + VarToSql(OleParams['UserID']);
                    s2 := s2 + ',' + ToSqlStr(DateToStr(Today));
                    CmdStr := 'Insert into dlgRecordInfo (' + s1 + ') Values (' + s2 + ')';
                  end;
                usDeleted:
                  begin
                    s1 := 'ri_DeletePsn = ' + VarToSql(OleParams['UserID']);
                    s1 := s1 + ', ri_DeleteDate = ' + ToSqlStr(DateToStr(Today));
                    s1 := s1 + ', ri_Deleted = 1';
                    s2 := VarToSql(cdsDelta[KeyField]);
                    CmdStr := 'Update dlgRecordInfo Set ' + s1 + ' Where ri_UniKey = ' + s2;
                  end;
              end;
              if CmdStr <> '' then Cmd.Execute(CmdStr);
              cdsDelta.Next;
            end;
          cdsDelta.First;
          cdsDelta.EmptyDataSet;
          cdsDelta.Close;
        end;
    end;
end;

procedure TBaseService.InnerApplyUpdates2(TableName, KeyField: WideString);
var
  i: integer;
  s1, s2: string;
  CmdStr: string;
  FieldList: TStringList;
  UpdateStatus: integer;
begin
  with (FParent as TDataServer2) do
    begin
      FieldList := TStringList.Create;
      Connection.GetFieldNames(TableName, FieldList);
      if not cdsDelta.Active then cdsDelta.Open;
      for i := 1 to FieldList.Count do
        if cdsDelta.FindField(FieldList[i - 1]) <> nil then
          cdsDelta.FindField(FieldList[i - 1]).Tag := 1;
      FieldList.Free;
      if cdsDelta.RecordCount > 0 then
        begin
          cdsDelta.First;
          s1 := '';
          s2 := '';
          while not cdsDelta.Eof do
            begin
              CmdStr := '';
              UpdateStatus := cdsDelta.IV['SYS_STATUS'];
              case TUpdateStatus(UpdateStatus) of
                usUnmodified, usModified:
                  begin
                    s1 := '';
                    s2 := VarToSql(cdsDelta[KeyField]);
                    for i := 1 to cdsDelta.FieldCount do
                      if cdsDelta.Fields[i - 1].CanModify and (cdsDelta.Fields[i - 1].Tag = 1) and (UpperCase(cdsDelta.Fields[i - 1].FieldName) <> Uppercase(KeyField)) then
                        begin
                          if s1 = '' then
                            s1 := Trim(cdsDelta.Fields[i - 1].FieldName) + ' = ' + VarToSql(cdsDelta.Fields[i - 1].Value)
                          else
                            s1 := s1 + ',' + Trim(cdsDelta.Fields[i - 1].FieldName) + ' = ' + VarToSql(cdsDelta.Fields[i - 1].Value);
                        end;
                    if s1 <> '' then
                      begin
                        CmdStr := 'Update ' + TableName + ' Set ' + s1 + ' Where ' + KeyField + ' = ' + s2;
                      end;
                  end;
                usInserted:
                  begin
                    s1 := '';
                    s2 := '';
                    for i := 1 to cdsDelta.FieldCount do
                      if (not cdsDelta.Fields[i - 1].IsNull) and (cdsDelta.Fields[i - 1].Tag = 1) then
                        begin
                          if s1 = '' then
                            begin
                              s1 := Trim(cdsDelta.Fields[i - 1].FieldName);
                              s2 := VarToSql(cdsDelta.Fields[i - 1].Value);
                            end
                          else
                            begin
                              s1 := s1 + ',' + Trim(cdsDelta.Fields[i - 1].FieldName);
                              s2 := s2 + ',' + VarToSql(cdsDelta.Fields[i - 1].Value);
                            end;
                        end;
                    if s1 <> '' then
                      begin
                        CmdStr := 'Insert into ' + TableName + '(' + s1 + ') Values (' + s2 + ')';
                      end;
                  end;
                usDeleted:
                  begin
                    s2 := VarToSql(cdsDelta[KeyField]);
                    CmdStr := 'Delete ' + TableName + ' Where ' + KeyField + ' = ' + s2;
                  end;
              end;
              if CmdStr <> '' then Cmd.Execute(CmdStr);
              cdsDelta.Next;
            end;
          cdsDelta.First;
          cdsDelta.EmptyDataSet;
          cdsDelta.Close;
        end;
    end;
end;

{ TBaseOle }

constructor TBaseOle.Create(AOwner: TComponent);
begin
  inherited Create;
  FParent := AOwner;
end;

procedure TBaseOle.AddDspAsName(Name: WideString);
begin
  (FParent as TDataServer2).Ole[Name] := (FParent as TDataServer2).dspTest.Data;
end;

procedure TBaseOle.Clear;
begin
  (FParent as TDataServer2).Ole.Clear;
end;

function TBaseOle.GetValue(Name: WideString): OleVariant;
begin
  Result := (FParent as TDataServer2).Ole[Name];
end;

procedure TBaseOle.SetValue(Name: WideString; Value: OleVariant);
begin
  (FParent as TDataServer2).Ole[Name] := Value;
end;

end.

2004-05-21 14:55:23 煙灰缸(2282902)
我想了想，今天還是和大家聊點基本功，就是“如何在DLL中活用Interface”

2004-05-21 14:56:40  黑夜(13633497)
問一個更基本的問題：
三層分工之前要先定義好接口函數嗎？比如說函數名，參數什麼的　

2004-05-21 14:57:24 煙灰缸(2282902)
 TO黑夜,今天講完這個，明天就講你那個如何？

2004-05-21 14:58:00  黑夜(13633497)
明天週末不上網啊

2004-05-21 14:58:54  黑夜(13633497)
其實回答可以很簡單，是或不是啊，N

2004-05-21 14:58:57 煙灰缸(2282902)
星期一好不？

2004-05-21 14:59:12 煙灰缸(2282902)
什麼是不是？

2004-05-21 15:00:16  黑夜(13633497)
是不是要先各個成員都商量好了接口的名稱，參數啊？

2004-05-21 15:00:39 煙灰缸(2282902)
簡單的說，“是”

2004-05-21 15:01:14  黑夜(13633497)
ｏｋ，那就開始說"如何在DLL中活用Interface" 吧

2004-05-21 15:01:19 煙灰缸(2282902)
就常用的接口和參數就可以了。

2004-05-21 15:06:30 煙灰缸(2282902)
中間層的“物理”分層，需要把“規則程序”和“事務程序”分開，

2004-05-21 15:07:46 煙灰缸(2282902)
這就成了“2個程序”了，但我們只要一個中間層，所以，把規則做成DLL是比較方便的做法。

2004-05-21 15:08:19 煙灰缸(2282902)
所以，就需要了解DLL和Interface了。

2004-05-21 15:08:43 李逸(57440981)
有道理

2004-05-21 15:09:24 煙灰缸(2282902)
再統計一下，有幾個兄弟了解COM，會不會都舉個手。

2004-05-21 15:09:57 李逸(57440981)
我不會，COM也是可執行模塊，但詳細的內部機制我不熟悉

2004-05-21 15:10:57 煙灰缸(2282902)
把Interface用在DLL中，實際上就是借了COM的思想了。

2004-05-21 15:11:21 楓長舞(273966879)
能結合一個實際的例子講一下嗎？

2004-05-21 15:11:29 李逸(57440981)
Interface是Delphi 中就有的啊

2004-05-21 15:11:27 Jackey(15677613)
com的interface知一點.

2004-05-21 15:12:09  黑夜(13633497)
那ｃｏｍ的思想是什麼，大概講一下啊

2004-05-21 15:12:24 煙灰缸(2282902)
暫可不管COM，了解了今天的課題，也差不多了解了一點COM了。

2004-05-21 15:12:25 李逸(57440981)
Aleyn，請將InterFace的中文解釋給大家仔細分析一下，我覺得對這個名詞的認識大家還是不統一的

2004-05-21 15:12:36 煙灰缸(2282902)
就是接口啊。

2004-05-21 15:13:18 煙灰缸(2282902)
我找找沒有沒例子先。

2004-05-21 15:13:46 Jackey(15677613)
確切的說。是delphi對于接口的定義.

2004-05-21 15:14:04 Jackey(15677613)
用interface這個單詞而已。

2004-05-21 15:14:18 煙灰缸(2282902)
Jackey說對了。

2004-05-21 15:16:57 煙灰缸(2282902)
從另一點入手。

2004-05-21 15:17:31 煙灰缸(2282902)
打個比喻，如何簡便的從DLL中導出類？

2004-05-21 15:17:47 煙灰缸(2282902)
大家說說看。

2004-05-21 15:17:48 李逸(57440981)
使用PACKAGE修飾符，在C++ Builder中

2004-05-21 15:17:58 李逸(57440981)
當然還有更傳統的辦法

2004-05-21 15:18:13 llyygg(13029886)
傳類指針?

2004-05-21 15:18:29 李逸(57440981)
如果是我當然是使用PACKAGE修飾符，這樣連同RTTI信息也是一起輸出的了

2004-05-21 15:18:59 煙灰缸(2282902)
DLL和Main可能會不同一個Application。

2004-05-21 15:19:53 煙灰缸(2282902)
大家在寫接口的時候有沒有發現，Interface可以傳送什麼類型，又不可以傳送什麼類型

2004-05-21 15:20:03 Jackey(15677613)
將類在dll定義為function.

2004-05-21 15:20:21 李逸(57440981)
VCL的對象類型應該都是可以的

2004-05-21 15:20:38 李逸(57440981)
不是VCL的類型傳遞起來可能不如VCL類好使用

2004-05-21 15:23:19 煙灰缸(2282902)
我們這樣做一下好了，在Main中，我們把s:=' ' ， 在DLL中 ，我們把s:='123456789'，function result 時，會出現什麼情況？

2004-05-21 15:24:31 煙灰缸(2282902)
沒人了？

2004-05-21 15:24:51 Jackey(15677613)
？

2004-05-21 15:24:56  黑夜(13633497)
不懂，哈哈

2004-05-21 15:25:19 煙灰缸(2282902)
是不是說得復雜了點，還是。。。。。。。。。。

2004-05-21 15:25:37 楓長舞(273966879)
應該看傳入的是指針還是值了

2004-05-21 15:27:13 煙灰缸(2282902)
無論是指針還是值，只要你是在DLL中申請內存，返回時你沒保存好返回值，DLL辭放時Main就會出錯。

2004-05-21 15:28:33 煙灰缸(2282902)
但Interface不會。因為，它的機制讓它只能是個接口，而不管你的值是從哪裡來的。

2004-05-21 15:28:35  黑夜(13633497)
什麼叫沒保存好返回值？
賦值給s了不就保存了嗎？？？

2004-05-21 15:29:21 煙灰缸(2282902)
不它那時賦的不是值，而是指針。

2004-05-21 15:29:39 煙灰缸(2282902)
而值還在DLL中。

2004-05-21 15:30:08 楓長舞(273966879)
將值賦給Result不可以了嗎？

2004-05-21 15:30:26 煙灰缸(2282902)
不可以，因為它是DLL申請的內存。

2004-05-21 15:30:40 煙灰缸(2282902)
但有個辦法可以做得到。

2004-05-21 15:30:44 李逸(57440981)
不是的

2004-05-21 15:30:59 煙灰缸(2282902)
什麼不是的？

2004-05-21 15:31:32 李逸(57440981)
String在BCB中是個類，如果是在dll中申請的內存，則在函數返回的時候就會釋放

2004-05-21 15:32:04 風雲雨(6614897)
main中傳指給dll，可以嗎？

2004-05-21 15:32:20 風雲雨(6614897)
應該是指針

2004-05-21 15:32:40 楓長舞(273966879)
function aa(var a:string);
begin
a:='asdf';
end;
你說能不能將‘asdf'傳回main?

2004-05-21 15:33:09 李逸(57440981)
’1234567'是個靜態的，函數S:=的時候，String應該是作一個拷貝的

2004-05-21 15:33:41 李逸(57440981)
而不是將數據段中的‘1234567'的地址交給String的內部data存儲

2004-05-21 15:34:15 煙灰缸(2282902)
不管它是靜態的還是動態的，它給S的就只是一個地址，是不？

2004-05-21 15:34:47 煙灰缸(2282902)
但這塊數據始終還是DLL申請的，是不？

2004-05-21 15:35:30 李逸(57440981)
不是的

2004-05-21 15:35:44 李逸(57440981)
Delphi的String和BCB的AnsiString應該是一樣的

2004-05-21 15:35:53  黑夜(13633497)
好像說這個是ansistring的做法，shortstring不是這樣子吧

2004-05-21 15:35:54 煙灰缸(2282902)
不一樣。

2004-05-21 15:36:11 煙灰缸(2282902)
ansistring 和 string 不一樣。

2004-05-21 15:36:11 斜陽(249208513)
原則上Dll中申請的內存應該在Dll中釋放，但是只是原則啊，不是說在Dll中申請的內存一定要在Dll中釋放啊

2004-05-21 15:36:49 李逸(57440981)
String我並不太了解，但是既然Borland是用AnsiString來實現Delphi 的String就應該是一樣的

2004-05-21 15:36:54 煙灰缸(2282902)
AnsiString 和 WideString 差不多。

2004-05-21 15:37:08 李逸(57440981)
String 不是shortString

2004-05-21 15:37:12 斜陽(249208513)
差挺多的

2004-05-21 15:37:12 煙灰缸(2282902)
但String 就和 PChar差不多了。

2004-05-21 15:37:20 李逸(57440981)
不是的

2004-05-21 15:37:37 李逸(57440981)
String可以自己申請內存並且可以自己釋放的

2004-05-21 15:38:14 煙灰缸(2282902)
string 和 Pchar 在Delphi中都是指針是不？

2004-05-21 15:38:38 煙灰缸(2282902)
就是因為String可以自己申請內存並且可以自己釋放，所以才出問題。

2004-05-21 15:38:56  黑夜(13633497)
打開了huge strings開關時
string是ansistring
否則是shortstring

2004-05-21 15:38:57 李逸(57440981)
不是吧，String應該是對象的指針

2004-05-21 15:39:18 李逸(57440981)
這個我不懂了，Delphi 不熟悉

2004-05-21 15:39:33 李逸(57440981)
現在按照ShortString還是AnsiString討論

2004-05-21 15:39:49 煙灰缸(2282902)
當指針討論。

2004-05-21 15:39:56 煙灰缸(2282902)
也可以當類討論。

2004-05-21 15:40:23 李逸(57440981)
在BCB中其實並不是一個類指針，而是一個類實例

2004-05-21 15:40:49 李逸(57440981)
其元素中有保存實際字符串的指針

2004-05-21 15:41:15 李逸(57440981)
實際內存是可以有類自己實現分配和管理的

2004-05-21 15:41:18 煙灰缸(2282902)
說它是實類是因為它可以自身管理。

2004-05-21 15:42:14 煙灰缸(2282902)
扯太遠了，還是用簡單的說回來好了。。。。。。。

2004-05-21 15:42:30 李逸(57440981)
就是就是

2004-05-21 15:42:41 李逸(57440981)
扯到內存管理了

2004-05-21 15:43:26 煙灰缸(2282902)
一句話，當它是指針，是一個會自生自滅的指針。大家有沒意見？

2004-05-21 15:43:42 李逸(57440981)
s不是的

2004-05-21 15:43:56 李逸(57440981)
s是在main中創建的

2004-05-21 15:43:58 煙灰缸(2282902)
我說是“當”它。

2004-05-21 15:44:22 李逸(57440981)
當賦值的時候，會將值復制一份的

2004-05-21 15:44:59 李逸(57440981)
因此原來的值改變的時候不會影響s的值，當然內存釋放的時候也不會影響s的以及main

2004-05-21 15:45:18 煙灰缸(2282902)
當沒有用到它時就會辭放是不？

2004-05-21 15:45:51 煙灰缸(2282902)
最好還是大家用實例試一下好了。。。。。

2004-05-21 15:46:36 煙灰缸(2282902)
看看S的內存在哪裡申請，又在哪裡辭放。。。。

2004-05-21 15:47:18 九日(106314414)
在delphi中string類型默認好像就是ansistring,所以它們是相同的.

2004-05-21 15:47:37 李逸(57440981)
s聲明的時候吧，呵呵

2004-05-21 15:48:08 李逸(57440981)
但是存儲字符串的內存是在運行時根據情況而定了

2004-05-21 15:48:38 煙灰缸(2282902)
打住這個S了，不然就要聊“內存管理”了。。。。。

2004-05-21 15:48:56 李逸(57440981)
呵呵，我是有些明白你的意思了

2004-05-21 15:49:38 煙灰缸(2282902)
又明白了什麼。。。。。。。。。。。。。。。。。。。。。不懂

2004-05-21 15:50:08 李逸(57440981)
你是說s中內存總歸是在dll中賦值的時候進行重新分配，在dll中分配的內存當dll被unload的時候就會要求釋放，就會出現錯誤，是不是這個西醫

2004-05-21 15:50:30 煙灰缸(2282902)
對，就是這樣。

2004-05-21 15:51:32 李逸(57440981)
不會的吧，因為dll並不是一個獨立執行的進程、系統應該是和其Host宿主程序來討論被Unload的時候是否清理內存，除非是dll內部強行清理內存

2004-05-21 15:52:10 煙灰缸(2282902)
找個實列來看看就知道了，今天就打住了。

2004-05-21 15:52:14 Jackey(15677613)
扯遠了：
我們這樣做一下好了，在Main中，我們把s:=' ' ， 在DLL中 ，我們把s:='123456789'，function result 時，會出現什麼情況？
-----想說明什麼? 不懂?

2004-05-21 15:52:22 李逸(57440981)
只有獨立的進程在關閉的時候系統才會有義務收回沒有釋放的內存

2004-05-21 15:52:50 李逸(57440981)
能不能翻譯一下上面的代碼到C++中啊，不好以西

2004-05-21 15:53:21 煙灰缸(2282902)
先不管這些了，下次開個“內存管理”課來聊聊好不？

2004-05-21 15:53:54 Jackey(15677613)
是不是想讲： 我們在DLL將'123456789'給一個值。在main怎麼得到這個值？

2004-05-21 15:54:02 煙灰缸(2282902)
我只是想說明，Interface中能傳送的類型。

2004-05-21 15:54:12 煙灰缸(2282902)
是。

2004-05-21 15:54:41 煙灰缸(2282902)
如果我們不用String，就不管它算了。

2004-05-21 16:21:34 煙灰缸(2282902)
我們常用的類型有幾種？ internet ,float ,boolean ,widestring,olevariant,還有其它的麼？不是指針的。

2004-05-21 16:22:04 斜陽(249208513)
最好使的就是指針了，結果被一棒子打死了！！

2004-05-21 16:22:09  q ?  ?r(17427437)
integer, double.......

2004-05-21 16:22:24  q ?  ?r(17427437)
指針是不安全的，但是高效，我喜歡：）

2004-05-21 16:22:45 煙灰缸(2282902)
Interface不能傳送指針。 XX

2004-05-21 16:23:05 斜陽(249208513)
非常之觀常在險遠 啊

2004-05-21 16:23:07 李逸(57440981)
Delphi中指針何解啊

2004-05-21 16:23:39 煙灰缸(2282902)
類似Pointer

2004-05-21 16:23:42 李逸(57440981)
原本Pascal就是按照地址傳遞參數的，還需要指針嗎

2004-05-21 16:23:45 斜陽(249208513)
不是吧， 接口中好像可以傳遞接口的吧，那不是指針是什麼啊

2004-05-21 16:23:47  q ?  ?r(17427437)
PASCAL不是有指針麼

2004-05-21 16:24:08 李逸(57440981)
當然需要使用Pascal調用規則才是這樣的

2004-05-21 16:25:12 煙灰缸(2282902)
把指針轉用HANDLE(cardint)就可以。

2004-05-21 16:25:16 李逸(57440981)
在Stdcall和fastcall中，那個是值傳遞還是地址傳遞啊

2004-05-21 16:26:34 llyygg(13029886)
傳遞和StdCall,fastcall沒有關系吧, pascal裡面不用var修飾就是值傳遞

2004-05-21 16:26:47 煙灰缸(2282902)
說錯了，應該說不可以傳送“類指針”和“串指針”
“串指針”特指String
這樣好了，一句話，不要在Interface中傳送“Class”和“String”
但可以是WideString

2004-05-21 16:29:44 斜陽(249208513)
我試過一種傳 String 的用法，可以保證在Dll中聲明的String在Mian中被釋放而不是在Dll中被釋放

2004-05-21 16:30:28 煙灰缸(2282902)
先別談這個好了。

2004-05-21 16:30:32 斜陽(249208513)
那你為什麼說不能呢？是不建議還是根本不可以呢

2004-05-21 16:31:01 煙灰缸(2282902)
是不建議。

2004-05-21 16:31:28 煙灰缸(2282902)
對於新手來說，錯誤會讓他更糊塗。
所以幹脆“不可以”

2004-05-21 16:32:38 煙灰缸(2282902)
先談談COM。
COM組件的建立應該是由COM工廠創建的，是不？
但我們的“COM”用function來建立好了，在DLL中，然後Exports。

2004-05-21 16:35:16 煙灰缸(2282902)
function 返回的是一個接口。

2004-05-21 16:36:15 煙灰缸(2282902)
接口的機制可以讓我們比較“安全”的處理一些數據。

2004-05-21 16:38:31 煙灰缸(2282902)
我們在DLL中定制一個Function,做為公共的Function，主要是Main調用它時比較好識別。

2004-05-21 16:39:13 煙灰缸(2282902)
類似：  function CreateCOM:IBaseServer;stdcall;

2004-05-21 16:39:34 煙灰缸(2282902)
一個DLL(規則)就一個就可以了。

2004-05-21 16:40:02 斜陽(249208513)
應該有個類型作參數吧

2004-05-21 16:40:30 煙灰缸(2282902)
不用，因為它的實例就在DLL中。

2004-05-21 16:40:56 煙灰缸(2282902)
而且一個DLL就對應一個。

2004-05-21 16:41:35 斜陽(249208513)
也就是說，每個DLL都必須導出這個函數，算是個對Dll的約定了

2004-05-21 16:41:39 煙灰缸(2282902)
有點類似於DllMain.

2004-05-21 16:41:44 煙灰缸(2282902)
是。

2004-05-21 16:43:47 煙灰缸(2282902)
還有一點，當你在其它DLL中要用到Main的接口，而接口中又要包函子接口，這時，需要注意什麼？

2004-05-21 16:44:28 煙灰缸(2282902)
大家有沒有留意到這一點？

2004-05-21 16:46:12 煙灰缸(2282902)
沒人回答？

2004-05-21 16:46:35 llyygg(13029886)
不懂

2004-05-21 16:46:47 斜陽(249208513)
沒人經歷過如何回答啊？（你的子接口指什麼？）

2004-05-21 16:48:01 斜陽(249208513)
是接口中的某個函數或者方法或者屬性返回一個接口嗎？

2004-05-21 16:48:53 煙灰缸(2282902)
也就是說，Main中的A接口有一個屬性(Property)是B接口，你在DLL用到了A接口和B接口，所以你在寫A接口和B接口的實現時，需要注意什麼？

2004-05-21 16:50:00 斜陽(249208513)
應該沒有什麼限制吧

2004-05-21 16:53:45 煙灰缸(2282902)
http://www.e-midas.cn/Soft_Show.asp?SoftID=5 ;
<code 1>

2004-05-21 16:53:56 煙灰缸(2282902)
大家請下載這個原代碼。

2004-05-21 16:58:34 煙灰缸(2282902)
看看43-46行。

2004-05-21 16:59:53 Jackey(15677613)
A接口要引入B接口。 A的dll中use B.接口.?

2004-05-21 17:00:15 煙灰缸(2282902)
是。

2004-05-21 17:02:55 煙灰缸(2282902)
還是先看看實現部分吧。http://www.e-midas.cn/Soft_Show.asp?SoftID=6 ;
<code 2>

2004-05-21 17:03:09 煙灰缸(2282902)
結合一起看。

2004-05-21 17:06:31 煙灰缸(2282902)
有沒有注意到幾個類都是從TSafeInterfacedObject來的？

2004-05-21 17:08:17 煙灰缸(2282902)
看看TSafeInterfacedObject的_AddRef和_Release的實現部分，有什麼東西？
[code]
function TSafeInterfacedObject._AddRef: integer;
begin
  Result := -1;
end;

function TSafeInterfacedObject._Release: integer;
begin
  Result := -1;
end;
[/code]

2004-05-21 17:08:42 llyygg(13029886)
-1,不理解

2004-05-21 17:09:07 煙灰缸(2282902)
Jackey能理解麼？

2004-05-21 17:09:38 Jackey(15677613)
No.

2004-05-21 17:09:59 煙灰缸(2282902)
大家有沒有用過TInterfacedObject這個類？
[code]
{ TInterfacedObject provides a threadsafe default implementation
  of IInterface.  You should use TInterfaceObject as the base class
  of objects implementing interfaces.  }

TInterfacedObject = class(TObject, IInterface)
  protected
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;
[/code]

2004-05-21 17:10:36 llyygg(13029886)
引用記數.

2004-05-21 17:11:02 煙灰缸(2282902)
大家打開Delphi中TInterfacedObject這個類的說明和實現。

2004-05-21 17:14:55 煙灰缸(2282902)
看看TSafeInterfacedObject和TInterfacedObject的_AddRef和_Release有什麼不同嗎？

2004-05-21 17:15:26 llyygg(13029886)
function TInterfacedObject._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then Destroy;
end;

2004-05-21 17:16:43 煙灰缸(2282902)
對，TInterfacedObject會自己引用計數和自己辭放，但TSafeInterfacedObject沒有，是不？

2004-05-21 17:17:05 llyygg(13029886)
是啊, 需要自己釋放對嗎

2004-05-21 17:17:39 Jackey(15677613)
yes

2004-05-21 17:18:01 llyygg(13029886)
這還叫Safe嗎?不理解

2004-05-21 17:18:50 煙灰缸(2282902)
對，因為如果用TInterfacedObject的話，DLL會在用它A接口先後，把它辭放了，所以會找不到A接口。
但如果用TSafeInterfacedObject的話，則是讓Main來手工Free，DLL不會自動辭放，所以比較安全點。
所以這就是為什麼是=-1的原因。

2004-05-21 17:20:26 llyygg(13029886)
為什麼Main調用Dll的接口以後,引用記數沒有增加?

2004-05-21 17:20:52 煙灰缸(2282902)
有增加。
也會減少。

2004-05-21 17:21:17 煙灰缸(2282902)
但是TSafeInterfacedObject不會加，也不會少。

2004-05-21 17:21:33 Jackey(15677613)
在哪增減,main?

2004-05-21 17:22:13 煙灰缸(2282902)
不用加，也不用減，不管它的計數，讓它永遠為-1就可以了。
實際上，就是不讓它自動FREE。

2004-05-21 17:23:16 llyygg(13029886)
DLL建立+1,Main調用+1, DLL釋放-1, Main如果還沒有用完接口,應該還有1吧...y

2004-05-21 17:23:52 煙灰缸(2282902)
不加它，不減它，哪來的1？

2004-05-21 17:24:56 llyygg(13029886)
那你的接口調用一次要釋放一次,調用二次要Free二次?

2004-05-21 17:25:29  黑夜(13633497)
引用計數增減

2004-05-21 17:25:40 煙灰缸(2282902)
就象CLASS一樣，只建立一次釋放一次

2004-05-21 17:26:26 煙灰缸(2282902)
你FREE接口後，不Create它，你還能用嗎？

2004-05-21 17:26:55 煙灰缸(2282902)
你說的調用是不是指它的Procedure和Property？

2004-05-21 17:27:49 llyygg(13029886)
就是自己的程序保證一個接口不同時建立二次,對嗎?
我是說
I := GetI;
再
I := GetI;
需要:
I.Free;
再
I.Free;嗎?
我已經暈了.

2004-05-21 17:28:27 Jackey(15677613)
main怎麼來free. 比如A. 調用 B. B的接口的free在哪?

2004-05-21 17:28:45 煙灰缸(2282902)
是

2004-05-21 17:29:09 llyygg(13029886)
B Free在A的Destroy裡面?

2004-05-21 17:29:10 煙灰缸(2282902)
把它當成類來Free

2004-05-21 17:30:14 煙灰缸(2282902)
是

2004-05-21 17:36:31 煙灰缸(2282902)
快下班了，聊點有趣的吧，今天說不完的，星期一再繼續。。。。。。。。。。