2005. december 15., csütörtök
Take Full Control Over ICQ
Problem/Question/Abstract:
Hi,
this is a full component source code that you can used to connect to ICQ© servers and do whatever you want, please notice, this is the code that is used by all programs available at http://www.8th-wonder.net .
Please do not ask me HOW to use the code, and notice that i posted here for EDUCATIONAL PORPUSES ONLY !!!
Answer:
unit IcqUdp;
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;
const
// TypeLibrary Major and minor versions
IcqUdpCtlMajorVersion = 1;
IcqUdpCtlMinorVersion = 0;
LIBID_IcqUdpCtl: TGUID = '{0A563493-2028-11D5-A2A7-00105A8619E7}';
IID__IcqUdp: TGUID = '{0A56349F-2028-11D5-A2A7-00105A8619E7}';
DIID___IcqUdp: TGUID = '{0A5634A2-2028-11D5-A2A7-00105A8619E7}';
IID__proppgGeneral: TGUID = '{0A5634AB-2028-11D5-A2A7-00105A8619E7}';
CLASS_proppgGeneral: TGUID = '{0A5634AC-2028-11D5-A2A7-00105A8619E7}';
IID__clsIcqUtilities: TGUID = '{0A563494-2028-11D5-A2A7-00105A8619E7}';
CLASS_clsIcqUtilities: TGUID = '{0A563495-2028-11D5-A2A7-00105A8619E7}';
CLASS_IcqUdp: TGUID = '{0A5634A0-2028-11D5-A2A7-00105A8619E7}';
type
enumInfoGender = TOleEnum;
const
icqMale = $00000002;
icqFemale = $00000001;
icqNotSpecified = $00000000;
// Constants for enum enumMessageType
type
enumMessageType = TOleEnum;
const
icqMsgText = $00000001;
icqMsgChatReq = $00000002;
icqMsgFile = $00000003;
icqMsgURL = $00000004;
icqMsgAuthReq = $00000006;
icqMsgAuthDecline = $00000007;
icqMsgAuthAccept = $00000008;
icqMsgAdded = $0000000C;
icqMsgWebpager = $0000000D;
icqMsgExpress = $0000000E;
icqMsgContact = $00000013;
// Constants for enum enumOnlineState
type
enumOnlineState = TOleEnum;
const
icqOnline = $00000000;
icqAway = $00000001;
icqNa = $00000005;
icqOccupied = $00000011;
icqDND = $00000013;
icqChat = $00000020;
icqInvisible = $00000100;
// Constants for enum enumUseTCP
type
enumUseTCP = TOleEnum;
const
icqNoTCP = $00000001;
icqTCPSendOnly = $00000002;
icqTCPSendRecv = $00000004;
// Constants for enum enumRandomGroup
type
enumRandomGroup = TOleEnum;
const
icqGrpGeneral = $00000001;
icqGrpRomance = $00000002;
icqGrpGames = $00000003;
icqGrpStudents = $00000004;
icqGrp20Something = $00000006;
icqGrp30Something = $00000007;
icqGrp40Something = $00000008;
icqGrp50Over = $00000009;
icqGrpManRequestWoman = $0000000A;
icqGrpWomanRequestMan = $0000000B;
// Constants for enum enumConnectionSate
type
enumConnectionSate = TOleEnum;
const
icqDisconnected = $00000000;
icqRegistering = $00000001;
icqLogin = $00000002;
icqConnected = $00000003;
// Constants for enum enumSearchResult
type
enumSearchResult = TOleEnum;
const
icqSearchUserFound = $00000000;
icqSearchDone = $00000001;
icqSearchTooMany = $00000002;
// Constants for enum enumInfoType
type
enumInfoType = TOleEnum;
const
icqNewUser = $00000000;
icqBasic = $00000001;
icqMain = $00000002;
icqMore = $00000003;
icqMetaMore = $0000000B;
icqWork = $00000004;
icqInterest = $00000005;
icqAffiliations = $00000006;
icqAbout = $00000007;
icqSecurity = $00000008;
icqHPCategory = $00000009;
icqall = $0000000A;
// Constants for enum enumErrorConstant
type
enumErrorConstant = TOleEnum;
const
icqErrNotConnected = $00000001;
icqErrWrongPassword = $00000002;
icqErrTryAgain = $00000003;
icqErrGoAway = $00000004;
icqErrInvalidUIN = $00000005;
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
_IcqUdp = interface;
_IcqUdpDisp = dispinterface;
__IcqUdp = dispinterface;
_proppgGeneral = interface;
_proppgGeneralDisp = dispinterface;
_clsIcqUtilities = interface;
_clsIcqUtilitiesDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
proppgGeneral = _proppgGeneral;
clsIcqUtilities = _clsIcqUtilities;
IcqUdp = _IcqUdp;
// *********************************************************************//
// Declaration of structures, unions and aliases.
// *********************************************************************//
typContactInfo = packed record
lngUIN: Integer;
strNickname: WideString;
strFirstName: WideString;
strLastName: WideString;
strEmail: WideString;
strEmail2: WideString;
strEmail3: WideString;
strCity: WideString;
strState: WideString;
strPhone: WideString;
strFax: WideString;
strStreet: WideString;
strCellular: WideString;
lngZip: Integer;
intCountryCode: Smallint;
byteTimeZone: Byte;
bEmailHide: WordBool;
intAge: Smallint;
byteGender: Byte;
strHomepageURL: WideString;
byteBirthYear: Byte;
byteBirthMonth: Byte;
byteBirthDay: Byte;
byteLanguage1: Byte;
byteLanguage2: Byte;
byteLanguage3: Byte;
strAboutInfo: WideString;
strWorkCity: WideString;
strWorkState: WideString;
strWorkPhone: WideString;
strWorkFax: WideString;
strWorkAddress: WideString;
lngWorkZip: Integer;
intWorkCountry: Smallint;
strWorkName: WideString;
strWorkDepartment: WideString;
strWorkPosition: WideString;
intWorkOccupation: Smallint;
strWorkWebURL: WideString;
byteInterestTotal: Byte;
intInterestCategory: array[0..3] of Smallint;
strInterestName: array[0..3] of WideString;
byteBackgroundTotal: Byte;
intBackgroundCategory: array[0..3] of Smallint;
strBackgroundName: array[0..3] of WideString;
byteOrganizationTotal: Byte;
intOrganizationCategory: array[0..3] of Smallint;
strOrganizationName: array[0..3] of WideString;
byteHPCategoryTotal: Byte;
intHPCategoryCategory: array[0..3] of Smallint;
strHPCategoryName: array[0..3] of WideString;
bAuthorize: WordBool;
bWebPresence: WordBool;
bPublishIP: WordBool;
end;
// *********************************************************************//
// Interface: _IcqUdp
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {0A56349F-2028-11D5-A2A7-00105A8619E7}
// *********************************************************************//
_IcqUdp = interface(IDispatch)
['{0A56349F-2028-11D5-A2A7-00105A8619E7}']
procedure Connect; safecall;
procedure Disconnect; safecall;
procedure Register(var Password: WideString); safecall;
procedure ChangePassword(var Password: WideString); safecall;
function SendAdded(uin: Integer; var Nickname: WideString; var EmailAddress:
WideString): Smallint; safecall;
procedure ContactAdd(var UINList: PSafeArray); safecall;
procedure VisibleAdd(var UINList: PSafeArray); safecall;
procedure InvisibleAdd(var UINList: PSafeArray); safecall;
procedure VisibleRemove(var UINList: PSafeArray); safecall;
procedure InvisibleRemove(var UINList: PSafeArray); safecall;
procedure InfoRequestBasic(uin: Integer); safecall;
procedure InfoRequestMore(uin: Integer); safecall;
procedure InfoRequestAll(uin: Integer); safecall;
procedure InfoUpdate(InfoUpdateType: enumInfoType; var InfoDetail: TGUID);
safecall;
procedure SearchUin(uin: Integer); safecall;
procedure SearchName(const Nickname: WideString; const Firstname: WideString;
const Lastname: WideString); safecall;
procedure SearchEmail(const EmailAddress: WideString); safecall;
function SendText(uin: Integer; const Message: WideString): Smallint; safecall;
function SendURL(uin: Integer; const URLAddress: WideString; const URLDescription:
WideString): Smallint; safecall;
function SendAuthReq(uin: Integer; const Nickname: WideString; const Firstname:
WideString;
const Lastname: WideString; const EmailAddress: WideString;
const Reason: WideString): Smallint; safecall;
function SendAuthAccept(uin: Integer): Smallint; safecall;
function SendAuthDecline(uin: Integer; const Reason: WideString): Smallint;
safecall;
function SendContact(uin: Integer; UINList: OleVariant; NickList: OleVariant):
Smallint; safecall;
function SendUserAdd(uin: Integer): Smallint; safecall;
function Get_UserUin: Integer; safecall;
procedure Set_UserUin(Param1: Integer); safecall;
function Get_UserPassword: WideString; safecall;
procedure Set_UserPassword(const Param1: WideString); safecall;
function Get_LocalIP: WideString; safecall;
procedure Set_LocalIP(const Param1: WideString); safecall;
function Get_LocalRealIP: WideString; safecall;
procedure Set_LocalRealIP(const Param1: WideString); safecall;
function Get_LocalPort: Smallint; safecall;
procedure Set_LocalPort(Param1: Smallint); safecall;
function Get_RemoteHost: WideString; safecall;
procedure Set_RemoteHost(const Param1: WideString); safecall;
function Get_RemotePort: Smallint; safecall;
procedure Set_RemotePort(Param1: Smallint); safecall;
function Get_UseTCP: enumUseTCP; safecall;
procedure Set_UseTCP(Param1: enumUseTCP); safecall;
function Get_SocketState: enumConnectionSate; safecall;
procedure Set_SocketState(Param1: enumConnectionSate); safecall;
function Get_OnlineState: enumOnlineState; safecall;
procedure Set_OnlineState(Param1: enumOnlineState); safecall;
procedure ShowAboutBox; safecall;
property UserUin: Integer read Get_UserUin write Set_UserUin;
property UserPassword: WideString read Get_UserPassword write Set_UserPassword;
property LocalIP: WideString read Get_LocalIP write Set_LocalIP;
property LocalRealIP: WideString read Get_LocalRealIP write Set_LocalRealIP;
property LocalPort: Smallint read Get_LocalPort write Set_LocalPort;
property RemoteHost: WideString read Get_RemoteHost write Set_RemoteHost;
property RemotePort: Smallint read Get_RemotePort write Set_RemotePort;
property UseTCP: enumUseTCP read Get_UseTCP write Set_UseTCP;
property SocketState: enumConnectionSate read Get_SocketState write
Set_SocketState;
property OnlineState: enumOnlineState read Get_OnlineState write Set_OnlineState;
end;
// *********************************************************************//
// DispIntf: _IcqUdpDisp
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {0A56349F-2028-11D5-A2A7-00105A8619E7}
// *********************************************************************//
_IcqUdpDisp = dispinterface
['{0A56349F-2028-11D5-A2A7-00105A8619E7}']
procedure Connect; dispid 1610809366;
procedure Disconnect; dispid 1610809367;
procedure Register(var Password: WideString); dispid 1610809368;
procedure ChangePassword(var Password: WideString); dispid 1610809369;
function SendAdded(uin: Integer; var Nickname: WideString; var EmailAddress:
WideString): Smallint; dispid 1610809370;
procedure ContactAdd(var UINList: {??PSafeArray} OleVariant); dispid 1610809371;
procedure VisibleAdd(var UINList: {??PSafeArray} OleVariant); dispid 1610809372;
procedure InvisibleAdd(var UINList: {??PSafeArray} OleVariant); dispid 1610809373;
procedure VisibleRemove(var UINList: {??PSafeArray} OleVariant); dispid
1610809374;
procedure InvisibleRemove(var UINList: {??PSafeArray} OleVariant); dispid
1610809375;
procedure InfoRequestBasic(uin: Integer); dispid 1610809376;
procedure InfoRequestMore(uin: Integer); dispid 1610809377;
procedure InfoRequestAll(uin: Integer); dispid 1610809378;
procedure InfoUpdate(InfoUpdateType: enumInfoType; var InfoDetail: {??TGUID}
OleVariant); dispid 1610809379;
procedure SearchUin(uin: Integer); dispid 1610809380;
procedure SearchName(const Nickname: WideString; const Firstname: WideString;
const Lastname: WideString); dispid 1610809381;
procedure SearchEmail(const EmailAddress: WideString); dispid 1610809382;
function SendText(uin: Integer; const Message: WideString): Smallint; dispid
1610809383;
function SendURL(uin: Integer; const URLAddress: WideString; const URLDescription:
WideString): Smallint; dispid 1610809384;
function SendAuthReq(uin: Integer; const Nickname: WideString; const Firstname:
WideString;
const Lastname: WideString; const EmailAddress: WideString;
const Reason: WideString): Smallint; dispid 1610809385;
function SendAuthAccept(uin: Integer): Smallint; dispid 1610809386;
function SendAuthDecline(uin: Integer; const Reason: WideString): Smallint; dispid
1610809387;
function SendContact(uin: Integer; UINList: OleVariant; NickList: OleVariant):
Smallint; dispid 1610809388;
function SendUserAdd(uin: Integer): Smallint; dispid 1610809389;
property UserUin: Integer dispid 1745027081;
property UserPassword: WideString dispid 1745027080;
property LocalIP: WideString dispid 1745027079;
property LocalRealIP: WideString dispid 1745027078;
property LocalPort: Smallint dispid 1745027077;
property RemoteHost: WideString dispid 1745027076;
property RemotePort: Smallint dispid 1745027075;
property UseTCP: enumUseTCP dispid 1745027074;
property SocketState: enumConnectionSate dispid 1745027073;
property OnlineState: enumOnlineState dispid 1745027072;
procedure ShowAboutBox; dispid - 552;
end;
// *********************************************************************//
// DispIntf: __IcqUdp
// Flags: (4240) Hidden NonExtensible Dispatchable
// GUID: {0A5634A2-2028-11D5-A2A7-00105A8619E7}
// *********************************************************************//
__IcqUdp = dispinterface
['{0A5634A2-2028-11D5-A2A7-00105A8619E7}']
procedure Connected; dispid 1;
procedure Disconnected; dispid 2;
procedure Registered; dispid 3;
procedure ContactOnline(var uin: Integer; var OnlineState: enumOnlineState;
var IntIP: WideString; var ExtIP: WideString; var ExtPort: Integer;
var bTcpCapable: WordBool; var TcpVersion: Integer); dispid 4;
procedure ContactStatusChange(var uin: Integer; var State: enumOnlineState);
dispid 5;
procedure ContactOffline(var uin: Integer); dispid 6;
procedure InfoReply(var InfoType: enumInfoType; var Info: {??TGUID} OleVariant);
dispid 7;
procedure SearchReply(var uin: Integer; var Nick: WideString; var First:
WideString;
var Last: WideString; var Email: WideString; var bAuth: WordBool;
var SearchResult: enumSearchResult); dispid 8;
procedure MessageReceived(var uin: Integer; var MsgDate: TDateTime; var MsgTime:
WideString;
var MsgType: enumMessageType; var MsgText: WideString;
var URLAddress: WideString; var URLDescription: WideString;
var authNick: WideString; var authFirst: WideString;
var authLast: WideString; var authEmail: WideString;
var authReason: WideString; var contNick: OleVariant;
var contUin: OleVariant); dispid 9;
procedure ErrorFound(var Number: enumErrorConstant; var Description: WideString);
dispid 10;
procedure PacketAcknowledge(var PacketSeq: Smallint); dispid 11;
procedure DebugOut(var DebugTxt: WideString); dispid 12;
end;
// *********************************************************************//
// Interface: _proppgGeneral
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {0A5634AB-2028-11D5-A2A7-00105A8619E7}
// *********************************************************************//
_proppgGeneral = interface(IDispatch)
['{0A5634AB-2028-11D5-A2A7-00105A8619E7}']
end;
// *********************************************************************//
// DispIntf: _proppgGeneralDisp
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {0A5634AB-2028-11D5-A2A7-00105A8619E7}
// *********************************************************************//
_proppgGeneralDisp = dispinterface
['{0A5634AB-2028-11D5-A2A7-00105A8619E7}']
end;
// *********************************************************************//
// Interface: _clsIcqUtilities
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {0A563494-2028-11D5-A2A7-00105A8619E7}
// *********************************************************************//
_clsIcqUtilities = interface(IDispatch)
['{0A563494-2028-11D5-A2A7-00105A8619E7}']
function GetCountryName(var Code: Smallint): WideString; safecall;
function GetCountryCode(var Index: Smallint): Smallint; safecall;
function GetCountryIndex(var CntryCode: Smallint): Smallint; safecall;
function GetLangName(var Index: Smallint): WideString; safecall;
function GetOccupationName(var Code: Smallint): WideString; safecall;
function GetOccupationCode(var Index: Smallint): Smallint; safecall;
function GetOccupationIndex(var OccupationCode: Smallint): Smallint; safecall;
function GetPastBackgroundName(var Code: Smallint): WideString; safecall;
function GetPastBackgroundCode(var Index: Smallint): Smallint; safecall;
function GetPastBackgroundIndex(var PastBackgroundCode: Smallint): Smallint;
safecall;
function GetAffiliationsName(var Code: Smallint): WideString; safecall;
function GetAffiliationsCode(var Index: Smallint): Smallint; safecall;
function GetAffiliationsIndex(var AffiliationsCode: Smallint): Smallint; safecall;
function GetTimeZone(Code: Byte): WideString; safecall;
function GetTimeCode(const strTime: WideString): Byte; safecall;
end;
// *********************************************************************//
// DispIntf: _clsIcqUtilitiesDisp
// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID: {0A563494-2028-11D5-A2A7-00105A8619E7}
// *********************************************************************//
_clsIcqUtilitiesDisp = dispinterface
['{0A563494-2028-11D5-A2A7-00105A8619E7}']
function GetCountryName(var Code: Smallint): WideString; dispid 1610809345;
function GetCountryCode(var Index: Smallint): Smallint; dispid 1610809346;
function GetCountryIndex(var CntryCode: Smallint): Smallint; dispid 1610809347;
function GetLangName(var Index: Smallint): WideString; dispid 1610809348;
function GetOccupationName(var Code: Smallint): WideString; dispid 1610809349;
function GetOccupationCode(var Index: Smallint): Smallint; dispid 1610809350;
function GetOccupationIndex(var OccupationCode: Smallint): Smallint; dispid
1610809351;
function GetPastBackgroundName(var Code: Smallint): WideString; dispid 1610809352;
function GetPastBackgroundCode(var Index: Smallint): Smallint; dispid 1610809353;
function GetPastBackgroundIndex(var PastBackgroundCode: Smallint): Smallint;
dispid 1610809354;
function GetAffiliationsName(var Code: Smallint): WideString; dispid 1610809355;
function GetAffiliationsCode(var Index: Smallint): Smallint; dispid 1610809356;
function GetAffiliationsIndex(var AffiliationsCode: Smallint): Smallint; dispid
1610809357;
function GetTimeZone(Code: Byte): WideString; dispid 1610809358;
function GetTimeCode(const strTime: WideString): Byte; dispid 1610809359;
end;
// *********************************************************************//
// The Class CoproppgGeneral provides a Create and CreateRemote method to
// create instances of the default interface _proppgGeneral exposed by
// the CoClass proppgGeneral. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoproppgGeneral = class
class function Create: _proppgGeneral;
class function CreateRemote(const MachineName: string): _proppgGeneral;
end;
// *********************************************************************//
// The Class CoclsIcqUtilities provides a Create and CreateRemote method to
// create instances of the default interface _clsIcqUtilities exposed by
// the CoClass clsIcqUtilities. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoclsIcqUtilities = class
class function Create: _clsIcqUtilities;
class function CreateRemote(const MachineName: string): _clsIcqUtilities;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TclsIcqUtilities
// Help String :
// Default Interface: _clsIcqUtilities
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TclsIcqUtilitiesProperties = class;
{$ENDIF}
TclsIcqUtilities = class(TOleServer)
private
FIntf: _clsIcqUtilities;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TclsIcqUtilitiesProperties;
function GetServerProperties: TclsIcqUtilitiesProperties;
{$ENDIF}
function GetDefaultInterface: _clsIcqUtilities;
protected
procedure InitServerData; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: _clsIcqUtilities);
procedure Disconnect; override;
function GetCountryName(var Code: Smallint): WideString;
function GetCountryCode(var Index: Smallint): Smallint;
function GetCountryIndex(var CntryCode: Smallint): Smallint;
function GetLangName(var Index: Smallint): WideString;
function GetOccupationName(var Code: Smallint): WideString;
function GetOccupationCode(var Index: Smallint): Smallint;
function GetOccupationIndex(var OccupationCode: Smallint): Smallint;
function GetPastBackgroundName(var Code: Smallint): WideString;
function GetPastBackgroundCode(var Index: Smallint): Smallint;
function GetPastBackgroundIndex(var PastBackgroundCode: Smallint): Smallint;
function GetAffiliationsName(var Code: Smallint): WideString;
function GetAffiliationsCode(var Index: Smallint): Smallint;
function GetAffiliationsIndex(var AffiliationsCode: Smallint): Smallint;
function GetTimeZone(Code: Byte): WideString;
function GetTimeCode(const strTime: WideString): Byte;
property DefaultInterface: _clsIcqUtilities read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TclsIcqUtilitiesProperties read GetServerProperties;
{$ENDIF}
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TclsIcqUtilities
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TclsIcqUtilitiesProperties = class(TPersistent)
private
FServer: TclsIcqUtilities;
function GetDefaultInterface: _clsIcqUtilities;
constructor Create(AServer: TclsIcqUtilities);
protected
public
property DefaultInterface: _clsIcqUtilities read GetDefaultInterface;
published
end;
{$ENDIF}
// *********************************************************************//
// OLE Control Proxy class declaration
// Control Name : TIcqUdp
// Help String :
// Default Interface: _IcqUdp
// Def. Intf. DISP? : No
// Event Interface: __IcqUdp
// TypeFlags : (32) Control
// *********************************************************************//
TIcqUdpContactOnline = procedure(Sender: TObject; var uin: Integer;
var OnlineState: enumOnlineState;
var IntIP: WideString; var ExtIP: WideString;
var ExtPort: Integer;
var bTcpCapable: WordBool;
var TcpVersion: Integer) of object;
TIcqUdpContactStatusChange = procedure(Sender: TObject; var uin: Integer;
var State: enumOnlineState) of object;
TIcqUdpContactOffline = procedure(Sender: TObject; var uin: Integer) of object;
TIcqUdpInfoReply = procedure(Sender: TObject; var InfoType: enumInfoType;
var Info: {??TGUID} OleVariant) of object;
TIcqUdpSearchReply = procedure(Sender: TObject; var uin: Integer; var Nick:
WideString;
var First: WideString; var Last: WideString;
var Email: WideString; var bAuth: WordBool;
var SearchResult: enumSearchResult) of object;
TIcqUdpMessageReceived = procedure(Sender: TObject; var uin: Integer; var MsgDate:
TDateTime;
var MsgTime: WideString;
var MsgType: enumMessageType;
var MsgText: WideString;
var URLAddress: WideString;
var URLDescription: WideString;
var authNick: WideString;
var authFirst: WideString;
var authLast: WideString;
var authEmail: WideString;
var authReason: WideString;
var contNick: OleVariant;
var contUin: OleVariant) of object;
TIcqUdpErrorFound = procedure(Sender: TObject; var Number: enumErrorConstant;
var Description: WideString) of object;
TIcqUdpPacketAcknowledge = procedure(Sender: TObject; var PacketSeq: Smallint) of
object;
TIcqUdpDebugOut = procedure(Sender: TObject; var DebugTxt: WideString) of object;
TIcqUdp = class(TOleControl)
private
FOnConnected: TNotifyEvent;
FOnDisconnected: TNotifyEvent;
FOnRegistered: TNotifyEvent;
FOnContactOnline: TIcqUdpContactOnline;
FOnContactStatusChange: TIcqUdpContactStatusChange;
FOnContactOffline: TIcqUdpContactOffline;
FOnInfoReply: TIcqUdpInfoReply;
FOnSearchReply: TIcqUdpSearchReply;
FOnMessageReceived: TIcqUdpMessageReceived;
FOnErrorFound: TIcqUdpErrorFound;
FOnPacketAcknowledge: TIcqUdpPacketAcknowledge;
FOnDebugOut: TIcqUdpDebugOut;
FIntf: _IcqUdp;
function GetControlInterface: _IcqUdp;
protected
procedure CreateControl;
procedure InitControlData; override;
public
procedure Connect;
procedure Disconnect;
procedure Register(var Password: WideString);
procedure ChangePassword(var Password: WideString);
function SendAdded(uin: Integer; var Nickname: WideString; var EmailAddress:
WideString): Smallint;
procedure ContactAdd(var UINList: PSafeArray);
procedure VisibleAdd(var UINList: PSafeArray);
procedure InvisibleAdd(var UINList: PSafeArray);
procedure VisibleRemove(var UINList: PSafeArray);
procedure InvisibleRemove(var UINList: PSafeArray);
procedure InfoRequestBasic(uin: Integer);
procedure InfoRequestMore(uin: Integer);
procedure InfoRequestAll(uin: Integer);
procedure InfoUpdate(InfoUpdateType: enumInfoType; var InfoDetail: TGUID);
procedure SearchUin(uin: Integer);
procedure SearchName(const Nickname: WideString; const Firstname: WideString;
const Lastname: WideString);
procedure SearchEmail(const EmailAddress: WideString);
function SendText(uin: Integer; const Message: WideString): Smallint;
function SendURL(uin: Integer; const URLAddress: WideString; const URLDescription:
WideString): Smallint;
function SendAuthReq(uin: Integer; const Nickname: WideString; const Firstname:
WideString;
const Lastname: WideString; const EmailAddress: WideString;
const Reason: WideString): Smallint;
function SendAuthAccept(uin: Integer): Smallint;
function SendAuthDecline(uin: Integer; const Reason: WideString): Smallint;
function SendContact(uin: Integer; UINList: OleVariant; NickList: OleVariant):
Smallint;
function SendUserAdd(uin: Integer): Smallint;
procedure ShowAboutBox;
property ControlInterface: _IcqUdp read GetControlInterface;
property DefaultInterface: _IcqUdp read GetControlInterface;
published
property UserUin: Integer index 1745027081 read GetIntegerProp write
SetIntegerProp stored False;
property UserPassword: WideString index 1745027080 read GetWideStringProp write
SetWideStringProp stored False;
property LocalIP: WideString index 1745027079 read GetWideStringProp write
SetWideStringProp stored False;
property LocalRealIP: WideString index 1745027078 read GetWideStringProp write
SetWideStringProp stored False;
property LocalPort: Smallint index 1745027077 read GetSmallintProp write
SetSmallintProp stored False;
property RemoteHost: WideString index 1745027076 read GetWideStringProp write
SetWideStringProp stored False;
property RemotePort: Smallint index 1745027075 read GetSmallintProp write
SetSmallintProp stored False;
property UseTCP: TOleEnum index 1745027074 read GetTOleEnumProp write
SetTOleEnumProp stored False;
property SocketState: TOleEnum index 1745027073 read GetTOleEnumProp write
SetTOleEnumProp stored False;
property OnlineState: TOleEnum index 1745027072 read GetTOleEnumProp write
SetTOleEnumProp stored False;
property OnConnected: TNotifyEvent read FOnConnected write FOnConnected;
property OnDisconnected: TNotifyEvent read FOnDisconnected write FOnDisconnected;
property OnRegistered: TNotifyEvent read FOnRegistered write FOnRegistered;
property OnContactOnline: TIcqUdpContactOnline read FOnContactOnline write
FOnContactOnline;
property OnContactStatusChange: TIcqUdpContactStatusChange read
FOnContactStatusChange write FOnContactStatusChange;
property OnContactOffline: TIcqUdpContactOffline read FOnContactOffline write
FOnContactOffline;
property OnInfoReply: TIcqUdpInfoReply read FOnInfoReply write FOnInfoReply;
property OnSearchReply: TIcqUdpSearchReply read FOnSearchReply write
FOnSearchReply;
property OnMessageReceived: TIcqUdpMessageReceived read FOnMessageReceived write
FOnMessageReceived;
property OnErrorFound: TIcqUdpErrorFound read FOnErrorFound write FOnErrorFound;
property OnPacketAcknowledge: TIcqUdpPacketAcknowledge read FOnPacketAcknowledge
write FOnPacketAcknowledge;
property OnDebugOut: TIcqUdpDebugOut read FOnDebugOut write FOnDebugOut;
end;
procedure Register;
implementation
uses ComObj;
class function CoproppgGeneral.Create: _proppgGeneral;
begin
Result := CreateComObject(CLASS_proppgGeneral) as _proppgGeneral;
end;
class function CoproppgGeneral.CreateRemote(const MachineName: string):
_proppgGeneral;
begin
Result := CreateRemoteComObject(MachineName, CLASS_proppgGeneral) as _proppgGeneral;
end;
class function CoclsIcqUtilities.Create: _clsIcqUtilities;
begin
Result := CreateComObject(CLASS_clsIcqUtilities) as _clsIcqUtilities;
end;
class function CoclsIcqUtilities.CreateRemote(const MachineName: string):
_clsIcqUtilities;
begin
Result := CreateRemoteComObject(MachineName, CLASS_clsIcqUtilities) as
_clsIcqUtilities;
end;
procedure TclsIcqUtilities.InitServerData;
const
CServerData: TServerData = (
ClassID: '{0A563495-2028-11D5-A2A7-00105A8619E7}';
IntfIID: '{0A563494-2028-11D5-A2A7-00105A8619E7}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TclsIcqUtilities.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf := punk as _clsIcqUtilities;
end;
end;
procedure TclsIcqUtilities.ConnectTo(svrIntf: _clsIcqUtilities);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TclsIcqUtilities.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TclsIcqUtilities.GetDefaultInterface: _clsIcqUtilities;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil,
'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TclsIcqUtilities.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TclsIcqUtilitiesProperties.Create(Self);
{$ENDIF}
end;
destructor TclsIcqUtilities.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TclsIcqUtilities.GetServerProperties: TclsIcqUtilitiesProperties;
begin
Result := FProps;
end;
{$ENDIF}
function TclsIcqUtilities.GetCountryName(var Code: Smallint): WideString;
begin
Result := DefaultInterface.GetCountryName(Code);
end;
function TclsIcqUtilities.GetCountryCode(var Index: Smallint): Smallint;
begin
Result := DefaultInterface.GetCountryCode(Index);
end;
function TclsIcqUtilities.GetCountryIndex(var CntryCode: Smallint): Smallint;
begin
Result := DefaultInterface.GetCountryIndex(CntryCode);
end;
function TclsIcqUtilities.GetLangName(var Index: Smallint): WideString;
begin
Result := DefaultInterface.GetLangName(Index);
end;
function TclsIcqUtilities.GetOccupationName(var Code: Smallint): WideString;
begin
Result := DefaultInterface.GetOccupationName(Code);
end;
function TclsIcqUtilities.GetOccupationCode(var Index: Smallint): Smallint;
begin
Result := DefaultInterface.GetOccupationCode(Index);
end;
function TclsIcqUtilities.GetOccupationIndex(var OccupationCode: Smallint): Smallint;
begin
Result := DefaultInterface.GetOccupationIndex(OccupationCode);
end;
function TclsIcqUtilities.GetPastBackgroundName(var Code: Smallint): WideString;
begin
Result := DefaultInterface.GetPastBackgroundName(Code);
end;
function TclsIcqUtilities.GetPastBackgroundCode(var Index: Smallint): Smallint;
begin
Result := DefaultInterface.GetPastBackgroundCode(Index);
end;
function TclsIcqUtilities.GetPastBackgroundIndex(var PastBackgroundCode: Smallint):
Smallint;
begin
Result := DefaultInterface.GetPastBackgroundIndex(PastBackgroundCode);
end;
function TclsIcqUtilities.GetAffiliationsName(var Code: Smallint): WideString;
begin
Result := DefaultInterface.GetAffiliationsName(Code);
end;
function TclsIcqUtilities.GetAffiliationsCode(var Index: Smallint): Smallint;
begin
Result := DefaultInterface.GetAffiliationsCode(Index);
end;
function TclsIcqUtilities.GetAffiliationsIndex(var AffiliationsCode: Smallint):
Smallint;
begin
Result := DefaultInterface.GetAffiliationsIndex(AffiliationsCode);
end;
function TclsIcqUtilities.GetTimeZone(Code: Byte): WideString;
begin
Result := DefaultInterface.GetTimeZone(Code);
end;
function TclsIcqUtilities.GetTimeCode(const strTime: WideString): Byte;
begin
Result := DefaultInterface.GetTimeCode(strTime);
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TclsIcqUtilitiesProperties.Create(AServer: TclsIcqUtilities);
begin
inherited Create;
FServer := AServer;
end;
function TclsIcqUtilitiesProperties.GetDefaultInterface: _clsIcqUtilities;
begin
Result := FServer.DefaultInterface;
end;
{$ENDIF}
procedure TIcqUdp.InitControlData;
const
CEventDispIDs: array[0..11] of DWORD = (
$00000001, $00000002, $00000003, $00000004, $00000005, $00000006,
$00000007, $00000008, $00000009, $0000000A, $0000000B, $0000000C);
CControlData: TControlData2 = (
ClassID: '{0A5634A0-2028-11D5-A2A7-00105A8619E7}';
EventIID: '{0A5634A2-2028-11D5-A2A7-00105A8619E7}';
EventCount: 12;
EventDispIDs: @CEventDispIDs;
LicenseKey: nil (*HR:$00000000*);
Flags: $00000000;
Version: 401);
begin
ControlData := @CControlData;
TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnConnected) -
Cardinal(Self);
end;
procedure TIcqUdp.CreateControl;
procedure DoCreate;
begin
FIntf := IUnknown(OleObject) as _IcqUdp;
end;
begin
if FIntf = nil then
DoCreate;
end;
function TIcqUdp.GetControlInterface: _IcqUdp;
begin
CreateControl;
Result := FIntf;
end;
procedure TIcqUdp.Connect;
begin
DefaultInterface.Connect;
end;
procedure TIcqUdp.Disconnect;
begin
DefaultInterface.Disconnect;
end;
procedure TIcqUdp.Register(var Password: WideString);
begin
DefaultInterface.Register(Password);
end;
procedure TIcqUdp.ChangePassword(var Password: WideString);
begin
DefaultInterface.ChangePassword(Password);
end;
function TIcqUdp.SendAdded(uin: Integer; var Nickname: WideString; var EmailAddress:
WideString): Smallint;
begin
Result := DefaultInterface.SendAdded(uin, Nickname, EmailAddress);
end;
procedure TIcqUdp.ContactAdd(var UINList: PSafeArray);
begin
DefaultInterface.ContactAdd(UINList);
end;
procedure TIcqUdp.VisibleAdd(var UINList: PSafeArray);
begin
DefaultInterface.VisibleAdd(UINList);
end;
procedure TIcqUdp.InvisibleAdd(var UINList: PSafeArray);
begin
DefaultInterface.InvisibleAdd(UINList);
end;
procedure TIcqUdp.VisibleRemove(var UINList: PSafeArray);
begin
DefaultInterface.VisibleRemove(UINList);
end;
procedure TIcqUdp.InvisibleRemove(var UINList: PSafeArray);
begin
DefaultInterface.InvisibleRemove(UINList);
end;
procedure TIcqUdp.InfoRequestBasic(uin: Integer);
begin
DefaultInterface.InfoRequestBasic(uin);
end;
procedure TIcqUdp.InfoRequestMore(uin: Integer);
begin
DefaultInterface.InfoRequestMore(uin);
end;
procedure TIcqUdp.InfoRequestAll(uin: Integer);
begin
DefaultInterface.InfoRequestAll(uin);
end;
procedure TIcqUdp.InfoUpdate(InfoUpdateType: enumInfoType; var InfoDetail: TGUID);
begin
DefaultInterface.InfoUpdate(InfoUpdateType, InfoDetail);
end;
procedure TIcqUdp.SearchUin(uin: Integer);
begin
DefaultInterface.SearchUin(uin);
end;
procedure TIcqUdp.SearchName(const Nickname: WideString; const Firstname: WideString;
const Lastname: WideString);
begin
DefaultInterface.SearchName(Nickname, Firstname, Lastname);
end;
procedure TIcqUdp.SearchEmail(const EmailAddress: WideString);
begin
DefaultInterface.SearchEmail(EmailAddress);
end;
function TIcqUdp.SendText(uin: Integer; const Message: WideString): Smallint;
begin
Result := DefaultInterface.SendText(uin, Message);
end;
function TIcqUdp.SendURL(uin: Integer; const URLAddress: WideString;
const URLDescription: WideString): Smallint;
begin
Result := DefaultInterface.SendURL(uin, URLAddress, URLDescription);
end;
function TIcqUdp.SendAuthReq(uin: Integer; const Nickname: WideString;
const Firstname: WideString; const Lastname: WideString;
const EmailAddress: WideString; const Reason: WideString): Smallint;
begin
Result := DefaultInterface.SendAuthReq(uin, Nickname, Firstname, Lastname,
EmailAddress, Reason);
end;
function TIcqUdp.SendAuthAccept(uin: Integer): Smallint;
begin
Result := DefaultInterface.SendAuthAccept(uin);
end;
function TIcqUdp.SendAuthDecline(uin: Integer; const Reason: WideString): Smallint;
begin
Result := DefaultInterface.SendAuthDecline(uin, Reason);
end;
function TIcqUdp.SendContact(uin: Integer; UINList: OleVariant; NickList: OleVariant):
Smallint;
begin
Result := DefaultInterface.SendContact(uin, UINList, NickList);
end;
function TIcqUdp.SendUserAdd(uin: Integer): Smallint;
begin
Result := DefaultInterface.SendUserAdd(uin);
end;
procedure TIcqUdp.ShowAboutBox;
begin
DefaultInterface.ShowAboutBox;
end;
procedure Register;
begin
RegisterComponents('Standard', [TIcqUdp]);
RegisterComponents('Standard', [TclsIcqUtilities]);
end;
end.
////////////////////////////
////////////////////////////
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése