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.
////////////////////////////
////////////////////////////

Nincsenek megjegyzések:

Megjegyzés küldése