DELPHI 与 ACTIVESYNC通讯判断连接单元

最新推荐文章于 2025-11-23 12:08:37 发布

原创最新推荐文章于 2025-11-23 12:08:37 发布 · 1.1k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#delphi #通讯 #function #integer #constructor #destructor

DELPHI 专栏收录该内容

2 篇文章

订阅专栏

这个博客详细介绍了如何使用DELPHI与ACTIVESYNC进行通信，并通过定义IDccManSink接口来监听和处理各种连接状态，如IP地址改变、连接关闭、活动状态等。同时，展示了TDccMan类的实现，用于管理和监控ACTIVESYNC的连接状态。

unit AutoSink; interface uses Windows, Classes, ActiveX, SysUtils, ComObj, Dialogs; const CLSID_DccMan : TGUID = '{499C0C20-A766-11cf-8011-00A0C90A8F78}'; IID_IDccMan : TGUID = '{A7B88841-A812-11cf-8011-00A0C90A8F78}'; IID_IDccManSink : TGUID = '{A7B88840-A812-11cf-8011-00A0C90A8F78}'; type IDccManSink = interface(IUnknown) ['{A7B88840-A812-11cf-8011-00A0C90A8F78}'] function OnLogIpAddr(dwIpAddr : DWORD): HResult; stdcall; function OnLogTerminated: HResult; stdcall; function OnLogActive: HResult; stdcall; function OnLogInactive: HResult; stdcall; function OnLogAnswered: HResult; stdcall; function OnLogListen: HResult; stdcall; function OnLogDisconnection: HResult; stdcall; function OnLogError: HResult; stdcall; end; LPDCCMANSINK = ^IDccManSink; IDccMan = interface(IUnknown) ['{A7B88841-A812-11cf-8011-00A0C90A8F78}'] function Advise(pDccSink : LPDCCMANSINK; var pdwContext : DWORD): HResult; stdcall; function Unadvise(dwContext : DWORD): HResult; stdcall; function ShowCommSettings: HResult; stdcall; function AutoconnectEnable: HResult; stdcall; function AutoconnectDisable: HResult; stdcall; function ConnectNow: HResult; stdcall; function DisconnectNow: HResult; stdcall; function SetIconDataTransferring: HResult; stdcall; function SetIconNoDataTransferring: HResult; stdcall; function SetIconError: HResult; stdcall; end; //LPDCCMAN = ^IDccMan; {$M+} { Déclaration forward pour FOwner } TDccMan = class; { Déclaration TDccEventSink } TDccEventSink = class(TInterfacedObject, IUnknown, IDccManSink) private FNbRef : integer; FOnLogEtat : string; FOnLogIndex : integer; FOwner : TDccMan; public { IUnknown } function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; { IDccManSink} function OnLogIpAddr(dwIpAddr : DWORD): HResult; stdcall; function OnLogTerminated: HResult; stdcall; function OnLogActive: HResult; stdcall; function OnLogInactive: HResult; stdcall; function OnLogAnswered: HResult; stdcall; function OnLogListen: HResult; stdcall; function OnLogDisconnection: HResult; stdcall; function OnLogError: HResult; stdcall; constructor Create(AOwner : TDccMan); destructor Destroy; override; function RehercheInterface(var p : LPDCCMANSINK) : HResult; property OnLogEtat : string read FOnLogEtat stored ''; property OnLogIndex : integer read FOnLogIndex stored - 1; published // end; //pDccEventSink = ^TDccEventSink; { Déclaration TDccMan } TDccMan = class private FIDccMan : IDccMan; FdwContext : DWORD; FDccSync : TDccEventSink; FpIMS : LPDCCMANSINK; FComLib : boolean; FQI : boolean; FAdvise : boolean; FOnChange : TNotifyEvent; procedure DoChange(Sender : TObject); public constructor Create; destructor Destroy; override; procedure Advise; procedure Unadvise; procedure ShowCommSettings; function LitEtat : string; function LitIndex : integer; property ComLibOk : boolean read FComLib stored false; property InterfaceOk : boolean read FQI stored false; property NotificationOk : boolean read FAdvise stored false; property Etat : string read LitEtat stored ''; property IndexOnLog : integer read LitIndex stored - 1; published property OnChange : TNotifyEvent read FOnChange write FOnChange; end; implementation { TDccMan implementation } constructor TDccMan.Create; var hr : HRESULT; begin inherited Create; CoInitialize(nil); FComLib := false; FQI := false; FAdvise := false; hr := CoCreateInstance(CLSID_DccMan, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IID_IDccMan, FIDccMan); if SUCCEEDED(hr) then begin FComLib := true; FDccSync := TDccEventSink.Create(Self); hr := FDccSync.RehercheInterface(FpIMS); if SUCCEEDED(hr) then FQI := true; end; end; destructor TDccMan.Destroy; begin Unadvise; if Assigned(FDccSync) then FDccSync.Free; CoUninitialize; inherited Destroy; end; procedure TDccMan.Advise; var hr : HRESULT; begin // apparemment on peut cumuler les appels // si déjà Advise redonne l'état actuel (actif ou autre) // peut être utile, mais le contexte a changé !! if FQI and not FAdvise then begin hr := FIDccMan.Advise(FpIMS, FdwContext); if SUCCEEDED(hr) then FAdvise := true; end; end; procedure TDccMan.Unadvise; begin if FAdvise then begin FIDccMan.Unadvise(FdwContext); FAdvise := false; end; end; procedure TDccMan.ShowCommSettings; begin if FComLib then FIDccMan.ShowCommSettings; end; function TDccMan.LitEtat : string; begin if Assigned(FDccSync) then Result := FDccSync.FOnLogEtat else Result := ''; end; function TDccMan.LitIndex : integer; begin if Assigned(FDccSync) then Result := FDccSync.FOnLogIndex else Result := - 1; end; procedure TDccMan.DoChange(Sender : TObject); begin if Assigned(FOnChange) then FOnChange(Self); end; { TDccEventSink implementation } constructor TDccEventSink.Create(AOwner : TDccMan); begin inherited Create; FNbRef := 0; FOwner := AOwner; end; destructor TDccEventSink.Destroy; begin _Release; inherited Destroy; end; function TDccEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT; begin Result := E_NOINTERFACE; if GetInterface(IID, Obj) then Result := S_OK; end; function TDccEventSink.RehercheInterface(var p : LPDCCMANSINK) : HResult; begin Result := QueryInterface(IID_IDccManSink, p); end; function TDccEventSink._AddRef: Integer; begin InterLockedIncrement(FNbRef); { FOnLogIndex := 200; FOnLogEtat := Format('AddRef %d', [FNbRef]); FOwner.DoChange(Self); } Result := 2; end; function TDccEventSink._Release: Integer; begin InterLockedDecrement(FNbRef); { FOnLogIndex := 100; FOnLogEtat := Format('Release %d', [FNbRef]); FOwner.DoChange(Self); } Result := 1; end; function TDccEventSink.OnLogIpAddr(dwIpAddr : DWORD): HResult; begin FOnLogIndex := 1; FOnLogEtat := Format('IP Adress : %d.%d.%d.%d', [dwIpAddr and $FF, (dwIpAddr and $FF00) shr 8, (dwIpAddr and $FF0000) shr 16, dwIpAddr shr 24]); FOwner.DoChange(Self); Result := NO_ERROR; end; function TDccEventSink.OnLogTerminated: HResult; begin FOnLogIndex := 2; FOnLogEtat := 'Closed'; FOwner.DoChange(Self); Result := NO_ERROR; end; function TDccEventSink.OnLogActive: HResult; begin FOnLogIndex := 3; FOnLogEtat := 'Active'; FOwner.DoChange(Self); Result := NO_ERROR; end; function TDccEventSink.OnLogInActive: HResult; begin FOnLogIndex := 4; FOnLogEtat := 'Inactive'; FOwner.DoChange(Self); Result := NO_ERROR; end; function TDccEventSink.OnLogAnswered: HResult; begin FOnLogIndex := 5; FOnLogEtat := 'Answer'; FOwner.DoChange(Self); Result := NO_ERROR; end; function TDccEventSink.OnLogListen: HResult; begin FOnLogIndex := 6; FOnLogEtat := 'Listen'; FOwner.DoChange(Self); Result := NO_ERROR; end; function TDccEventSink.OnLogDisconnection: HResult; begin FOnLogIndex := 7; FOnLogEtat := 'Disconnected'; FOwner.DoChange(Self); Result := NO_ERROR; end; function TDccEventSink.OnLogError: HResult; begin FOnLogIndex := 8; FOnLogEtat := 'Error'; FOwner.DoChange(Self); Result := NO_ERROR; end; end.