Codigo sin utilidad

[[ArdiIIa]]

Bueno. Yo siguo en mis "doce mas uno" y a coladura de aquel hilo, pongo este código "de fin de semana".

No sirve para ver los usuarios que están conectados y resume el número suma el número de visitantes...........

En esta ocasión, prescindimos de las WinInet
El código es simplom y con prisas pero funciona.


[delphi]
unit UnitMain;

interface

uses
Windows, SysUtils, Classes, Forms,Dialogs, IdComponent, IdTCPConnection,
IdHTTP, IdCookieManager, IdBaseComponent, ExtCtrls, StdCtrls, Controls,
IdTCPClient;

type
TFormMain = class(TForm)
IdCookieManager1: TIdCookieManager;
IdHTTP: TIdHTTP;
Memo1: TMemo;
Panel1: TPanel;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Button1: TButton;

procedure IdHTTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);
procedure Conectar;
procedure Extraer(Url : String);
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
FormMain: TFormMain;
Perfil : Integer;

implementation

{$R *.dfm}

procedure TFormMain.IdHTTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);
begin
//Memo1.Lines.Add(AStatusText)
end;


procedure TFormMain.Button1Click(Sender: TObject);
begin
Perfil := 0;
Memo1.Lines.Clear;
Conectar;
Extraer('http://www.clubdelphi.com/foros/online.php');
end;



procedure TFormMain.Conectar;
var
Campos: TStringlist;
Respuesta: TStringStream;
Begin
Campos:= TStringList.Create;
Respuesta:= TStringStream.Create('');
Campos.Values['vb_login_username']:= Trim(Edit1.Text);
Campos.Values['vb_login_password']:= Trim(Edit2.Text);
Campos.Values['do']:= 'login';
Idhttp.post('http://www.clubdelphi.com/foros/login.php',Campos);
Campos.Free;
Respuesta.Free;
end;


procedure TFormMain.Extraer(Url : String);
var
SiguientePag : String;
Contenido : TStrings;
I : Integer;
Desde , Longitud : Integer;
cTemp : String;
Begin

Contenido := TStringList.Create;
SiguientePag := '';

Contenido.Text := Idhttp.Get(Url);

//Procesar la salida
For I := 0 to Contenido.Count -1 Do
begin
//Siguiente página
If Pos('Siguiente Página',Contenido[i]) > 0 then
Begin
Desde := Pos('href', Contenido[i]);
Longitud := Pos('title', Contenido[i]) - Desde;
SiguientePag := Copy(Contenido[i],Desde , Longitud);
SiguientePag := StringReplace(SiguientePag,'&','&',[rfReplaceAll]);
End;

//Usuarios
If (Pos('<a href="member.php',Contenido[i]) > 0 ) and (Pos('Mi Perfil',Contenido[i]) = 0 ) then
Begin
Desde := 1 + Pos('>', Contenido[i]);
Longitud := Pos('</a>', Contenido[i]) - Desde;
//usuarios conectados -----> también aparecen los que han terminado sesión
if Trim(Contenido[I + 12 ]) <> '' then
Memo1.Lines.Add( Copy(Contenido[i],Desde , Longitud) + ' ---> ' + Trim(Contenido[I + 12 ]));
End;

If Trim (Contenido[i]) = 'Visitante' then
Begin
if Pos('Registrandose' ,Trim(Contenido[I + 12 ])) > 0 then
cTemp := 'Registrándose'
else
cTemp := Trim(Contenido[I + 12 ]);

if Pos('Viendo Perfil de Usuario' ,Trim(Contenido[I + 12 ])) > 0 then
inc(Perfil);
Memo1.Lines.Add( 'Visitante ---> ' + cTemp);
End;

End;

Contenido.Free;
Application.ProcessMessages;

if SiguientePag = '' then
Begin
Memo1.Lines.Add('***************************************************************************');
Memo1.Lines.Add('NUMERO DE VISITANTES VIENDO PERFIL DE USUARIOS: ' + IntToStr(Perfil));
Memo1.Lines.Add('***************************************************************************');
End
Else
Begin
SiguientePag := 'http://www.clubdelphi.com/foros/' + Copy(SiguientePag,7,Length(SiguientePag));
System.Delete(SiguientePag,Length(SiguientePag)-1,1);
Extraer(SiguientePag);
End;



End;


end.




[/delphi]

El Fom
[code]
object FormMain: TFormMain
Left = 309
Top = 149
Width = 532
Height = 409
Caption = 'Estadísticas de usuarios contectados -By AdiIIa-'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 0
Top = 45
Width = 524
Height = 330
Align = alClient
ScrollBars = ssBoth
TabOrder = 0
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 524
Height = 45
Align = alTop
TabOrder = 1
object Label1: TLabel
Left = 8
Top = 8
Width = 36
Height = 13
Caption = 'Usuario'
end
object Label2: TLabel
Left = 192
Top = 8
Width = 46
Height = 13
Caption = 'Password'
end
object Edit1: TEdit
Left = 64
Top = 8
Width = 121
Height = 21
TabOrder = 0
Text = 'TuNick'
end
object Edit2: TEdit
Left = 248
Top = 8
Width = 121
Height = 21
TabOrder = 1
Text = 'TuClave'
end
object Button1: TButton
Left = 392
Top = 8
Width = 75
Height = 25
Caption = 'Conectar'
TabOrder = 2
OnClick = Button1Click
end
end
object IdCookieManager1: TIdCookieManager
Left = 32
Top = 208
end
object IdHTTP: TIdHTTP
OnStatus = IdHTTPStatus
MaxLineAction = maException
ReadTimeout = 0
Host = 'www.clubdelphi.com'
AllowCookies = True
ProxyParams.BasicAuthentication = False
ProxyParams.ProxyPort = 0
Request.ContentLength = -1
Request.ContentRangeEnd = 0
Request.ContentRangeStart = 0
Request.ContentType = 'application/x-www-form-urlencoded'
Request.Accept = 'text/html, text/plain, */*'
Request.AcceptEncoding = 'gzip, deflate '
Request.AcceptLanguage = 'es,en;q=0.5 '
Request.BasicAuthentication = False
Request.UserAgent = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1) '
HTTPOptions = [hoForceEncodeParams]
CookieManager = IdCookieManager1
Left = 32
Top = 176
end
end
[/code]


Para los que no quieran perder tiempo en compilar, pongo el ejecutable comprimido como adjunto.


Edito y pongo las etiquetas noparse porque el mensaje aslía echo una porquería..