partserverimpl.pas

来自「Delphi 下COM开发的重要参考书籍之一。使用有一定COM开发经验的使用者」· PAS 代码 · 共 163 行

unit PartServerImpl;

interface

uses
  ComObj, ActiveX, AxCtrls, PartSrv_TLB;

type
  TPartServer = class(TAutoObject, IConnectionPointContainer, IPartServer)
  private
    { Private declarations }
    FConnectionPoints: TConnectionPoints;
    FEvents: IPartServerEvents;
    FObjectID: Integer;
  public
    procedure Initialize; override;
    destructor Destroy; override;
  protected
    { Protected declarations }
    property ConnectionPoints: TConnectionPoints read FConnectionPoints
      implements IConnectionPointContainer;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function GetAll(varFields: OleVariant): OleVariant; safecall;
    function GetPart(const PartNumber: WideString;
      varFields: OleVariant): OleVariant; safecall;
    procedure AddPart(varFields, varValues: OleVariant); safecall;
    procedure DeletePart(const PartNumber: WideString); safecall;
    procedure ModifyPart(const PartNumber: WideString; varFields,
      varValues: OleVariant); safecall;
    procedure UsePart(const PartNumber: WideString; Quantity: Integer);
      safecall;
    function GetEnumerator: IEnumConnections;
  end;

implementation

uses Windows, ComServ, DataModule;

procedure TPartServer.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IPartServerEvents;
end;

procedure TPartServer.Initialize;
begin
  inherited Initialize;
  FConnectionPoints := TConnectionPoints.Create(Self);
  if AutoFactory.EventTypeInfo <> nil then
    FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID,
      ckMulti, EventConnect);

  RegisterActiveObject(self as IUnknown, CLASS_PartServer,
    ACTIVEOBJECT_WEAK, FObjectID);
end;

destructor TPartServer.Destroy;
begin
  RevokeActiveObject(FObjectID, nil);

  inherited Destroy;
end;

function TPartServer.GetAll(varFields: OleVariant): OleVariant;
begin
  PartDM.GetAllParts(varFields, Result);
end;

function TPartServer.GetPart(const PartNumber: WideString;
  varFields: OleVariant): OleVariant;
begin
  PartDM.GetPart(PartNumber, varFields, Result);
end;

procedure TPartServer.AddPart(varFields, varValues: OleVariant);
var
  Enum: IEnumConnections;
  ConnectData: TConnectData;
  Fetched: Cardinal;
begin
  PartDM.AddPart(varFields, varValues);

  Enum := GetEnumerator;
  if Enum <> nil then begin
    while Enum.Next(1, ConnectData, @Fetched) = S_OK do
      if ConnectData.pUnk <> nil then
        (ConnectData.pUnk as IPartServerEvents).OnAdd(varFields, varValues);
  end;
end;

procedure TPartServer.DeletePart(const PartNumber: WideString);
var
  Enum: IEnumConnections;
  ConnectData: TConnectData;
  Fetched: Cardinal;
begin
  if PartDM.DeletePart(PartNumber) then begin
    Enum := GetEnumerator;
    if Enum <> nil then begin
      while Enum.Next(1, ConnectData, @Fetched) = S_OK do
        if ConnectData.pUnk <> nil then
          (ConnectData.pUnk as IPartServerEvents).OnDelete(PartNumber);
    end;
  end;
end;

procedure TPartServer.ModifyPart(const PartNumber: WideString; varFields,
  varValues: OleVariant);
var
  Enum: IEnumConnections;
  ConnectData: TConnectData;
  Fetched: Cardinal;
begin
  PartDM.ModifyPart(PartNumber, varFields, varValues);

  Enum := GetEnumerator;
  if Enum <> nil then begin
    while Enum.Next(1, ConnectData, @Fetched) = S_OK do
      if ConnectData.pUnk <> nil then
        (ConnectData.pUnk as IPartServerEvents).OnModify(PartNumber, varFields, varValues);
  end;
end;

procedure TPartServer.UsePart(const PartNumber: WideString;
  Quantity: Integer);
var
  NewQuantity: Integer;
  Enum: IEnumConnections;
  ConnectData: TConnectData;
  Fetched: Cardinal;
  varFields: OleVariant;
  varValues: OleVariant;
begin
  NewQuantity := PartDM.UsePart(PartNumber, Quantity);

  varFields := VarArrayCreate([0, 0], varVariant);
  varValues := VarArrayCreate([0, 0], varVariant);
  varFields[0] := fnOnHand;
  varValues[0] := NewQuantity;

  Enum := GetEnumerator;
  if Enum <> nil then begin
    while Enum.Next(1, ConnectData, @Fetched) = S_OK do
      if ConnectData.pUnk <> nil then
        (ConnectData.pUnk as IPartServerEvents).OnModify(PartNumber, varFields, varValues);
  end;
end;

function TPartServer.GetEnumerator: IEnumConnections;
var
  Container: IConnectionPointContainer;
  ConnectionPoint: IConnectionPoint;
begin
  OleCheck(QueryInterface(IConnectionPointContainer, Container));
  OleCheck(Container.FindConnectionPoint(AutoFactory.EventIID, ConnectionPoint));
  ConnectionPoint.EnumConnections(Result);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TPartServer, Class_PartServer,
    ciMultiInstance, tmApartment);
end.