小弟參考了網路上的元件(DELPHI寫的), 重新以 BCB 改寫,
結果動作不正常, 收不到 MESSAGE 也發不出去, 還請各位
幫忙看一下, 是那些地方的處理有問題.
程式一:
//--------------------------------------------------------------------------- #ifndef SkypeH
#define SkypeH
//---------------------------------------------------------------------------
#include
#include
#include
#include <Forms.hpp> //---------------------------------------------------------------------------
#define SKYPECONTROLAPI_ATTACH_SUCCESS 0x0000
#define SKYPECONTROLAPI_ATTACH_PENDING_AUTHORIZATION 0x0001
#define SKYPECONTROLAPI_ATTACH_REFUSED 0x0002
#define SKYPECONTROLAPI_ATTACH_NOT_AVAILABLE 0x0003
#define SKYPECONTROLAPI_ATTACH_AVAILABLE 0x8001 enum SkypeControlAPI_Result {
saSuccess = SKYPECONTROLAPI_ATTACH_SUCCESS,
saPendingAuth = SKYPECONTROLAPI_ATTACH_PENDING_AUTHORIZATION,
saRefused = SKYPECONTROLAPI_ATTACH_REFUSED,
saNotAvailable = SKYPECONTROLAPI_ATTACH_NOT_AVAILABLE,
saAvailable = SKYPECONTROLAPI_ATTACH_AVAILABLE
}; typedef void __fastcall (__closure *TSkypeAttachEvent)(TObject *Sender, SkypeControlAPI_Result Result);
typedef void __fastcall (__closure *TSkypeMessageEvent)(TObject *Sender, AnsiString AMessage);
//---------------------------------------------------------------------------
class PACKAGE TSkype : public TComponent
{
private:
bool FActive;
HWND FHandle;
HWND FSkype;
TSkypeAttachEvent FOnAttach;
TSkypeMessageEvent FOnMessage;
bool __fastcall IsInstalled(void);
int __fastcall SendDetectMessage(void);
void __fastcall SetActive(bool AValue);
protected:
int __fastcall SendAMessage(UINT Msg, LPARAM LParam);
void __fastcall WndProc(Messages::TMessage &Message);
public:
__fastcall TSkype(TComponent* Owner);
// virtual __fsatcall TSkype(TComponent* Owner);
__fastcall ~TSkype();
void __fastcall SkypeMessage(AnsiString AMessage); __published:
__property bool Active = {read=FActive, write=SetActive};
__property TSkypeAttachEvent OnAttach = {read=FOnAttach, write=FOnAttach};
__property TSkypeMessageEvent OnMessage = {read=FOnMessage, write=FOnMessage};
};
//---------------------------------------------------------------------------
#endif
程式二:
#include
#include
#pragma hdrstop
#pragma resource "skype.res" #include "Skype.h"
#pragma package(smart_init)
//---------------------------------------------------------------------------
// ValidCtrCheck is used to assure that the components created do not have
// any pure virtual functions.
//
//---------------------------------------------------------------------------
Cardinal WM_SkypeAPIAttach;
Cardinal WM_SkypeAPIDiscover;
//---------------------------------------------------------------------------
static inline void ValidCtrCheck(TSkype *)
{
new TSkype(NULL);
}
//---------------------------------------------------------------------------
__fastcall TSkype::TSkype(TComponent* Owner)
: TComponent(Owner)
{
// inherited new(Owner);
WM_SkypeAPIAttach = RegisterWindowMessage("SkypeControlAPIAttach");
WM_SkypeAPIDiscover = RegisterWindowMessage("SkypeControlAPIDiscover");
FHandle = AllocateHWnd(WndProc); // Top Level Handle
FSkype = NULL;
FActive = false;
}
//---------------------------------------------------------------------------
__fastcall TSkype::~TSkype()
{
if ( Active )
{
Active = false;
}
DeallocateHWnd(FHandle);
// inherited; }
//---------------------------------------------------------------------------
namespace Skype
{
void __fastcall PACKAGE Register()
{
TComponentClass classes[1] = {__classid(TSkype)};
RegisterComponents("Samples", classes, 0);
}
}
//---------------------------------------------------------------------------
bool __fastcall TSkype::IsInstalled(void)
{
AnsiString SkypeKey = "\\SOFTWARE\\Skype\\Phone"; // Do not localize!
AnsiString SkypeVal = "SkypePath"; // Do not localize!
TRegistry *Registry = new TRegistry;
bool bFlag = false; try {
Registry->RootKey = HKEY_CURRENT_USER;
if ( Registry->OpenKeyReadOnly(SkypeKey) == true )
{
if ( Registry->ValueExists(SkypeVal) == true )
{
if ( FileExists(Registry->ReadString(SkypeVal)) == true )
{
bFlag = true;
}
}
}
else
{
Registry->RootKey = HKEY_LOCAL_MACHINE;
if ( Registry->OpenKeyReadOnly(SkypeKey) == true )
{
if ( Registry->ValueExists(SkypeVal) == true )
{
if ( FileExists(Registry->ReadString(SkypeVal)) == true )
{
bFlag = true;
}
}
}
}
} // try
catch(ERegistryException& E)
{
}
Registry->Free();
return bFlag;
}
//---------------------------------------------------------------------------
int __fastcall TSkype::SendAMessage(UINT Msg, LPARAM LParam)
{
if ( Active == true )
return SendMessage(FSkype, Msg, (UINT)FHandle, LParam);
else
return false;
}
//---------------------------------------------------------------------------
int __fastcall TSkype::SendDetectMessage(void)
{
return SendMessage(HWND_BROADCAST, WM_SkypeAPIDiscover, (UINT)FHandle, 0);
}
//---------------------------------------------------------------------------
void __fastcall TSkype::SetActive(bool AValue)
{
if ( FActive != AValue )
{
if ( AValue == true )
{
if ( !IsInstalled() )
{
throw "Skype is not installed!";
}
SendDetectMessage();
//Todo: Write more code...
}
else
{
//Todo: Write more code...
}
FActive = AValue;
}
}
//---------------------------------------------------------------------------
void __fastcall TSkype::SkypeMessage(AnsiString AMessage)
{
COPYDATASTRUCT _CDS; _CDS.dwData = 0;
_CDS.lpData = AMessage.c_str();
_CDS.cbData = AMessage.Length() 1;
SendAMessage(WM_COPYDATA, (LPARAM)&_CDS);
}
//---------------------------------------------------------------------------
void __fastcall TSkype::WndProc(Messages::TMessage &Message)
{
if ( Active == true )
{
if ( Message.Msg == WM_SkypeAPIAttach )
{
//Todo: Write more code...
switch ( SkypeControlAPI_Result(Message.LParam) ) {
case saSuccess:
FSkype = (HWND)Message.WParam;
break;
case saPendingAuth:
break;
case saRefused:
break;
case saNotAvailable:
break;
case saAvailable:
break;
}
if ( FOnAttach )
FOnAttach(this, SkypeControlAPI_Result(Message.LParam));
Message.Result = 1;
}
else
{
switch (Message.Msg) {
case WM_COPYDATA :
if ( (HWND)Message.WParam == FSkype )
if ( FOnMessage )
FOnMessage(this, (char)((PCOPYDATASTRUCT)Message.LParam)->lpData);
Message.Result = 1;
break;
// default:
// Message.Result = DefWindowProc(FHandle, Message.Msg, Message.WParam, Message.LParam);
}
}
}
// else
// Message.Result = DefWindowProc(FHandle, Message.Msg, Message.WParam, Message.LParam);
}
//---------------------------------------------------------------------------
程式三: 原始元件源碼
unit SkypeEx; interface uses Classes, Messages; const
SKYPECONTROLAPI_ATTACH_SUCCESS = $0000;
SKYPECONTROLAPI_ATTACH_PENDING_AUTHORIZATION = $0001;
SKYPECONTROLAPI_ATTACH_REFUSED = $0002;
SKYPECONTROLAPI_ATTACH_NOT_AVAILABLE = $0003;
SKYPECONTROLAPI_ATTACH_AVAILABLE = $8001; type
SkypeControlAPI_Result = (saSuccess = SKYPECONTROLAPI_ATTACH_SUCCESS,
saPendingAuth = SKYPECONTROLAPI_ATTACH_PENDING_AUTHORIZATION,
saRefused = SKYPECONTROLAPI_ATTACH_REFUSED,
saNotAvailable = SKYPECONTROLAPI_ATTACH_NOT_AVAILABLE,
saAvailable = SKYPECONTROLAPI_ATTACH_AVAILABLE); type
TSkypeAttachEvent = procedure (Sender : TObject; Result : SkypeControlAPI_Result) of object;
TSkypeMessageEvent = procedure (sender : TObject; AMessage : string) of object; TSkype = class(TComponent)
private
FActive : Boolean;
FHandle : THandle;
FOnAttach : TSkypeAttachEvent;
FSkype : THandle;
FOnMessage: TSkypeMessageEvent;
function IsInstalled : Boolean;
function SendDetectMessage : Integer;
procedure SetActive(AValue : Boolean);
protected
function SendAMessage(AMsg : Cardinal; LParam : Integer) : Integer;
procedure WndProc(var AMessage : TMessage);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure SkypeMessage(AMessage : string);
published
property Active : Boolean read FActive write SetActive;
property OnAttach : TSkypeAttachEvent read FOnAttach write FOnAttach;
property OnMessage : TSkypeMessageEvent read FOnMessage write FOnMessage;
end; implementation uses Registry, SysUtils, Windows; var
WM_SkypeAPIAttach : Cardinal;
WM_SkypeAPIDiscover : Cardinal; { TSkype } constructor TSkype.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FActive := False;
FHandle := Classes.AllocateHWnd(WndProc); // Top Level Handle
FSkype := 0;
end; destructor TSkype.Destroy;
begin
if Active then Active := False;
Classes.DeallocateHWnd(FHandle);
inherited;
end; function TSkype.IsInstalled : Boolean;
const
SkypeKey = '\SOFTWARE\Skype\Phone'; // Do not localize!
SkypeVal = 'SkypePath'; // Do not localize!
begin
with TRegistry.Create do try
RootKey := HKEY_CURRENT_USER;
Result := OpenKeyReadOnly(SkypeKey) and ValueExists(SkypeVal) and FileExists(ReadString(SkypeVal));
if not Result then
RootKey := HKEY_LOCAL_MACHINE;
Result := OpenKeyReadOnly(SkypeKey) and ValueExists(SkypeVal) and FileExists(ReadString(SkypeVal));
finally Free; end;
end; function TSkype.SendAMessage(AMsg : Cardinal; LParam : Integer) : Integer;
begin
Result := Integer(nil);
if Active then
Result := SendMessage(FSkype, AMsg, FHandle, LParam);
end; function TSkype.SendDetectMessage : Integer;
begin
Result := SendMessage(HWND_BROADCAST, WM_SkypeAPIDiscover, FHandle, 0);
end; procedure TSkype.SetActive(AValue : Boolean);
begin
if FActive <> AValue then begin
if AValue then begin
if not IsInstalled then raise Exception.Create('Skype is not installed!');
SendDetectMessage;
//Todo: Write more code...
end else begin
//Todo: Write more code...
end;
FActive := AValue;
end;
end; procedure TSkype.SkypeMessage(AMessage : string);
var _CDS : COPYDATASTRUCT;
begin
_CDS.dwData := 0;
_CDS.lpData := PChar(AMessage);
_CDS.cbData := Length(AMessage) 1;
SendAMessage(WM_COPYDATA, Integer(@_CDS));
end; procedure TSkype.WndProc(var AMessage : TMessage);
var s : string;
begin
with AMessage do begin
if Active then begin
Result := -1;
if Msg = WM_SkypeAPIAttach then begin
//Todo: Write more code...
case SkypeControlAPI_Result(LParam) of
saSuccess : FSkype := WParam;
saPendingAuth : ;
saRefused : ;
saNotAvailable : ;
saAvailable : ;
end;
if Assigned(FOnAttach) then FOnAttach(Self, SkypeControlAPI_Result(LParam));
end else
case Msg of
WM_COPYDATA : if WParam = FSkype then begin
s := StrPas(TWMCopyData(AMessage).CopyDataStruct.lpData);
if Assigned(FOnMessage) then FOnMessage(Self, s);
end;
else
Result := DefWindowProc(FHandle, Msg, wParam, lParam);
end;
end else Result := DefWindowProc(FHandle, Msg, wParam, lParam);
end;//with...
end; initialization
WM_SkypeAPIAttach := RegisterWindowMessage('SkypeControlAPIAttach');
WM_SkypeAPIDiscover := RegisterWindowMessage('SkypeControlAPIDiscover'); end.