icqclient.pas

本程序是转载的

  if (not LoggedIn) then Exit;
  CreateCLI_METASETPASS(@pkt, FLUIN, '', Buffer, BufLen, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);
end;

{Returns True if direct connection with UIN has been estabilished.}
function TICQClient.DirectConnectionEstabilished(UIN: LongWord): Boolean;
begin
  Result := False;
  if FDirect = nil then Exit;
  Result := FDirect.ConnectionEstabilished(UIN);
end;

{Send contacts to UIN through server.}
function TICQClient.SendContacts(UIN: LongWord; Contacts: TStringList; ID: Word): Boolean;
var
  pkt: TRawPkt;
begin
  Result := False;
  if not LoggedIn then Exit;
  CreateCLI_SENDCONTACTS(@pkt, 0, ID, UIN, Contacts, FSeq);
  FSock.SendData(pkt, pkt.Len);
  Result := True;
end;

{Request contacts from UIN through server.}
function TICQClient.RequestContacts(UIN: LongWord; const Reason: String; ID: Word): Boolean;
var
  pkt: TRawPkt;
begin
  Result := False;
  if not LoggedIn then Exit;
  CreateCLI_SENDCONTACTS_REQ(@pkt, 0, ID, UIN, Reason, FSeq);
  FSock.SendData(pkt, pkt.Len);
  Result := True;  
end;

{Sends contacts to UIN directly. Returns ID of the packet or 0 if failed.}
function TICQClient.SendContactsDC(UIN: LongWord; Contacts: TStringList): Word;
var
  pkt: TRawPkt;
begin
  Result := 0;
  if FDirect = nil then Exit;
  if (FDSeq = 0) then Inc(FSeq);
  Result := CreatePEER_CONTACTS(@pkt, Contacts, FDSeq);
  if not FDirect.SendData(UIN, @pkt) then
    Result := 0;
end;

{Sends PEER_MSG with info to start a File Send. Returns ID or 0 if Fialed.}
Function TICQClient.SendFileDC(UIN:LongWord; FileName, Description:String): Word;
Var
  Pkt:TRawPkt;
  FileSend:TSendFileRec;
  I:Integer;
Begin
  Result := 0;

  If fDirect = nil then exit;
  If (FDSeq = 0) then inc(FSeq);
//  If not FileExists(FileName) then Exit;

  FileSend.Files := TStringList.Create;
  FileSend.FilesCurrent := 0;
  FileSend.Files.Text := FileName;
  If FileSend.Files.Count = 0 then Begin
    FileSend.Files.Free;
    FileSend.Files := nil;
    Exit;
  End;

  FileSend.UIN := UIN;
  FileSend.FilesCount := FileSend.Files.Count;
  FileSend.FilePath := ExtractFilePath(FileSend.Files[FileSend.FilesCurrent]);
  FileSend.FileName := ExtractFileName(FileSend.Files[FileSend.FilesCurrent]);
  FileSend.FileDescription := Description;
  FileSend.TotalSize := 0;
  for i := 0 to FileSend.Files.Count -1 do
    Inc(FileSend.TotalSize, FileSize(FileSend.Files[i]));
  FileSend.FileSize  := FileSize(FileSend.Files[FileSend.FilesCurrent]);
  FileSend.Port := FindBindPort;
  FileSend.Speed:= 100;
  fDirect.SetFileRecord(UIN, FileSend);
  Result := CreatePEER_MSG_FILE(@Pkt, FileSend, FDSeq);
  If Not FDirect.SendData(UIN, @Pkt) then
    Result := 0;
End;

Procedure TICQClient.SendFileCancel(UIN: LongWord);
Begin
  If FDirect <> nil then
    fDirect.StopFileSending(UIN);
End;

{Request contacts from UIN directly. Returns ID of the packet or 0 if failed.}
function TICQClient.RequestContactsDC(UIN: LongWord; const Reason: String): Word;
var
  lpkt: TRawPkt;
begin
  Result := 0;
  if FDirect = nil then Exit;
  if (FDSeq = 0) then Inc(FSeq);
  Result := CreatePEER_CONTACTREQ(@lpkt, Reason, FDSeq);
  if not FDirect.SendData(UIN, @lpkt) then
    Result := 0;
end;

{Send keep alive packet.}
procedure TICQClient.SendKeepAlive;
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_KEEPALIVE(@lpkt, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Set AuthorizationRequired and WebAware options.}
procedure TICQClient.SetAuthorization(AuthorizationRequired, WebAware: Boolean);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_METASETPERMISSIONS(@lpkt, FLUIN, AuthorizationRequired, WebAware, FSeq, FSeq2);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Request authorization.}
procedure TICQClient.SendAuthRequest(UIN: LongWord; Msg: String);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_REQAUTH(@lpkt, UIN, Msg, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Start changes of SSL.}
procedure TICQClient.SSLChangeStart(FirstUpload: Boolean);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_ADDSTART(@lpkt, FirstUpload, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{End changes of SSL.}
procedure TICQClient.SSLChangeEnd;
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_ADDEND(@lpkt, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Add group to SSL.}
procedure TICQClient.SSLAddGroup(GroupName: String; GroupID: Word);
var
  lpkt: TRawPkt;
begin
  if (not LoggedIn) then Exit;
  CreateCLI_ADDBUDDY(@lpkt, GroupName, '', '', GroupID, 0, BUDDY_GROUP, False, FSeq);
  FSock.SendData(lpkt, lpkt.Len);
end;

{Add user to SSL.}
procedure TICQClient.SSLAddUser(GroupID, UserID: Word; UIN, Name, SMSNumber: String; Authorize, UpdateUser: Boolean);
var
  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, @ResponseRec) 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, ICQLanguages[FErrLang].Translate(IMSG_WADD_USER));
  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.Current, {StartPos} $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);

      if Snac.Flags and $8000 = $8000 then begin
      end;

      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)}