Obsługa Gadu-Gadu Delphi 2009

[I3L4D3]

Witam!
Czy już ktoś znalazł sposób na obsłużenie GG w Delphi 2009 albo 7?

 

[Dark Smark]

Oczywiście. Gniazdka

http://toxygen.net/libgadu/protocol/

 

[I3L4D3]

Taaa... Sam to próbuję rozkminić... Nie jest takie ciężkie jak by się wydawało... Ale chodziło mi raczej o jakiś komponent...

 

[Damn3d]

Kolejny przykład "programisty" w Delphi - bez gotowego komponentu nic nie potrafi.

Ale chodziło mi raczej o jakiś komponent[/b]

Popraw istniejący? Tylko nie pytaj o komponent do poprawiania komponentów ;P

 

[djmentos]

Dokumentacja toxygen'a jest walnięta. A przynajmniej przy tłumaczeniu na Delphi. Ja padłem na logowaniu i wiem tyle ze coś z Indianinami pochrzaniłem

 

[Damn3d]

Dokumentacja jest dobra. Trzeba tylko potrafić ją przeczytać ;P

 

[I3L4D3]

@Damn3d
Nie pasuje Ci że ktoś woli sobie ułatiwać życie niż robić pod górkę!?
Po to tworzone są komponenty - aby inni mogli z nich krzystac!
Próbujesz mnie obrazić dając słowo programisty w cudzysłów? - Mi to nie robi. Mam to gdzieś!
Poprawa istniejącego komponentu - niemożliwa... Raczej napisanie własnego jest łatwiejsze niż poprawa tego co istnieje.

 

[djmentos]

Damn3d: Znam 11 języków więc nie (auto cenzura), że nie umiem czytać dokumentacji. Bo umiem ją czytać doskonale i jedyne co jest nie teges to pobranie ziarna i obsługa hasha SHA - 1

 

[Damn3d]

Nie pasuje Ci że ktoś woli sobie ułatiwać życie niż robić pod górkę!?[/b]

Tak. Bo potem takie osoby zadają różne debilne pytania dotyczące podstawowych rzeczy. A jakość wykonanych aplikacji jest wątpliwa.

Raczej napisanie własnego jest łatwiejsze niż poprawa tego co istnieje.[/b]

Na co czekasz?

Znam 11 języków[/b]

Fajnie ;P (Dlaczego nie napiszesz tego w C?)

więc nie (auto cenzura), że nie umiem czytać dokumentacji.[/b]

Tego nie napisałem.

Bo umiem ją czytać doskonale i jedyne co jest nie teges to pobranie ziarna i obsługa hasha SHA - 1[/b]

Pobranie ziarna? nie wiem co tu może być nie tak. Aczkolwiek jeżeli Ci na tym zależy, to możesz wejść na IRC, może coś wymyślimy ;P
SHA1? Użyj drugiego sposobu na hashowanie.

 

[I3L4D3]

Rozmawiałem z DJ Mentos... Stwierdził że drugi sposób hashowania nie działa pod 8.0...

Co do mnie... Jakoś wykonywanych aplikacji nie jest wątpliwa... Jeżeli komus nie przeszkadza rozmiar - to jest ok. ;P
Nie napisze własnego protokołu połączenia za NAT'em - czemu? PROSTE! Bo posiadam wewnętrzne zmienne ip. Więc nie miałbym gdzie aplikacji serwerowej postawić. Chyba że znajdziesz mi jakiś serwer (dodam że na początek nie chce wkładać w to gotówki).
Jakie moje pytanie uważasz za debilne?

 

[Damn3d]

Stwierdził że drugi sposób hashowania nie działa pod 8.0...[/b]

Bzdura. Z ciekawości sprawdziłem. Oprócz tego, że co chwile pisałem '=' zamiast ':=' nie miałem z Delphi większych problemów ;P Połączyło i zalogowało. Metoda hashowania - stara.

Jakie moje pytanie uważasz za debilne?[/b]

Nie napisałem, że Twoje, nie bądźcie nadwrażliwi. A jak chcesz zoabczyć debilne pytania, to zobacz dział Delphi

Nie trudno będzie znaleźć.

 

[I3L4D3]

@Damn3d
Tak... Tu masz racje... Niektóre pytania są naprawde debilne... Gdzieś widziałem temat typu: Jak nacisnąć button2 naciskając button1... Hah... :/
Delphi może i na prawde nie jest takie doskonałe... Ale napewno wystarczające... I tak w końcu kiedyś będę musiał nauczyć się C++...

No to może tak zaprezentujesz nam kodzik którym to zrobiłeś?

 

[Damn3d]

A proszę.
Binarka : http://rapidshare.com/files/256240273/DGG.exe.html
Kod niżej.
Kompilowane na najnowszej wersji Delphi.
Może być pare niedociągnięc, nigdy wczesniej nie programowalem w Pascalu.
Jak jakieś pytania, to IRC jest otwarty ;P
Jak ktoś użyje kodu, to wypadałoby podziękować ;P

{
  [email protected]
}

program DGG;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows,
  Sockets;


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;
      WriteLn('Unable to connect');
      exit()
    end;

    while socket.ReceiveBuf(header, SizeOf(gg_header)) > 0 do begin

      if (header.t = GG_WELCOME) then begin
          WriteLn('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));
          WriteLn('Sent login data');

    end else if (header.t = GG_LOGIN80_OK) then begin
      WriteLn('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
      WriteLn('Wrong password');
      socket.Disconnect;

    end else if (header.t = GG_DISCONNECTING) then begin
      WriteLn('Received GG_DISCONNECTING');
      socket.Disconnect;

    end else begin
      WriteLn('Unknown header');

      // Odbieramy smieci
      if (header.l > 0) then begin
        GetMem(garbage, header.l);
        socket.ReceiveBuf(garbage, header.l);
        FreeMem(garbage);
      end;
    end;

  end;

  WriteLn('Disconnected.');
  socket.Destroy;
  ReadLn;

end;


var
  buff_in: AnsiString;
  gg_id: Integer;

begin
  try

  Write('Numerek: ');
  ReadLn(buff_in);

  if StrToIntDef(String(buff_in), 0) = 0 then begin
    WriteLn('Bledny numer');
    exit();
  end;


  gg_id := StrToIntDef(String(buff_in), 0);
  Write('Haslo: ');
  ReadLn(buff_in);


  WriteLn('gg_id=' + IntToStr(gg_id) + ' gg_pass=' + String(buff_in));
  WriteLn('[@] Start');
  connect(gg_id, PAnsiChar(buff_in));


  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;

end.

 

[I3L4D3]

Ciekawe zastosowanie... Zawsze korzystałem z Array of Char... A tutaj widze Array of AnsiChar... xD

Zauważyłem 2 błędy... Z przyzwyczajenia zapomniałeś skasować nawiasy przy instrukcjach Exit... xD
Dokładnie trzeba to: exit() i to: exit();
Zamienić na: exit;

Sprawdziłem... Coś nie za bardzo działa... ;/
Problem: Zalogowałem się na numer. I nie zmienił statusu na dostępny... :/

 

[Damn3d]

Zaraz zobaczę. Sprawdzałeś na załączonej binarce? Takie coś zresztą łatwo poprawić, bo program bez problemu się loguje.

Dokładnie trzeba to: exit() i to: exit();
Zamienić na: exit;[/b]

Mi tam się kompiluje tak jak jest. Ale fakt, to chyba nie do końca zgodne z praktykami Delphi.

Ciekawe zastosowanie... Zawsze korzystałem z Array of Char... A tutaj widze Array of AnsiChar... xD[/b]

W nowszych edycjach Delphi z tego co zauwazylem, to Char jest przypisany na wersje Unicode (WideChar), a co za tym idzie waży dwa bajty zamiast 1.

 

[I3L4D3]

Bardzo możliwe... Mało piszę w Delphi9

Raczej rozpisuję sie nad 7...

Na binarce - nie próbowałem...

 

[Damn3d]

Sprawdziłem. Wszystko jest ok, po prostu musisz wysłać info o liście kontaktów, dopiero wtedy będziesz mógł "działać". Opis w dokumentacji.
A co do 'Char' - W przypadkach tego typu najlepiej precyzować od razu WideChar/AnsiChar, aby uniknąć problemów na kolejnych wersjach/systemach.

 

[I3L4D3]

Taa... Git... To zaraz sprawdze...

Jak dam listempty - to powinno byc ok...

//EDIT

Jeszcze jedna sprawencja

Mam kodzik:

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;

I jak dam do opisu (FDescription) znaki polskie znaki, to w gadu są wyświetlane nieprawidłowo... Jakieś porady? Jak temu zaradzic?

 

[Damn3d]

Możesz mieć problem przy Unknown header, bo tam błąd chyba jest. Jak chcesz szybki kontakt, to jestem aktualnie na IRCu.

 

[djmentos]

AnsiChar na WideChar spróbuj.