icqclient.pas

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

  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  if not UpdateUser then
    CreateCLI_ADDBUDDY(@lpkt, UIN, Name, SMSNumber, GroupID, UserID, BUDDY_NORMAL, Authorize, FSeq)
  else
    CreateCLI_UPDATEBUDDY(@lpkt, UIN, Name, SMSNumber, GroupID, UserID, BUDDY_NORMAL, Authorize, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Remove user from SSL.}
procedure TICQClient.SSLDelUser(GroupID, UserID: Word; UIN, Name, SMSNumber: String; Authorize: Boolean);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_DELETEBUDDY(@lpkt, UIN, Name, SMSNumber, GroupID, UserID, BUDDY_NORMAL, Authorize, True, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Remove group from SSL.}
procedure TICQClient.SSLDelGroup(GroupName: String; GroupID: Word);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_DELETEBUDDY(@lpkt, GroupName, '', '', GroupID, 0, BUDDY_GROUP, False, True, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Update group's ids.}
procedure TICQClient.SSLUpdateGroup(GroupName: String; GroupID: Word; UserIDs: TStringList);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_UPDATEGROUP(@lpkt, GroupName, GroupID, UserIDs, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Add user to the specified SSL's list.}
procedure TICQClient.SSLAddUserIntoList(UserID: Word; UIN: String; BuddyType: Word);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_ADDBUDDY(@lpkt, UIN, '', '', $0000, UserID, BuddyType, False, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Remove user from the specified SSL's list.}
procedure TICQClient.SSLDelUserFromList(UserID: Word; UIN: String; BuddyType: Word);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_DELETEBUDDY(@lpkt, UIN, '', '', $0000, UserID, BuddyType, False, True, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Send response on a file request.}
function TICQClient.FTResponse(ResponseRec: TFTRequestRec; Accept: Boolean; Reason: String): Boolean;
var
  lpkt: TRawPkt;
begin
  if DisableDirectConnections then
  begin
    Result := False;
    Exit;
  end;
  if not Accept then
  begin
    if ResponseRec.ReqType <> 0 then
    begin
      {Never tested because didn't see when ICQ request ft through server, miranda-icq doest this but doesn't handle file declines even from real ICQ}
      CreateCLI_SENDMSG_FILEDECLINE(@lpkt, ResponseRec.Seq, ResponseRec.ITime, ResponseRec.IRandomID,
        ResponseRec.UIN, ResponseRec.FileSize,
        ResponseRec.Description, ResponseRec.FileName, Reason, 0, FSeq);
      FSock.SendData(lpkt, lpkt.Len);
      Result := True;
      Exit;
    end;
  end;
  if FDirect <> nil then
  if FDirect.AddFileUser(ResponseRec.UIN, ResponseRec.Port) then
    begin
      {Send response through estabilished direct connection}
      if ResponseRec.ReqType = 0 then
      begin
        CreatePEER_FILEINIT(@lpkt, True, ResponseRec.Description, ResponseRec.FileName, ResponseRec.Port,
          ResponseRec.FileSize, ResponseRec.Seq, Reason, Accept);
        Result := FDirect.SendData(ResponseRec.UIN, @lpkt);
      end else
      {Send response through server}
      begin
        CreateCLI_SENDMSG_FILEACK(@lpkt, ResponseRec.Seq, ResponseRec.ITime, ResponseRec.IRandomID,
          ResponseRec.UIN, ResponseRec.FileSize, ResponseRec.Description, ResponseRec.FileName,
          ResponseRec.Port, FSeq);
        FSock.SendData(lpkt, lpkt.Len);
        Result := True;
      end;
      Exit;
    end else
      OnIntError(Self, ERR_WARNING, 'Could not add user for sending/receiving files');
  Result := False;
end;

procedure TICQClient.FTCancel(UIN: LongWord);
begin
  if FDirect <> nil then
    FDirect.StopFileReceiving(UIN);
end;

function TICQClient.FTStartResponse(StartRec: TFTStartRec): Boolean;
var
  lpkt: TRawPkt;
begin
  Result := False;
  if FDirect = nil then Exit;
  CreatePEER_FILE_INIT2(@lpkt, StartRec.FilesCount, $00000000, StartRec.Speed);
  Result := FDirect.SendDataFile(StartRec.UIN, @lpkt);
end;

{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
{Handling of all incoming packets}
procedure TICQClient.HandlePacket(Flap: TFlapHdr; Data: Pointer);
var
  FUIN: String;
  FData: String;
  pkt: TRawPkt;
  T: Word;
  Snac: TSnacHdr;
  i: Word;
begin
  case Flap.ChID of
    1: //Channel 1
    begin
      {SRV_HELLO}
      if Flap.DataLen = 4 then
      begin
        if FRegisteringUIN then
        begin
          //Send CLI_HELLO
          CreateCLI_HELLO(@pkt, FSeq);
          FSock.SendData(pkt, pkt.Len);
          //Register a new UIN.
          CreateCLI_REGISTERUSER(@pkt, FRegPassword, FSeq);
          FSock.SendData(pkt, pkt.Len);
          Exit;
        end;
        if FFirstConnect then
        begin
          //Send login packet
          CreateCLI_IDENT(@pkt, FLUIN, FLPass, FSeq);
          FSock.SendData(pkt, pkt.len);
        end
        else
        begin
          //Sending the cookie(second stage of login sequence)
          CreateCLI_COOKIE(@pkt, FCookie, FSeq);
          FSock.SendData(pkt, pkt.Len);
        end;
      end;
      FFirstConnect := False;
    end;
    2: //Channel 2
    begin
      Move(Data^, pkt.Data, Flap.DataLen); pkt.Len := 0;
      GetSnac(@pkt, Snac);
      case Snac.Family of
        $01: //Family x01
          case Snac.SubType of
            $03: {SRV_FAMILIES}
            begin
              CreateCLI_FAMILIES(@pkt, FSeq);           {SNAC(x01/x17)}
              FSock.SendData(pkt, pkt.Len);
            end;
            $07: {SRV_RATES}
            begin
              CreateCLI_ACKRATES(@pkt, FSeq);           {SNAC(x01/x08)}
              FSock.SendData(pkt, pkt.Len);
              CreateCLI_SETICBM(@pkt, FSeq);            {SNAC(x04/x02)}
              FSock.SendData(pkt, pkt.Len);
              CreateCLI_REQINFO(@pkt, FSeq);            {SNAC(x01/x0E)}
              FSock.SendData(pkt, pkt.Len);
              CreateCLI_REQLOCATION(@pkt, FSeq);        {SNAC(x02/x02)}
              FSock.SendData(pkt, pkt.Len);
              CreateCLI_REQBUDDY(@pkt, FSeq);           {SNAC(x03/x02)}
              FSock.SendData(pkt, pkt.Len);
              CreateCLI_REQICBM(@pkt, FSeq);            {SNAC(x04/x04)}
              FSock.SendData(pkt, pkt.Len);
              CreateCLI_REQBOS(@pkt, FSeq);             {SNAC(x09/x02)}
              FSock.SendData(pkt, pkt.Len);
              //FConnecting := False;
            end;
            $13: {SRV_MOTD}
            begin
              CreateCLI_RATESREQUEST(@pkt, FSeq);       {SNAC(x01/x06)}
              FSock.SendData(pkt, pkt.Len);
            end;
          end;
        $03: //Family x03
        begin
          case Snac.SubType of
            $0B: {SRV_USERONLINE}
              HSnac030B(Flap, Snac, @pkt);
            $0C: {SRV_USEROFFLINE}
            begin
              FData := GetStr(@pkt, GetInt(@pkt, 1));
              if Assigned(OnUserOffline) then
                FOnUserOffline(Self, FData);
            end;
          end;
        end;
        $04: //Family x04
          if Snac.SubType = $07 then {SRV_MSG}
            HSnac0407(Flap, Snac, @pkt)
          else if Snac.SubType = $0b then {SRV_MSGACK}
            HSnac040b(Flap, Snac, @pkt);
        $09: //Family x09
        begin
          if Snac.SubType = $03 then
          begin
            CreateCLI_SETUSERINFO(@pkt, FSeq);                                  {SNAC(x02/x04)}
            FSock.SendData(pkt, pkt.Len);
            if FContactLst.Count > 0 then
              for i := 0 to FContactLst.Count - 1 do
              begin
                CreateCLI_ADDCONTACT(@pkt, FContactLst.Strings[i], FSeq);       {SNAC(x03/x04)}
                FSock.SendData(pkt, pkt.Len);
              end;
            if StatusToStr(FStatus) <> 'Invisible' then
            begin
              CreateCLI_ADDINVISIBLE(@pkt, FInvisibleLst, FSeq);                {SNAC(x09/x07)}
              FSock.SendData(pkt, pkt.Len);
            end else
            begin
              CreateCLI_ADDVISIBLE(@pkt, FVisibleLst, FSeq);                    {SNAC(x09/x05)}
              FSock.SendData(pkt, pkt.Len);
            end;
            FDConnCookie := Random(High(Integer));
            if FDirect <> nil then
            begin
              if ProxyType = P_NONE then
                i := FDirect.BindPort
              else
                i := 0;
              CreateCLI_SETSTATUS(@pkt, FStatus, GetLocalIP, i, FDConnCookie, FProxyType, FSeq)  {SNAC(x01/x1E)}
            end else
              CreateCLI_SETSTATUS(@pkt, FStatus, 0, 0, 0, FProxyType, FSeq);    {SNAC(x01/x1E)}
            FSock.SendData(pkt, pkt.Len);
            CreateCLI_READY(@pkt, FSeq);                                        {SNAC(x01/x02)}
            FSock.SendData(pkt, pkt.Len);
            CreateCLI_TOICQSRV(@pkt, FLUIN, CMD_REQOFFMSG, nil, 0, FSeq, FSeq2);{SNAC(x15/x02)}
            FSock.SendData(pkt, pkt.Len);
            {OnLogin Event}
            FLoggedIn := True;
            FTimer.Enabled := False;
            FInfoChain.Clear;
            FSInfoChain.Clear;
            if Assigned(OnLogin) then
              FOnLogin(Self);
          end;
        end;
        $13: //Family x13
        begin
          if Snac.SubType = $0e then
            HSnac130e(Flap, Snac, @pkt) {SRV_UPDATE_ACK}
          else if Snac.SubType = $1B then
            HSnac131b(Flap, Snac, @pkt) {SRV_AUTH}
          else if Snac.SubType = $1C then {SRV_ADDEDYOU}
            HSnac131C(Flap, Snac, @pkt)
          else if Snac.SubType = $19 then {SRV_AUTH_REQ}
            HSnac1319(Flap, Snac, @pkt)
          else if Snac.SubType = $06 then {SRV_REPLYROSTER}
            HSnac1306(Flap, Snac, @pkt);
        end;
        $15: //Family x15
        begin
          if Snac.SubType = $03 then {SRV_FROMICQSRV}
            HSnac1503(Flap, Snac, @pkt);
        end;
        $17:
        begin
          if Snac.SubType = $01 then {SRV_REGREFUSED}
          begin
            if Assigned(OnNewUINRefused) then
              FOnNewUINRefused(Self);
          end else
          if Snac.SubType = $05 then
            HSnac1705(Flap, Snac, @pkt);
        end;
      end;
    end;
    4: //Channel 4
    begin
      if FLoggedIn or FRegisteringUIN then
      begin
        FTOnConnectError(Self);
        FSock.Disconnect;
        Exit;
      end;
      Move(Data^, pkt.Data, Flap.DataLen); pkt.Len := 0;
      //SRV_COOKIE
      FUIN  := GetTLVStr(@pkt, T);                //Client's UIN in ASCII format
      if T <> 1 then
      begin
        OnIntError(nil, ERR_PROTOCOL, 'Received malformed login packet');
        FTOnConnectError(Self);
        FSock.Disconnect;
        Exit;
      end;
      FData := GetTLVStr(@pkt, T);                //IP, Port to connect to
      if T = 4 then
      begin
        OnIntError(nil, ERR_LOGIN, 'Bad password');
        FTOnConnectError(Self);
        Exit;
      end else
      if T = 8 then
      begin
        OnIntError(nil, ERR_LOGIN, 'Too often logins');
        FTOnConnectError(Self);
        Exit;
      end else
      if T <> 5 then
      begin
        OnIntError(nil, ERR_PROTOCOL, 'Received malformed login packet');
        FTOnConnectError(Self);
        FSock.Disconnect;
        Exit;
      end;
      FCookie := GetTLVStr(@pkt, T);              //Cookie used in second stage of login
      if T <> 6 then
      begin
        OnIntError(nil, ERR_PROTOCOL, 'Received malformed login packet');
        FTOnConnectError(Self);
        FSock.Disconnect;
        Exit;