icqclient.pas

本程序是转载的

  flap: TFlapHdr;
begin
  inherited;
  for i := 0 to BufLen - 1 do
  begin
    FSrcBuf[FSrcLen] := PByte(LongWord(Buffer) + i)^;
    Inc(FSrcLen);
    //Searching for the Flap header
    if (FSrcLen >= TFLAPSZ) and (not FFlapSet) then
    begin
      FFlapSet := True;
      FNewFlap := PFlapHdr(@FSrcBuf)^;
      FNewFlap.DataLen := Swap16(FNewFlap.DataLen);
      FNewFlap.Seq := Swap16(FNewFlap.Seq);
      if FNewFlap.DataLen > 8192 then
      begin
        if Assigned(OnError) then
          OnError(Self, ERR_PROTOCOL, ICQLanguages[FErrLang].Translate(IMSG_EPROTO_LEN));
        FreeSocket(FSocket);
        FreeSocket(FSendSocket);
        Exit;
      end;
    end;
    //Whole packet was received
    if FSrcLen = FNewFlap.DataLen + TFLAPSZ then
    begin
      if FNewFlap.Ident <> $2a then
      begin
        if Assigned(OnError) then
          OnError(Self, ERR_PROTOCOL, ICQLanguages[FErrLang].Translate(IMSG_EMALFORMED_PKT));
        FreeSocket(FSocket);
        FreeSocket(FSendSocket);
        Exit;
      end;
      Move(FNewFlap, flap, SizeOf(FNewFlap));
      //Preparing structures for receiving the next packet
      FNewFlap.DataLen := 0;
      len := FSrcLen; FSrcLen := 0;
      FFlapSet := False;
      //Dump packet (if needed)
      if Assigned(OnPktParse) then
        OnPktParse(Self, @FSrcBuf, len, True);
      //Handling packet
      if Assigned(OnHandlePkt) then
        FOnHandlePkt(flap, Ptr(LongWord(@FSrcBuf) + TFLAPSZ));
    end;
  end;
end;

procedure TICQNet.Connect;
begin
  FSrcLen := 0;
  FFlapSet := False;
  FreeSocket(FSocket);
  FreeSocket(FSendSocket);
  FHTTPConnected := False;
  FCanSend := False;
  case FProxyType of
    P_NONE:     FSocket := TEventSocket.Create;         {do not use proxy}
    P_SOCKS4:   FSocket := TSOCKS4Socket.Create;        {use socks4/4a proxy}
    P_SOCKS5:   FSocket := TSOCKS5Socket.Create;        {use socks5 proxy}
    P_HTTP:     FSocket := THTTPSocket.Create;          {use http proxy}
    P_HTTPS:    FSocket := THTTPSSocket.Create;         {use https proxy}
  else
    Exit;
  end;
  if FProxyType = P_NONE then begin
    FSocket.ProxyReady := True;
    FSocket.ProxyHost := FHost;
    FSocket.ProxyPort := FPort;
  end else
  if FProxyType = P_HTTP then begin
    FSocket.ProxyHost := FProxyHost;
    FSocket.ProxyPort := FProxyPort;
    FSocket.Host := 'http.proxy.icq.com';
    FSocket.Port := 80;
    FSocket.ProxyReady := False;
  end else begin
    FSocket.Host := FHost;
    FSocket.Port := FPort;
    FSocket.ProxyHost := FProxyHost;
    FSocket.ProxyPort := FProxyPort;
    FSocket.ProxyReady := False;
  end;

  if FProxyType = P_HTTP then begin
    FHTTPBuffer.Enter;
    FHTTPBuffer.Clear;
    FHTTPBuffer.Leave;
  end;

  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.Connect;
end;

procedure TICQNet.SendData(var Data; DataLen: LongWord);
begin
  if FProxyType <> P_HTTP then begin
    if FSocket <> nil then begin
      if Assigned(OnPktParse) then
        OnPktParse(Self, @Data, DataLen, False);
      FSocket.SendData(@Data, DataLen);
    end
  end else begin
    if Assigned(OnPktParse) then
      OnPktParse(Self, @Data, DataLen, False);
    FHTTPBuffer.Enter;
    FHTTPBuffer.AddPacket(@Data, DataLen);
    FHTTPBuffer.Leave;
    SendHTTPData;
  end;
end;

procedure TICQNet.FreeSocket(var Socket: TEventSocket);
begin
  {Free socket safe}
  if (Socket <> nil) then begin
    if Socket.Working then begin {working means not-terminated}
      Socket.FreeOnTerminate := True;
      Socket.Terminate;
    end else
      Socket.Free;
    Socket := nil;
  end;
end;

procedure TICQNet.FreeSockets;
begin
  FreeSocket(FSocket);
  FreeSocket(FSendSocket);
end;

procedure TICQNet.Disconnect;
begin
  FreeSockets;
  if Assigned(OnDisconnect) then
    FOnDisconnect(Self);
end;
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

{*** CONSTRUCTOR ***}
constructor TICQClient.Create(AOwner: TComponent);
begin
  inherited;
  FLastError := '';                     //Last error

  gPortRange.First := 3000;             // Kludge for port range support
  gPortRange.Last  := 50000;

  FContactLst := TStringList.Create;    //Contact list
  FVisibleLst := TStringList.Create;    //Visible list
  FInvisibleLst := TStringList.Create;  //Invisible list

  FInfoChain := TStringList.Create;     //Info request chain
  FSInfoChain := TStringList.Create;    //Short info request chain

  //Socket for working with TCP
  FSock := TICQNet.Create;
  //Assign events  
  FSock.OnError := OnIntError;
  FSock.OnHandlePkt := HandlePacket;
  FSock.OnDisconnect := FTOnDisconnect;
  FSock.OnConnectError := FTOnConnectError;
  FSock.OnPktParse := FTOnPktParse;

  //Set default port and server
  if ICQPort = 0 then ICQPort := 5190;
  if ICQServer = '' then ICQServer := 'login.icq.com';


  FTimer := TMyTimer.Create;              //Timeout timer
  FTimer.OnTimer := OnTimeout;          //Set timeout event
  FTimer.Enabled := False;              //Disable timer by default

  Randomize;                            //Initialize random generator
  FSeq := Random($AAAA);                //Choose random seq, which is used in Flap header

  FDirect := nil;                       //Do not initialize direct control until we connect
end;

{*** DESTRUCTOR ***}
destructor TICQClient.Destroy;
begin
  if FDirect <> nil then
    FDirect.Free;

  FSock.OnConnectError := nil;
  //FSock.OnConnect := nil;
  FSock.OnDisconnect := nil;
  FSock.OnError := nil;
  //FSock.OnSockReceive := nil;
  FSock.Free;

  FTimer.OnTimer := nil;
  FTimer.Free;

  //Free TStringList objects
  FContactLst.Free;
  FVisibleLst.Free;
  FInvisibleLst.Free;
  FInfoChain.Free;
  FSInfoChain.Free;

  inherited;
end;

{Set NetICQ's properties}
procedure TICQClient.InitNetICQ;
begin
  //Assign properties
  FSock.Host := FIp;
  FSock.Port := FPort;
  FSock.ProxyType := FProxyType;
  FSock.ProxyHost := FProxyHost;
  FSock.ProxyPort := FProxyPort;
  FSock.ProxyUser := FProxyUser;
  FSock.ProxyAuth := FProxyAuth;
  FSock.ProxyPass := FProxyPass;
  FSock.ProxyResolve := FProxyResolve;
  FSock.ErrorLanguage := FErrLang;

//  //Assign events
//  FSock.OnHandlePkt := HandlePacket;
//  FSock.OnDisconnect := FTOnDisconnect;
//  FSock.OnConnectError := FTOnConnectError;
//  FSock.OnPktParseA := FTOnPktParse;
end;

{Called when error happened.}
procedure TICQClient.OnIntError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
begin
  FLastError := ErrorMsg;
  if Assigned(OnError) then
    FOnError(Self, ErrorType, ErrorMsg);
end;

{Logoff of server.}
Procedure TICQClient.LogOff;
var
  pkt: TRawPkt;
Begin
  CreateCLI_GOODBYE(@pkt, fSeq);
  fSock.SendData(Pkt, Pkt.Len);
  Sleep(10);
  Disconnect;
//  FSock.Disconnect;
  If fDirect <> nil then Begin
    fDirect.free;
    fDirect := nil;
  End;
  FTimer.Enabled := False;
  if assigned(OnLogOff) Then
    fOnLogOff(Self);
End;

{Logins to server.}
procedure TICQClient.Login(Status: LongWord = S_ONLINE; BirthDay: Boolean = False);
begin
  if FDirect <> nil then
  begin
    FDirect.OnError := nil;
    FDirect.OnHandle := nil;
    FDirect.OnPktDump := nil;
    FDirect.Free;
  end;

  if not DisableDirectConnections then
  begin
    FDirect := TDirectControl.Create(FLUIN);
    FDirect.OnPktDump := FTOnDirectParse;
    FDirect.OnHandle := HDirectMsg;
    FDirect.OnError := OnIntError;
    FDirect.OnFTInit := OnFTInitProc;
    FDirect.OnFTStart := OnFTStartProc;
    FDirect.OnFTFileData := OnFTFileDataProc;
    FDirect.OnSendFileStart := OnSendFileStartProc;
    FDirect.OnSendFileData  := OnSendFileDataProc;

    //Assign proxy settings
    FDirect.ProxyType := ProxyType;
    FDirect.ProxyHost := ProxyHost;
    FDirect.ProxyPort := ProxyPort;
    FDirect.ProxyUserID := ProxyUserID;
    FDirect.ProxyAuth := ProxyAuth;
    FDirect.ProxyPass := ProxyPass;
    FDirect.UseProxyResolve := ProxyResolve;
  end;


  FDSeq := Random(High(Word));
  FSeq2 := 2;
  FCookie := '';
  FFirstConnect := True;
  FStatus := Status;
  If BirthDay then FStatus := FStatus or SF_BIRTH;
  FLoggedIn := False;
  FRegisteringUIN := False;

  InitNetICQ;
  FTimer.Interval := FTimeout * 1000;
  FTimer.Enabled := False;
  if FTimeout <> 0 then
    FTimer.Enabled := True;

  FSock.Connect;
end;

procedure TICQClient.RequestOfflineMessages; // *yegor
var
   pkt: TRawPkt;
begin
     CreateCLI_TOICQSRV(@pkt, FLUIN, CMD_REQOFFMSG, nil, 0, FSeq, FSeq2);{SNAC(x15/x02)}
     FSock.SendData(pkt, pkt.Len);
end; // **yegor

{Registers a new UIN.}
procedure TICQClient.RegisterNewUIN(const Password: String);
begin
  FRegisteringUIN := True;
  FRegPassword := Password;
  FLoggedIn := False;
  InitNetICQ;
  FTimer.Interval := FTimeout * 1000;
  FTimer.Enabled := True;
  FSock.Connect;
end;

{Disconnect user from server.}
procedure TICQClient.Disconnect;
begin
  FTimer.Enabled := False;
  FSock.Disconnect;
  if Assigned(OnConnectionFailed) then
    FOnConnectionFailed(Self);
end;

{Send a message to UIN.}
procedure TICQClient.SendMessage(UIN: LongWord; const Msg: String);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SENDMSG(@pkt, 0, Random($FFFFAA), UIN, Msg, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Send an URL message to UIN.}
procedure TICQClient.SendURL(UIN: LongWord; const URL, Description: String);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SENDURL(@pkt, 0, Random($FFFFAA), FLUIN, UIN, URL, Description, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;