icqclient.pas

本程序是转载的

    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 FProxyUser write FProxyUser;
    property ProxyResolve: Boolean read FProxyResolve write FProxyResolve 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 ErrorLanguage: TICQLangType read FErrLang write SetErrorLang default LANG_EN;
    property ICQServer: String read FIp write FIp;
    property ICQPort: Word read FPort write FPort;
    property PortRangeFirst: Word read GetPortFirst write SetPortFirst;
    property PortRangeLast: Word read GetPortLast write SetPortLast;
    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 OnLogOff: TNotifyEvent read FOnLogOff write FOnLogOff;
    property OnMessageRecv: TOnMsgProc read FOnMsg write FOnMsg;
    property OnURLRecv: TOnURLProc read FOnURL write FOnURL;
    property OnOfflineMsgRecv: TOnOffMsgProc read FOnOffMsg write FOnOffMsg;
    property OnOfflineURLRecv: TOnOffURLProc read FOnOffURL write FOnOffURL;
    property OnPktParse: TOnAdvPktParse read FOnPktParse write FOnPktParse;
    property OnPktDirectParse: TOnParseDirectPkt 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 OnMsgAck: TOnMsgAck read FOnMsgAck write FOnMsgAck;
    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 OnAuthRequest: TOnAuthRequest read FOnAuthReq write FOnAuthReq;
    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 OnSendFileStart: TOnSendFileStart read FOnSendFileStart write FOnSendFileStart;
    property OnSendFileData:  TOnSendFileData  read FOnSendFileData  write FOnSendFileData;
    property OnSendFileFinish: TOnSendFileFinish read FOnSendFileFinish write FOnSendFileFinish;
    property OnUserInfoShort: TOnUserInfoShort read FOnUserInfoShort write FOnUserInfoShort;
  end;

  TMyTimer = class(TObject)
  private
    FInterval: LongWord;
    FWindowHandle: THandle;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    FTag: Integer;
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: LongWord);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure Timer; dynamic;
  public
    constructor Create;
    destructor Destroy; override;
    property Tag: Integer read FTag write FTag;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: LongWord read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  end;

procedure Register;

implementation
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

{*** CONSTRUCTOR ***}
constructor TICQNet.Create;
begin
  inherited Create;
  FSocket := nil; FSendSocket := nil;
  FHTTPBuffer := TNetBuffer.Create;
end;

{*** DESTRUCTOR ***}
destructor TICQNet.Destroy;
begin
  FreeSocket(FSocket);
  FreeSocket(FSendSocket);
  FHTTPBuffer.Free;
  inherited Destroy;
end;

procedure TICQNet._OnConnect(Sender: TObject);
begin
  if FProxyType = P_HTTP then begin
    if Sender = FSocket then begin
      if not FHTTPConnected then begin
        FHTTPConnected := True;
        FSocket.SendStr(CreateHTTP_INIT(ProxyAuth, ProxyUser, ProxyPass))
      end else
        FSocket.SendStr(CreateHTTP_RECV(FHTTPIP, FHTTPSid, ProxyAuth, ProxyUser, ProxyPass));
    end else begin
      FCanSend := True;
      SendHTTPData;
    end;
  end;
end;

procedure TICQNet._OnError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
begin
  if Sender = FSocket then FreeSocket(FSendSocket) else FreeSocket(FSocket);

  if Assigned(OnError) then
    FOnError(Self, ErrorType, ErrorMsg);

  if Assigned(OnConnectError) then
    FOnConnectError(Self);
end;

procedure TICQNet._OnConnectError(Sender: TObject);
begin
  if Sender = FSocket then FreeSocket(FSendSocket) else FreeSocket(FSocket);

  if Assigned(OnConnectError) then
    FOnConnectError(Self);
end;

procedure TICQNet._OnDisconnect(Sender: TObject);
begin
  if Sender = FSocket then FreeSocket(FSendSocket) else FreeSocket(FSocket);

  if Assigned(OnDisconnect) then
    FOnDisconnect(Self);
end;

procedure TICQNet._OnReceive(Sender: TObject; Buffer: Pointer; BufLen: LongWord);
begin
  if Sender = FSocket then begin
    if ProxyType <> P_HTTP then
      HandleFlapData(Buffer, BufLen)
    else begin
      {$IFDEF HTTP_DEBUG}
      LogText('http.txt', 'Received (proxy): '#13#10 + DumpPacket(Buffer, BufLen) + #13#10#13#10);
      {$ENDIF}
      HandleHTTPData(Buffer, BufLen);
      HTTPReconnect;
    end;
  end else begin
    {$IFDEF HTTP_DEBUG}
    LogText('http.txt', 'Received (send-proxy): '#13#10 + PChar(Buffer));
    {$ENDIF}
    FCanSend := False;
    HTTPResend;
  end;
end;

procedure TICQNet._OnDataSent(Sender: TObject);
begin
end;

procedure TICQNet.SendHTTPData;
var
  Len: LongWord;
  Buffer: array[0..$FFFF-1] of Byte;
  Pkt: TRawPkt;
begin
  if (FCanSend) then begin
    if FHTTPFirstResend then begin
      CreateHTTP_LOGIN(@pkt, Host, Port);

      Inc(FHTTPSeq);
      FSendSocket.SendStr(CreateHTTP_Header('POST', 'http://' + FHTTPIP + '/data?sid=' + FHTTPSid + '&seq=' + IntToStr(FHTTPSeq), FHTTPIP, pkt.Len + 14, ProxyAuth, ProxyUser, ProxyPass));

      CreateHTTP_DATA_HDR(@pkt, 3, pkt.Len);
      FSendSocket.SendData(@pkt, pkt.Len);

      CreateHTTP_LOGIN(@pkt, Host, Port);

      FSendSocket.SendData(@pkt, pkt.Len);
      FHTTPFirstResend := False;
      FHTTPBuffer.Enter;
      FHTTPBuffer.Clear;
      FHTTPBuffer.Leave;      
    end;
    FHTTPBuffer.Enter;
    Len := FHTTPBuffer.GetLength;
    if Len > 0 then begin
      Inc(FHTTPSeq);
      FSendSocket.SendStr(CreateHTTP_Header('POST', 'http://' + FHTTPIP + '/data?sid=' + FHTTPSid + '&seq=' + IntToStr(FHTTPSeq), FHTTPIP, Len + 14, ProxyAuth, ProxyUser, ProxyPass));

      if FHTTPFirstResend then begin
      end else
        CreateHTTP_DATA_HDR(@pkt, 5, Len);

      {$IFDEF HTTP_DEBUG}
      LogText('http.txt', 'SENDING: '#13#10 + DumpPacket(@pkt, pkt.Len) + #13#10#13#10);
      {$ENDIF}
      FSendSocket.SendData(@pkt, pkt.Len);

      Len := FHTTPBuffer.GetPacket(@Buffer);
      while Len > 0 do begin
        {$IFDEF HTTP_DEBUG}
        LogText('http.txt', 'SENDING: '#13#10 + DumpPacket(@Buffer, Len) + #13#10#13#10);
        {$ENDIF}
        FHTTPBuffer.DelPacket;
        FSendSocket.SendData(@Buffer, Len);
        Len := FHTTPBuffer.GetPacket(@Buffer);
      end;
      FCanSend := False;
    end;
    FHTTPBuffer.Leave;
  end;
end;

procedure TICQNet.HTTPReconnect;
begin
  FreeSocket(FSocket);

  FSocket := THTTPSocket.Create;

  FSocket.ProxyHost := FProxyHost;
  FSocket.ProxyPort := FProxyPort;
  FSocket.Host := FHTTPIP;
  FSocket.Port := FHTTPPort;
  FSocket.ProxyReady := False;

  FSocket.ProxyUser := FProxyUser;
  FSocket.ProxyPass := FProxyPass;
  FSocket.ProxyAuth := FProxyAuth;
  FSocket.ProxyResolve := FProxyResolve;
  FSocket._OnConnect := _OnConnect;
  FSocket._OnError := _OnError;
  FSocket._OnConnectError := _OnConnectError;
  FSocket._OnDisconnect := _OnDisconnect;
  FSocket._OnReceive := _OnReceive;
  FSocket.ErrorLanguage := FErrLang;
  FSocket.Connect;

  {$IFDEF HTTP_DEBUG}
  LogText('http.txt', 'Initializing RECV thread...' + #13#10#13#10);
  {$ENDIF}
end;

procedure TICQNet.HTTPResend;
begin
  FreeSocket(FSendSocket);

  FSendSocket := THTTPSocket.Create;

  FSendSocket.ProxyHost := FProxyHost;
  FSendSocket.ProxyPort := FProxyPort;
  FSendSocket.Host := FHTTPIP;
  FSendSocket.Port := FHTTPPort;
  FSendSocket.ProxyReady := False;

  FSendSocket.ProxyUser := FProxyUser;
  FSendSocket.ProxyPass := FProxyPass;
  FSendSocket.ProxyAuth := FProxyAuth;
  FSendSocket.ProxyResolve := FProxyResolve;
  FSendSocket._OnConnect := _OnConnect;
  FSendSocket._OnError := _OnError;
  FSendSocket._OnConnectError := _OnConnectError;
  FSendSocket._OnDisconnect := _OnDisconnect;
  FSendSocket._OnReceive := _OnReceive;
  FSendSocket._OnDataSent := _OnDataSent;
  FSendSocket.ErrorLanguage := FErrLang;
  FSendSocket.Connect;

  {$IFDEF HTTP_DEBUG}
  LogText('http.txt', 'Initializing SEND thread...' + #13#10#13#10);
  {$ENDIF}
end;

procedure TICQNet.HandleHTTPDataPak(Buffer: Pointer; BufLen: LongWord);
var
  pkt: TRawPkt;
  ptype: Word;
  sw: LongWord;
begin
  Move(Buffer^, pkt.Data, BufLen);
  pkt.Len := 0;
  GetInt(@pkt, 2); //Version
  ptype := GetInt(@pkt, 2);
  Inc(pkt.Len, 6);
  case ptype of
    2 {HELLO REPLY}:
    begin
      FHTTPSeq := 0;
      sw := GetInt(@pkt, 4); FHTTPSid := IntToHex(sw, 8);
      sw := GetInt(@pkt, 4); FHTTPSid := FHTTPSid + IntToHex(sw, 8);
      sw := GetInt(@pkt, 4); FHTTPSid := FHTTPSid + IntToHex(sw, 8);
      sw := GetInt(@pkt, 4); FHTTPSid := FHTTPSid + IntToHex(sw, 8);
      FHTTPSid := LowerCase(FHTTPSid);      
      FHTTPIP := GetWStr(@pkt);
      FHTTPPort := GetLInt(@pkt, 2);
      {FHTTPBuffer.Enter;
      //FHTTPBuffer.Clear;
      FHTTPBuffer.AddPacket(@pkt, pkt.Len);
      FHTTPBuffer.Leave;}
      FHTTPFirstResend := True;
      HTTPResend; {Initialize send connection}
    end;
    5 {FLAP PACKETS}: begin
      HandleFlapData(Ptr(LongWord(@pkt.Data) + pkt.Len + 2), BufLen - pkt.Len - 2);
    end;
    7: begin
      FreeSockets;
      if Assigned(OnError) then
        FOnError(Self, ERR_PROXY, ICQLanguages[FErrLang].Translate(IMSG_EHTTP_INIT));
    end;
  end;
end;

procedure TICQNet.HandleHTTPData(Buffer: Pointer; BufLen: LongWord);
var
  Len: Word;
  Buf: TRawPkt;
  l: LongWord;
begin
  l := 0;
  while True do
  begin
    if l = BufLen then Break;
    Len := Swap16(PWord(Buffer)^);
    if (Len > 8192) or (Len < 12) then Break;
    Move(Ptr(LongWord(Buffer) + 2)^, Buf, Len);
    Inc(l, Len + 2);
    Buffer := Ptr(LongWord(Buffer) + Len + 2);
    {Handle ICQ Pak packet}
    HandleHTTPDataPak(@Buf, Len);
  end;
end;

procedure TICQNet.HandleFlapData(Buffer: Pointer; BufLen: LongWord);
var
  i, len: LongWord;