Codigo sin utilidad

[[ArdiIIa]]

seoane, con relación al ejemplo44, te comenté (aunque ahora no consta) que había cambiado el parámetro strUrl a 33, por aquello del consuelo.

A día de hoy, he vuelto a restablecer dicho parámetro tal cual estaba...

[[seoane]]

Empezado por ArdiIIa

seoane, con relación al ejemplo44, te comenté (aunque ahora no consta) que había cambiado el parámetro strUrl a 33, por aquello del consuelo.

A día de hoy, he vuelto a restablecer dicho parámetro tal cual estaba...

Como ya dije, no se consuela el que no quiere. Felicidades por tu nueva posición.

De todas formas, creo que roman lo tiene puesto a 1

[Enan0]

Bueno Mi codigo Inutil.

por las estadisticas de visitas.. "el TA-TE-TI" que esta agregado en el hilo el Juego del X y O, ya que ha tenido la gran suma de!!! 0 visitas
jaja Bueno saludos (no lo agrego) ya que no quiero saturar el server con basura

[Neftali [Germán.Estévez]]

Empezado por Enan0

...ya que ha tenido la gran suma de!!! 0 visitas

Pues debe estar el contador mal, como mínimo debería haber 1; Yo me lo descargué...

[Enan0]

Empezado por Neftali

Pues debe estar el contador mal, como mínimo debería haber 1; Yo me lo descargué...

Ha bueno me quedo mas Tranquilo entonces. jeje
yo ya pensaba quera el maxime de los inservibles!! jejeje

saludos. (pretendo hacerle algunos cambios, ya se los comentare) porque requieren de PHP y por ahora voy a tener que estudiar

[[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..

[[seoane]]

Gracias Ardilla por animarte, espero que se anime alguno mas, que seguro que algún código inútil tienen por ahí

[[seoane]]

Con tu permiso Ardilla, creo que queda mejor con etiquetas php

Código PHP:

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. 


El Fom

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