Jak pobrać status i opis jakiegoś numeru GG
Adamo
Opisana poniżej metoda jest już nieaktualna. Jeśli możesz, zaktualizuj ją.
Piszę tą wskazówkę ponieważ się trochę napisałem na forum (http://4programmers.net/Forum/viewtopic.php?id=57108) i nie chcę żeby to się zmarnowało :P
ten kod poniżej pobiera te informacje ze strony http://gg.siedziba.pl/
{ Kod do odczytywania statusu i opisu użytkownika GG by Adamo }
uses
UrlMon;
function Heks(C: Char): Byte; // Funkcja zamiany cyfry Hex (0-f) na normalną liczbę (0-15)
begin
Case Ord(UpCase(c)) of
48..57: Result := Ord(UpCase(C)) - 48; // cyfry (0-9)
65..70: Result := Ord(UpCase(C)) - 55; // litery (A-F)
else
Result := 0; // jeśli jest to inny znak to przypisz 0
end;
end;
function HexToInt(Hex: String): Integer; // Funkcja zamiany liczby Hexadecymalnej na decymalną napisana na szybko przez Adamo
var I, wsp: Byte;
begin
for I := Length(Hex) - 1 downto 1 do
begin
Inc(wsp);
Inc(Result, Heks(Hex[I]) *wsp*16);
end;
Inc(Result, Heks(Hex[Length(Hex)]));
end;
function Decode(Text : String): String;
var S : String;
I : Byte;
begin
for I := 0 to (Length(Text) - 1) div 6 do
begin
S := Copy(Text, I*6 + 1,6);
S := Copy(S, 5, 2);
S := Chr(HexToInt(S));
Result := Result + Ch;
end;
end;
procedure StatusGG(Number: Integer; var Status: Integer; var Description: String);
var TxFile : TextFile;
Linia : String;
begin
if URLDownloadToFile(nil, PChar('http://gg.siedziba.pl/status.php?uid=' + IntToStr(Number) + '&js=2'), 'C:\stat.dat', 0, nil) <> 0 then
begin
Status := 1;
Description := 'Brak opisu';
Exit;
end;
AssignFile(TxFile, 'C:\stat.dat');
Reset(TxFile);
ReadLn(TxFile, Linia);
Linia := Copy(Linia, Pos('=', Linia) + 1,1);
if not TryStrToInt(Linia, Status) then Status := 1;
ReadLn(TXFile, Linia);
Linia := Copy(Linia, Pos('"',linia) + 1, Length(Linia));
Linia := Copy(Linia, 1, Pos('"', Linia) -1);
if Length(Linia) < 6 then
Description := 'Brak opisu'
else
Description := Decode(Linia);
CloseFile(TxFile);
DeleteFile('C:\stat.dat');
end;
i przykład użycia:
procedure TForm1.Button1Click(Sender: TObject);
var Description: String; Status: Integer;
begin
statusGG('5555698', Status, Description);
Case Status of
2: Label1.Caption := '5555698 jest teraz dostępny';
3: Label1.Caption := '5555698 zaraz wraca';
else
Label1.Caption := '555698 jest niedostępny';
end;
Label2.Caption := Description;
end;
Aby pobrać sam status osoby w przypadku gdy powyższy przykład nie działa można pobrać status ze strony http://gadu-gadu.pl
uses
UrlMon;
var Number, Status : Integer;
TxFile : TextFile;
Temp : String;
begin
Number := 5555698;
if URLDownloadToFile(nil, PChar('http://www.gadu-gadu.pl/users/status.asp?id=' + IntToStr(Number) + '&styl=2') ,'c:\stat.dat', 0, nil) <> 0 then Status := 1
else
begin
AssignFile(TxFile, 'C:\stat.dat');
Reset(TxFile);
ReadLn(TxFile, Temp);
if not TryStrToInt(Temp, Status) then Status := 1;
CloseFile(plik);
DeleteFile('c:\stat.dat');
end;
Case Status of
2: Label1.Caption := IntToStr(Number) + ' jest teraz dostępny';
3: Label1.Caption := IntToStr(Number) + ' zaraz wraca';
else
Label1.Caption := IntToStr(Number) + ' jest niedostępny';
end;
end;
można otworzyć okienko rozmowy gg jeżeli ktoś ma je zainstalowane w następujący sposób:
uses
Registry;
procedure OtworzOkienko(Number: String);
var
Version, Path : String;
Registry : TRegistry;
Ver : Integer;
Luzno : Boolean;
begin
Registry := TRegistry.Create;
Registry.RootKey := HKEY_LOCAL_MACHINE;
Registry.OpenKey('Software\Gadu-Gadu\Setup', False);
Path := Registry.ReadString('InstallPath') + '\gg.exe';
Registry.CloseKey;
Registry.OpenKey('Software\Gadu-Gadu\Gadu-Gadu', False);
Version := Registry.ReadString('Version');
Luzno := False;
if Version = '' then
begin
Version := '5.0';
luzno := True;
end;
Registry.CloseKey;
Registry.Free;
if not TryStrToInt(Version[1], Ver) then
begin
Ver := 5;
Luzno:=true;
end;
if not FileExists(Path) then
begin
Path := 'C:\Program Files\Gadu-Gadu\gg.exe';
ShowMessage('Nie można znaleźć zainstalowanego gg. Otwórz okienko rozmowy ręcznie');
end
else if Ver < 5 then
ShowMessage('Masz zainstalowaną za starą wersję gg. Otwórz okienko rozmowy ręcznie');
else
WinExec(PChar(Path + ' /ggurl:"' + Number + '"'), SW_Normal);
if Luzno then
ShowMessage('Mimo twojej wersji gg, nastąpiła próba uruchomienia okienka, jeśli okienko się nie uruchomi to uruchom je ręcznie');
end;
i przykład uruchomienia okienka:
OtworzOkienko('5555698');
Jeśli chcesz być widoczny również wtedy, gdy masz ustawione "Tylko dla znajomych", dodaj użytkownika o numerze 3908302 do swojej listy kontaktów.
w dziale Kody źródłowe dodałem gotowy programik
Dla mnie działający kod to:
[code]
var
x: string;
begin
X := idHTTP1.Get('http://status.gadu-gadu.pl/users/status.asp?id=' + lgg.Caption + '_GG&styl=2');
if pos('1', X) > 0 then TBXLabel2.Caption := 'status 1';
if pos('2', X) > 0 then TBXLabel2.Caption := 'status 2';
if pos('3', X) > 0 then TBXLabel2.Caption := 'status 3';
end;
[/code]
Dobrym sposobem na sprawdzenie statusu użytkownika GG jest oto taki kod (oprócz tego co już o tym powiedziano "Jak pobrać status i opis jakiegoś numeru GG"):
var
X: byte;
numer: string;
begin
X := StrToInt(idHTTP1.Get('http://status.gadu-gadu.pl/users/status.asp?id=xxxxxx_GG&styl=2'));
case X of
1:Label1.Caption:=IntToStr(xxxxxx)+' niedostępny';
2:Label1.Caption:=IntToStr(xxxxxx)+' jest teraz dostępny';
3:Label1.Caption:=IntToStr(xxxxxx)+' zaraz wraca';
end;
gdzie xxxxxx - Twój nr GG
Kod ten wymaga komponentu z zakładki Indy Clients - TidHTTP
http://gg.siedziba.pl/status.php?uid=numer&xml=1 co da nam informacje zapisane w xmlu, ktorego o wiele latwiej sparsowac, poza tym te pliki .... :(
Gdybym uznał, że ten FAQ się powtarza, to bym go skasował. Link podałem w celach informacyjnych.
Ale przyznam że o http://gg.siedziba.pl/ dowiedziałem się właśnie z tego faqu co podał Marooned
No, Marooned, ale nie powiesz chyba, że to jest powtarzający się FAQ? Przecież to dwie różne rzeczy. Ten dotyczy sprawdzenia statusu i opisu z poziomu Delphi, tamten zamieszczenia takiej informacji na swojej stronie internetowej. Oczywiście można wykorzystać tamten skrypcik w Delphi, ale to jest BARDZO okrężna droga...
http://4programmers.net/faq.php?id=579
no fakt z tymi plikami ale pisałem to na szybko byle żeby było :) można zastąpić oczywiście URLDownloadToFile, AssignFile, Reset, CloseFile komponentem IdHTTP i dać temp:=IdHTTP1.Get('to co jest w URLDownloadToFile);
będzie to szybsze i nie zapisze nic na dysku i nie potrzebuje dodania unitu URLMon do uses za to dopisuje unity Indy które zajmują jeszcze więcej :)
a te dane w xmlu w/g mnie ma taką samą trudność sprarsowania tyle że jest może bardziej czytelna