Zmiana statusu w gg8 i jego obsługa

0

Witam :)
Znalazłem na internecie kod do obsługi gg8. Pozmieniałem go trochę, i oto on:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Sockets, StdCtrls;

type
  TFgg = class(TForm)
    zaloguj: TButton;
    lnumer: TLabel;
    lhaslo: TLabel;
    numer: TEdit;
    haslo: TEdit;
    log: TMemo;
    llog: TLabel;
    procedure zalogujClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Fgg: TFgg;

implementation

{$R *.dfm}

function gg_login_hash(password: PAnsiChar; seed: Cardinal) : Integer;
  var
    x, y, z: Integer;
  begin
   y := seed;
    x := 0;
    while (password^ <> AnsiChar(nil)) do begin
      x := (x and $ffffff00) or Ord(password^);
      y := y xor x;
      y := y + x;
      x := x shl 8;
      y := y xor x;
      x := x shl 8;
      y := y - x;
      x := x shl 8;
      y := y xor x;
      z := y and $1f;
      y := (y shl z) or (y shr (32 - z));
      password := password + 1;
    end;
    result := y;
end;

procedure connect(gg_id: Integer; gg_pass: PAnsiChar);
  type
    gg_header = record
      t: Integer;
      l: Integer;
    end;
    s_gg_login80 = packed record
      uin: Integer;
      language: array[1..2] of AnsiChar;
      hash_type: Byte;
      hash: array [1..64] of AnsiChar;
      status: Integer;
      flags: Integer;
      features: Integer;
      local_ip: Integer;
      local_port: SmallInt;
      external_ip: Integer;
      external_port: SmallInt;
      image_size: Byte;
      unknown2: Byte;
      version_len: Integer;
      version: array[1..$21] of AnsiChar;
      description_size: Integer;
  end;
  var
    socket: TTcpClient;
    i_tmp: Integer;
    garbage: Pointer; // Tutaj beda tymczasowo odbierane wszystkie smieci
    header : gg_header;
    out_login: s_gg_login80;
    seed: Cardinal;
    const GG_WELCOME = $0001;
    const GG_LOGIN80 = $0031;
    const GG_LOGIN_HASH_GG32 = $01;
    const GG_LOGIN_HASH_SHA1 = $02;
    const GG_LOGIN80_OK = $0035;
    const GG_STATUS_AVAIL = $0002;
    const GG_LOGIN_FAILED = $0009;
    const GG_DISCONNECTING = $000b;
  begin
    socket := TTcpClient.Create(nil);
    socket.RemoteHost := '91.197.13.35';
    socket.RemotePort := '443';
    if not socket.Connect then begin
      socket.Destroy;
      Fgg.log.Lines.Add(TimeTostr(Time)+': Unable to connect');
    end;
    while socket.ReceiveBuf(header, SizeOf(gg_header)) > 0 do begin
      if (header.t = GG_WELCOME) then begin
          Fgg.log.Lines.Add(TimeTostr(Time)+': GG Welcome');
          socket.ReceiveBuf(i_tmp, SizeOf(i_tmp));
          seed := i_tmp;
          ZeroMemory(@out_login, SizeOf(out_login));
          header.t := GG_LOGIN80;
          header.l := SizeOf(out_login);
          out_login.uin := gg_id;
          out_login.hash_type := GG_LOGIN_HASH_GG32;
          out_login.status := GG_STATUS_AVAIL;
          out_login.features := $00000007; // Bo tak ma byc
          out_login.unknown2 := $64; // Bo tak ma byc
          out_login.version_len := SizeOf(out_login.version);
          out_login.description_size := 0; // I tak jest wyzerowane, ale to tak dla pamieci, ze nie mamy opisu
          CopyMemory(@out_login.language, PAnsiChar('pl'), 2); { Dlaczego tak? A no bo po to, zeby miec pewnosc, z
                                                                 ze Delphi nie dolozy magicznie na koniec NULLa. }
          CopyMemory(@out_login.version, PAnsiChar('Gadu-Gadu Client build 8.0.0.7669'), SizeOf(out_login.version));
          i_tmp := gg_login_hash(gg_pass, seed); // Obliczamy hasha
          CopyMemory(@out_login.hash, @i_tmp, SizeOf(i_tmp));
          socket.SendBuf(header, SizeOf(header));
          socket.SendBuf(out_login, SizeOf(out_login));
          Fgg.log.Lines.Add(TimeTostr(Time)+': Sent login data');
    end else if (header.t = GG_LOGIN80_OK) then begin
      Fgg.log.Lines.Add(TimeTostr(Time)+': Logged in');
      if (header.l > 0) then begin
        GetMem(garbage, header.l);
        socket.ReceiveBuf(garbage, header.l, 1);
        FreeMem(garbage);
      end;
    end else if (header.t = GG_LOGIN_FAILED) then begin
      Fgg.log.Lines.Add(TimeTostr(Time)+': Wrong password');
      socket.Disconnect;
    end else if (header.t = GG_DISCONNECTING) then begin
      Fgg.log.Lines.Add(TimeTostr(Time)+': Received GG_DISCONNECTING');
      socket.Disconnect;
    end else begin
      Fgg.log.Lines.Add(TimeTostr(Time)+': Unknown header');
      // Odbieramy smieci
      if (header.l > 0) then begin
        GetMem(garbage, header.l);
        socket.ReceiveBuf(garbage, header.l);
        FreeMem(garbage);
      end;
    end;
  end;
  Fgg.log.Lines.Add(TimeTostr(Time)+': Disconnected.');
  socket.Destroy;
end;

procedure TFgg.zalogujClick(Sender: TObject);
var
  buff_in: AnsiString;
  gg_id: Integer;
begin
  try
  gg_id:=strtoint(numer.Text);
  buff_in:=haslo.Text;
  connect(gg_id, PAnsiChar(buff_in));
  except end;
end;


end.

Kompilowane w Delphi 2009. I teraz problemy:

  1. "Błąd" podczas kompilowania. Wyskakuje przy linijce: buff_in:=haslo.Text; i pisze [DCC Warning] Unit1.pas(159): W1058 Implicit string cast with potential data loss from 'TCaption' to 'AnsiString' Dlaczego?
  2. Logowanie przebiega prawidłowo do momentu "Logged In". Po tym - program sie zawiesza. Czemu? Gdy np. wprowadzę nieprawidłowe hasło - program wyświetli, że jest błędne hasło, ale się nie zawiesi. Więc co jest źle?
  3. Program nie zmienia statusu. I teraz pytanie, jak to zrobić? Szukałem na necie, znalazłem, że trzeba wysłać informację o liście kontaktów, a dopiero później działać. Znalazłem także kod, który powinien działać (podobno nie wyświetla poprawnie polskich znaków, no, ale ważne że działa :P):
procedure TBGG1.ChangeStatus;
var
  Header: THeader;
  OutNewStatus: packed record
    Status: Integer;
    Flags: Integer;
    DescriptionSize: Integer;
  end;
  Description: Array[1..255]of AnsiChar;
const
  C_OUT_NEWSTATUS = $0038;
begin
  Header.Typ := C_OUT_NEWSTATUS;
  OutNewStatus.DescriptionSize := Length(FDescription);
  if OutNewStatus.DescriptionSize > 0 then
  begin
    FStatusEx := CodeStatus(FStatus,True);
    OutNewStatus.Status := FStatusEx;
    CopyMemory(@Description,PAnsiChar(FDescription),Length(FDescription));
    Header.Length := SizeOf(OutNewStatus)+Length(FDescription);
    TCP.WriteBuffer(Header,SizeOf(Header));
    TCP.WriteBuffer(OutNewStatus,SizeOf(OutNewStatus));
    TCP.WriteBuffer(Description,Length(FDescription));
    MessageBox(0,PAnsiChar(string(Description)),'lol',MB_OK);
  end else
  begin
    FStatusEx := CodeStatus(FStatus);
    OutNewStatus.Status := FStatusEx;
    Header.Length := SizeOf(OutNewStatus);
    TCP.WriteBuffer(Header,SizeOf(Header));
    TCP.WriteBuffer(OutNewStatus,SizeOf(OutNewStatus));
  end;
end;

Moje pytanie - jak dodać ten kod do programu? W które miejsce go wstawić?
4. Jak dodać do programu procedurę odbierania i wysyłania wiadomości? Może ktoś już to robił? Można się posłużyć [url="http://toxygen.net/libgadu/protocol/"][b]tą[/b][/url] dokumentacją.

Z góry za wszelką pomoc dziękuję :)

0

  1. Zmieniamy status po zalogowaniu więc po zalogowaniu wystepuje fragment zmiany statusu.

  2. Nie spotkałem się z czymś tak śmiesznym ale może być kłopot z przesyłaniem danych do serwer już kiedyś trafiłem na coś takiego że program łączył się z serverem a następnie wysyłał paczki danych bez oczekiwania na gotowość servera. I tu może być podobny problem ale z gg nie korzystam od 5 lat i nie mam zamiaru zaczynać więc nie sprawdzę. Podobnie z delphi 2009 leży na dysku i jeszcze trochę poleży.

1 użytkowników online, w tym zalogowanych: 0, gości: 1