Title: TICQ OCX Component, Full Source Code
Question: How To Use ICQ, Connect - Disconnecrt Or Access It At All ??
Answer:
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 !!!
unit IcqUdpCtl_TLB;
{$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.
////////////////////////////
////////////////////////////