Take Full Control Over ICQ (Views: 708)
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. //////////////////////////// //////////////////////////// |