icqclient.pas

DarkMoon v4.11 (远程控制) 国外收集的代码,控件下载: http://www.winio.cn/Blogs/jishuwenzhang/200712/20071208230135.

unit ICQClient {v. 1.18f};
{************************************************
    For updates checkout: http://www.cobans.net
      (C) Alex Demchenko([e-mail])
*************************************************}
{$R-}                   //Remove range checking
{$DEFINE USE_FORMS}     //If you don't use forms unit remove this line



//Some needed defines, do not remove them!
{$IFDEF VER90}
  {$DEFINE OLD_DELPHI}
{$ENDIF}
{$IFDEF VER100}
  {$DEFINE OLD_DELPHI}
{$ENDIF}
{$IFDEF VER120}
  {$DEFINE OLD_DELPHI}
{$ENDIF}
{$IFDEF VER130}
  {$DEFINE OLD_DELPHI}
{$ENDIF}



interface
uses
  Windows, Messages, Classes {StringLists}, {$IFDEF USE_FORMS}Forms {AllocateHwnd/DeallocateHwnd}, {$ENDIF}
  WinSock, ICQWorks, MySocket, ICQDirect;

{$IFNDEF USE_FORMS}
  {$DEFINE OLD_DELPHI}
{$ENDIF}

type
  //UIN Entry used in direct connections
  PUINEntry = ^TUINEntry;
  TUINEntry = record
    UIN: LongWord;
    Nick: ShortString;
    CType: Word;
    CTag: Word;
    CGroupID: Word;
    CGroup: ShortString;
  end;

  TMyTimer = class;

  //Callback function types
  THandlePkt = procedure(Flap: TFlapHdr; Buffer: Pointer) of object;
  TOnMsgProc = procedure(Sender: TObject; Msg, UIN: String) of object;
  TOnURLProc = procedure(Sender: TObject; Description, URL, UIN: String) of object;
  TOnStatusChange = procedure(Sender: TObject; UIN: String; Status: LongWord) of object;
  TOnOnlineInfo = procedure(Sender: TObject; UIN: String; Port: Word; InternalIP, ExternalIP: String; ProtoVer: Byte) of object;
  TOnUserEvent = procedure(Sender: TObject; UIN: String) of object;
  TOnUserGeneralInfo = procedure(Sender: TObject; UIN, NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean) of object;
  TOnUserWorkInfo = procedure (Sender: TObject; UIN, WCity, WState, WPhone, WFax, FAddress, WZip, WCountry, WCompany, WDepartment, WPosition, WOccupation, WHomePage: String) of object;
  TOnUserInfoMore = procedure (Sender: TObject; UIN: String; Age: Word; Gender: Byte; HomePage: String; BirthYear: Word; BirthMonth: Word; BirthDay: Word; Lang1, Lang2, Lang3: String) of object;
  TOnUserInfoAbout = procedure(Sender: TObject; UIN, About: String) of object;
  TOnUserInfoInterests = procedure(Sender: TObject; UIN: String; Interests: TStringList) of object;
  TOnUserInfoMoreEmails = procedure(Sender: TObject; UIN: String; Emails: TStringList) of object;
  TOnUserInfoBackground = procedure(Sender: TObject; UIN: String; Pasts, Affiliations: TStringList) of object;
  TOnUserFound = procedure(Sender: TObject; UIN, Nick, FirstName, LastName, Email: String; Status: Word; Gender, Age: Byte; SearchComplete: Boolean; Authorize: Boolean) of object;
  TOnServerListRecv = procedure(Sender: TObject; SrvContactList: TList) of object;
  TOnAdvMsgAck = procedure(Sender: TObject; UIN: String; ID: Word; AcceptType: Byte; AcceptMsg: String) of object;
  TOnAutoMsgResponse = procedure(Sender: TObject; UIN: String; ID: Word; RespStatus: Byte; Msg: String) of object;
  TOnContactListRecv = procedure(Sender: TObject; UIN: String; ContactList: TStringList) of object;
  TOnContactListReq = procedure(Sender: TObject; UIN, Reason: String) of object;
  TOnDirectPktAck = procedure(Sender: TObject; ID: Word) of object;
  TOnSMSAck = procedure(Sender: TObject; Source, Network, MsgId: String; Deliverable: Boolean) of object;
  TOnSMSReply = procedure(Sender: TObject; Source, SmsSender, Time, Text: String) of object;
  TOnInfoChanged = procedure(Sender: TObject; InfoType: TInfoType; ChangedOk: Boolean) of object;
  TOnAuthResponse = procedure(Sender: TObject; UIN: String; Granted: Boolean; Reason: String) of object;
  TOnChangeResponse = procedure(Sender: TObject; ErrorCode: Word) of object;
  TOnFTRequest = procedure(Sender: TObject; RequestRec: TFTRequestRec) of object;
  TOnUserInfoShort = procedure(Sender: TObject; UIN, NickName, FirstName, LastName, Email: String; UserFound, AuthRequired: Boolean) of object;

  {TICQNet -- Object implementing sending/receiving packets between Client and ICQ Server.}
  TICQNet = class(TMySock)
  private
    FSrcBuf: array[0..MAX_DATA_LEN - 1] of Byte;        //.              .
    FSrcLen: Word;                                      //.PACKET READING.
    FNewFlap: TFlapHdr;                                 //.     DATA     .
    FFlapSet: Boolean;                                  //.              .
    FHandlePkt: THandlePkt;
  protected
    procedure OnReceive(Buffer: Pointer; BufLen: LongWord); override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Connect; override;
  published
    property OnConnectError;
    property OnDisconnect;
    property OnPktParseA;
    property OnError;
    property OnHandlePkt: THandlePkt read FHandlePkt write FHandlePkt;
  end;

  {TICQClient -- ICQ Component}
  TICQClient = class(TComponent)
  private
    FSock: TICQNet;                                     //Client's socket
    FLUIN: LongWord;                                    //Client's UIN
    FLPass: String;                                     //Client's password
    FFirstConnect: Boolean;                             //Flag, used in login sequence
    FSeq: Word;                                         //Main Flap Seq
    FSeq2: Word;                                        //TO_ICQSRV Seq
    FDSeq: Word;                                        //Direct connection Seq
    FCookie: String;                                    //Temporary cookie, used in login sequence, we can use String type, becouse ICQ server doesn't send 0x00 chars in it's Cookie part
    FIp: String;                                        //Ip to connect to
    FPort: Word;                                        //Port to connect to
    FDConnCookie: LongWord;                             //Direct connection cookie
    FDirect: TDirectControl;                            //Direct control
    //-- Proxy settings
    FProxyType: TProxyType;                             //.
    FProxyHost: String;                                 //.
    FProxyPort: Word;                                   //. Proxy Configaration
    FProxyAuth: Boolean;                                //.        Data
    FProxyPass: String;                                 //.
    FUserID: String;                                    //.
    FResolve: Boolean;
    //-- Events & other stuff --
    FContactLst: TStrings;
    FVisibleLst: TStrings;
    FInvisibleLst: TStrings;
    FOnMsg: TOnMsgProc;
    FOnURL: TOnURLProc;
    FOnOffMsg: TOnMsgProc;
    FOnOffURL: TOnURLProc;
    FOnLogin: TNotifyEvent;
    FOnPktParse: TOnAdvPktParse;
    FOnDPktParse: TOnAdvPktParse;
    FOnConnectionFailed: TNotifyEvent;
    FOnStatusChange: TOnStatusChange;
    FOnUserOffline: TOnUserEvent;
    FOnAddedYou: TOnUserEvent;
    FOnUserGeneralInfo: TOnUserGeneralInfo;
    FOnUserWorkInfo: TOnUserWorkInfo;
    FOnUserInfoMore: TOnUserInfoMore;
    FOnUserInfoAbout: TOnUserInfoAbout;
    FOnUserInfoInterests: TOnUserInfoInterests;
    FOnUserInfoMoreEmails: TOnUserInfoMoreEmails;
    FOnUserInfoBackground: TOnUserInfoBackground;
    FStatus: LongWord;
    FDoPlain: Boolean;
    FInfoChain: TStringList;
    FSInfoChain: TStringList;
    FLastInfoUin: String;
    FLastSInfoUin: String;
    FLoggedIn: Boolean;
    FRegisteringUIN: Boolean;
    FRegPassword: String;
    FOnUserFound: TOnUserFound;
    FOnUserNotFound: TNotifyEvent;
    FOnServerListRecv: TOnServerListRecv;
    FOnAdvMsgAck: TOnAdvMsgAck;
    FOnNewUINRegistered: TOnUserEvent;
    FOnNewUINRefused: TNotifyEvent;
    FOnAutoMsgResponse: TOnAutoMsgResponse;
    FAutoAwayMsg: String;
    FOnUnregisterOk: TNotifyEvent;
    FOnUnregBadPass: TNotifyEvent;
    FOnContactListRecv: TOnContactListRecv;
    FOnContactListReq: TOnContactListReq;
    FOnDirectPktAck: TOnDirectPktAck;
    FOnSmsRefused: TNotifyEvent;
    FOnSMSAck: TOnSMSAck;
    FOnOnlineInfo: TOnOnlineInfo;
    FUseDirect: Boolean;
    FOnError: TOnError;
    FTimer: TMyTimer;
    FTimeout: Byte;
    FOnSMSReply: TOnSMSReply;
    FOnInfoChanged: TOnInfoChanged;
    FOnAuthSet: TNotifyEvent;
    FOnAuthResponse: TOnAuthResponse;
    FOnChangeResponse: TOnChangeResponse;
    FOnFTRequest: TOnFTRequest;
    FOnFTInit: TOnFTInit;
    FOnFTStart: TOnFTStart;
    FOnFTFileData: TOnFTFileData;
    FLastError: String;
    FOnUserInfoShort: TOnUserInfoShort;
    procedure InitNetICQ;
    procedure OnIntError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
    procedure HandlePacket(Flap: TFlapHdr; Data: Pointer);
    procedure SetStatus(NewStatus: LongWord);
    //-- Handling Snac packet procedures
    procedure HSnac0407(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    //procedure HSnac1503(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HSnac030B(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HSnac131C(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HSnac1319(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HSnac1306(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HSnac040b(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HSnac1705(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HSnac131b(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HSnac130e(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    procedure HDirectMsg(Sender: TObject; UIN: LongWord; Pak: PRawPkt; Len: LongWord);
    procedure FTOnConnectError(Sender: TObject);
    procedure FTOnDisconnect(Sender: TObject);
    procedure FTOnDirectParse(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean);
    procedure FTOnPktParse(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean);
    procedure OnFTInitProc(Sender: TObject; UIN: LongWord; FileCount, TotalBytes, Speed: LongWord; NickName: String);
    procedure OnFTStartProc(Sender: TObject; StartRec: TFTStartRec; FileName: String; FileSize, Speed: LongWord);
    procedure OnFTFileDataProc(Sender: TObject; UIN: LongWord; Data: Pointer; DataLen: LongWord; LastPacket: Boolean);
    procedure SetContactList(Value: TStrings);
    procedure SetVisibleList(Value: TStrings);
    procedure SetInvisibleList(Value: TStrings);
    procedure OnTimeout(Sender: TObject);
  public
    procedure HSnac1503(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Login(Status: LongWord = S_ONLINE);
    procedure RegisterNewUIN(const Password: String);
    procedure Disconnect;
    procedure SendMessage(UIN: LongWord; const Msg: String);
    procedure SendURL(UIN: LongWord; const URL, Description: String);
    function AddContact(UIN: LongWord): Boolean;
    procedure RemoveContact(UIN: LongWord);
    procedure RemoveContactVisible(UIN: LongWord);
    procedure RemoveContactInvisible(UIN: LongWord);
    procedure RequestInfo(UIN: LongWord);
    procedure RequestInfoShort(UIN: LongWord);    
    procedure SearchByMail(const Email: String);
    procedure SearchByUIN(UIN: LongWord);
    procedure SearchByName(const FirstName, LastName, NickName, Email: String);
    procedure SearchRandom(Group: Word);
    procedure SearchWhitePages(const FirstName, LastName, NickName, Email: String; MinAge, MaxAge: Word; Gender: Byte; const Language, City, Country, Company, Department, Position, Occupation, Organization, OrganKeyWords, PastAffiliation, AffiKeyWords, KeyWord: String; Online: Boolean);
    procedure SetSelfInfoGeneral(NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean);
    procedure SetSelfInfoMore(Age: Word; Gender: Byte; const HomePage: String; BirthYear: Word; BirthMonth, BirthDay: Byte; Language1, Language2, Language3: String);
    procedure SetSelfInfoAbout(const About: String);
    procedure RequestContactList;
    procedure DestroyUINList(var List: TList);
    procedure SendSMS(const Destination, Text: String);
    procedure SendMessageAdvanced(UIN: LongWord; const Msg: String; ID: Word; RTFFormat: Boolean);
    function SendMessageDirect(UIN: LongWord; const Msg: String; RTFFormat: Boolean): Word;
    procedure RequestAwayMsg(UIN: LongWord; ID: Word; ReqStatus: Byte);
    procedure UnregisterUIN(const Password: String);
    procedure ChangePassword(const NewPassword: String);
    procedure ChangePasswordPtr(Buffer: Pointer; BufLen: Word);
    function DirectConnectionEstabilished(UIN: LongWord): Boolean;
    function SendContacts(UIN: LongWord; Contacts: TStringList; ID: Word): Boolean;
    function RequestContacts(UIN: LongWord; const Reason: String; ID: Word): Boolean;
    function SendContactsDC(UIN: LongWord; Contacts: TStringList): Word;
    function RequestContactsDC(UIN: LongWord; const Reason: String): Word;
    procedure SendKeepAlive;
    procedure SetAuthorization(AuthorizationRequired, WebAware: Boolean);
    procedure SendAuthRequest(UIN: LongWord; Msg: String);
    procedure SSLChangeStart(FirstUpload: Boolean);
    procedure SSLChangeEnd;
    procedure SSLAddGroup(GroupName: String; GroupID: Word);
    procedure SSLAddUser(GroupID, UserID: Word; UIN, Name, SMSNumber: String; Authorize, UpdateUser: Boolean);
    procedure SSLDelUser(GroupID, UserID: Word; UIN, Name, SMSNumber: String; Authorize: Boolean);
    procedure SSLDelGroup(GroupName: String; GroupID: Word);
    procedure SSLUpdateGroup(GroupName: String; GroupID: Word; UserIDs: TStringList);
    procedure SSLAddUserIntoList(UserID: Word; UIN: String; BuddyType: Word);
    procedure SSLDelUserFromList(UserID: Word; UIN: String; BuddyType: Word);
    function FTResponse(ResponseRec: TFTRequestRec; Accept: Boolean; Reason: String): Boolean;
    procedure FTCancel(UIN: LongWord);
    function FTStartResponse(StartRec: TFTStartRec): Boolean;
    property LastError: String read FLastError;
    property Status: LongWord read FStatus write SetStatus;
    property LoggedIn: Boolean read FLoggedIn;
  published
    property DisableDirectConnections: Boolean read FUseDirect write FUseDirect default False;
    property ProxyType: TProxyType read FProxyType write FProxyType default P_NONE;
    property ProxyHost: String read FProxyHost write FProxyHost;
    property ProxyPort: Word read FProxyPort write FProxyPort;
    property ProxyUserID: String read FUserID write FUserID;
    property ProxyResolve: Boolean read FResolve write FResolve default False;
    property ProxyAuth: Boolean read FProxyAuth write FProxyAuth default False;
    property ProxyPass: String read FProxyPass write FProxyPass;
    property UIN: LongWord read FLUIN write FLUIN;
    property Password: String read FLPass write FLPass;
    property ICQServer: String read FIp write FIp;
    property ICQPort: Word read FPort write FPort;
    property ConvertToPlaintext: Boolean read FDoPlain write FDoPlain;
    property ContactList: TStrings read FContactLst write SetContactList;
    property VisibleList: TStrings read FVisibleLst write SetVisibleList;
    property InvisibleList: TStrings read FInvisibleLst write SetInvisibleList;
    property AutoAwayMessage: String read FAutoAwayMsg write FAutoAwayMsg;
    property OnLogin: TNotifyEvent read FOnLogin write FOnLogin;
    property OnMessageRecv: TOnMsgProc read FOnMsg write FOnMsg;
    property OnURLRecv: TOnURLProc read FOnURL write FOnURL;
    property OnOfflineMsgRecv: TOnMsgProc read FOnOffMsg write FOnOffMsg;
    property OnOfflineURLRecv: TOnURLProc read FOnOffURL write FOnOffURL;
    property OnPktParse: TOnAdvPktParse read FOnPktParse write FOnPktParse;
    property OnPktDirectParse: TOnAdvPktParse read FOnDPktParse write FOnDPktParse;
    property OnConnectionFailed: TNotifyEvent read FOnConnectionFailed write FOnConnectionFailed;
    property OnStatusChange: TOnStatusChange read FOnStatusChange write FOnStatusChange;
    property OnUserOffline: TOnUserEvent read FOnUserOffline write FOnUserOffline;
    property OnAddedYou: TOnUserEvent read FOnAddedYou write FOnAddedYou;
    property OnUserGeneralInfo: TOnUserGeneralInfo read FOnUserGeneralInfo write FOnUserGeneralInfo;
    property OnUserWorkInfo: TOnUserWorkInfo read FOnUserWorkInfo write FOnUserWorkInfo;
    property OnUserInfoMore: TOnUserInfoMore read FOnUserInfoMore write FOnUserInfoMore;
    property OnUserInfoAbout: TOnUserInfoAbout read FOnUserInfoAbout write FOnUserInfoAbout;
    property OnUserInfoInterests: TOnUserInfoInterests read FOnUserInfoInterests write FOnUserInfoInterests;
    property OnUserInfoMoreEmails: TOnUserInfoMoreEmails read FOnUserInfoMoreEmails write FOnUserInfoMoreEmails;
    property OnUserInfoBackground: TOnUserInfoBackground read FOnUserInfoBackground write FOnUserInfoBackground;
    property OnUserFound: TOnUserFound read FOnUserFound write FOnUserFound;
    property OnUserNotFound: TNotifyEvent read FOnUserNotFound write FOnUserNotFound;
    property OnServerListRecv: TOnServerListRecv read FOnServerListRecv write FOnServerListRecv;
    property OnAdvancedMsgAck: TOnAdvMsgAck read FOnAdvMsgAck write FOnAdvMsgAck;
    property OnNewUINRegistered: TOnUserEvent read FOnNewUINRegistered write FOnNewUINRegistered;
    property OnNewUINRefused: TNotifyEvent read FOnNewUINRefused write FOnNewUINRefused;
    property OnAutoMsgResponse: TOnAutoMsgResponse read FOnAutoMsgResponse write FOnAutoMsgResponse;
    property OnUnregisterOk: TNotifyEvent read FOnUnregisterOk write FOnUnregisterOk;
    property OnUnregisterBadPassword: TNotifyEvent read FOnUnregBadPass write FOnUnregBadPass;
    property OnContactListRecv: TOnContactListRecv read FOnContactListRecv write FOnContactListRecv;
    property OnContactListRequest: TOnContactListReq read FOnContactListReq write FOnContactListReq;
    property OnDirectPacketAck: TOnDirectPktAck read FOnDirectPktAck write FOnDirectPktAck;
    property OnSMSRefused: TNotifyEvent read FOnSmsRefused write FOnSmsRefused;
    property OnSMSAck: TOnSMSAck read FOnSMSAck write FOnSMSAck;
    property OnOnlineInfo: TOnOnlineInfo read FOnOnlineInfo write FOnOnlineInfo;
    property OnError: TOnError read FOnError write FOnError;
    property ConnectionTimeout: Byte read FTimeout write FTimeout;
    property OnSMSReply: TOnSMSReply read FOnSMSReply write FOnSMSReply;
    property OnInfoChanged: TOnInfoChanged read FOnInfoChanged write FOnInfoChanged;
    property OnAuthorizationChangedOk: TNotifyEvent read FOnAuthSet write FOnAuthSet;
    property OnAuthResponse: TOnAuthResponse read FOnAuthResponse write FOnAuthResponse;
    property OnSSLChangeResponse: TOnChangeResponse read FOnChangeResponse write FOnChangeResponse;
    property OnFTRequest: TOnFTRequest read FOnFTRequest write FOnFTRequest;
    property OnFTInit: TOnFTInit read FOnFTInit write FOnFTInit;
    property OnFTStart: TOnFTStart read FOnFTStart write FOnFTStart;
    property OnFTFileData: TOnFTFileData read FOnFTFileData write FOnFTFileData;
    property OnUserInfoShort: TOnUserInfoShort read FOnUserInfoShort write FOnUserInfoShort;
  end;

  TMyTimer = class(TObject)
  private
    FInterval: LongWord;
    FWindowHandle: THandle;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    FTag: Integer;