Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Codigo sin utilidad (https://www.clubdelphi.com/foros/showthread.php?t=41240)

seoane 20-07-2007 11:36:27

Cita:

Empezado por Neftali
No he conseguido pasar de 31 sg. :(:(:(

Me pongo nervioso, miro cuanto tiempo llevo y me "pasan por encima" :(

No te preocupes yo no paso de 19 seg :(

Quizá es por eso que no somos pilotos de combate :D :D aunque con 31 segundos a lo mejor te dejaban una avioneta, a mi ni eso :(

ContraVeneno 20-07-2007 17:17:38

Orales!, por fin: Record 38.513

Caral 20-07-2007 17:56:04

Hola
Que va esto es imposible, voy a tener que dejar de fumar, con 6 segundos, no me dan ni una bicicleta.
Aparte, Seoane, no me canso de decirlo, eres genial, de verdad, impresionas cada 6 segundos, como mi record.
Saludos

white_zombie 20-07-2007 18:29:50

Complicado el juegecito, 20 seg y de casualidad porque el resto de la veces no paso de 8.

Esto es como el pac-man, simple pero adictivo.

Un saludo.

seoane 20-07-2007 18:59:55

Cita:

Empezado por ContraVeneno
Orales!, por fin: Record 38.513

Se nota que juegas habitualmente, tu coordinación mano-ojo es excelente :D

principiante22 20-07-2007 19:17:56

1 Archivos Adjunto(s)
ehhhhh!!!!! new record 52 seg, es demasiado dificil mantenerse dentro del cuadro blanco :(

seoane 11-08-2007 03:45:53

1 Archivos Adjunto(s)
Caramba me voy dos días de fiesta y me borran los mensajes :p :D

Pues nada, el ejemplo que se borro, genera una gráfica a partir del numero de mensajes de los 32 usuarios con mas mensajes. Perdonar si no me extiendo mas en la explicación, pero el ron me impide ser mas locuaz :D

seoane 12-08-2007 17:17:56

Yo continuo, al final este hilo esta siendo un monologo :p

Bueno, imaginaros esta situación, estas en un ordenador que no es el tuyo y quieres ocultar un archivo a la vista de los curiosos, una foto comprometida, un documento confidencial, etc. Como no es tu ordenador, no te vas a poner a instalar nada, ni andar ejecutando ningún programa extraño, pero lo que si podemos hacer es abrir la consola de comandos y teclear esto:
Código:

copy /b foto.jpg+secreto.doc oculto.jpg
Donde "foto.jpg" es una foto jpg cualquiera, que tenga una apariencia lo mas inocente posible, "secreto.doc" es el archivo a ocultar (puede ser cualquier tipo de archivo) y "oculto.jpg" es el nombre del archivo ya empaquetado.

Te preguntaras que hacemos con esto, pues básicamente "ponerle un sombrero" a nuestro archivo. A todos los efectos el archivo resultante parecerá una foto, y tanto la vista previa de windows, como la mayoría de los programas lo abrirán como si de una foto se tratara.

Ahora el problema es "quitarle el sombreo" a nuestro archivo. Para esto no queda mas remedio que usar un programa (al menos no se de ningún comando que realice esta labor). Y aquí es donde, por fin :D , entra en acción el siguiente código:

Es una aplicación de consola
Código Delphi [-]
program unpack;

{$APPTYPE CONSOLE}

uses 
  SysUtils, Classes;

// Esta funcion posiciona el puntero al principio del archivo oculto
procedure QuitarSombrero(Stream: TStream);
var
  Buffer: array[0..3] of Byte;
  Size: Integer;
begin
  while TRUE do
  begin
    FillChar(Buffer,Sizeof(Buffer),#0);
    Stream.Read(Buffer,4);
    Size:= ((Buffer[2] shl 8) + Buffer[3]) - 2;
    case Buffer[1] of
      $01,$D0..$D8: Stream.Seek(-2,soFromCurrent);
      $D9: begin
             Stream.Seek(-2,soFromCurrent);
             Exit;
           end;
      $DA: begin
             Stream.Seek(-2,soFromCurrent);
             while TRUE do
             begin
               Stream.ReadBuffer(Buffer,1);
               if Buffer[0] = $FF then
               begin
                 Stream.ReadBuffer(Buffer,1);
                 if (Buffer[0] <> 0) and not (Buffer[0] in [$D0..$D7]) then
                 begin
                   Stream.Seek(-2,soFromCurrent);
                   break;
                 end;
               end;
             end;
           end;
      else
        Stream.Seek(Size,soFromCurrent);
    end;
  end;
end;

var
  Entrada, Salida: TFileStream;
begin
  try
    Entrada:= TFileStream.Create(ParamStr(1),fmOpenRead or fmShareDenyWrite);
    try
      Salida:= TFileStream.Create(ParamStr(2),fmCreate);
      try
        QuitarSombrero(Entrada);
        Salida.CopyFrom(Entrada,Entrada.Size - Entrada.Position);
      finally
        Salida.Free;
      end;
    finally
      Entrada.Free;
    end;
  except
    On E: Exception do
      Writeln('Error: ' + E.Message);
  end;
end.

Por ejemplo, para extraer "secreto.doc" de "oculto.jpg":
Código:

unpack oculto.jpg secreto.doc

ArdiIIa 12-08-2007 18:12:48

Pues yo también me quito el sombrero ante esta "inutilidad"..:)

¿Que ocurre si no hay ningún archivo jpg en ese ordenador ?
Y... si la hubiera...
¿Que pasaría si la foto fuera mas comprometida que el propio documento a ocultar.?:D

seoane 12-08-2007 18:39:19

Cita:

Empezado por ArdiIIa
¿Que ocurre si no hay ningún archivo jpg en ese ordenador ?

Entonces el proceso a seguir seria el siguiente, vamos a "Inicio > Programas > Accesorios > Paint", abrimos un documento nuevo, dibujamos un bonito paisaje con un arbolito y un sol bien grande, y para terminar lo guardamos como jpg :D


Cita:

Pues yo también me quito el sombrero ante esta "inutilidad"..
Pues colabora y pon tu algo, no me creo que no tengas alguna idea de bombero por ahí guardada ;) :D

ArdiIIa 12-08-2007 18:59:33

Cita:

Empezado por seoane
Pues colabora y pon tu algo, no me creo que no tengas alguna idea de bombero por ahí guardada ;) :D

Lo son casi todas, pero no están patentadas.:D
Además, imagina que se me echa encima el cuerpo de bomberos por exponer aquí sus ideas.

seoane 12-08-2007 19:02:56

Cita:

Empezado por ArdiIIa
Además, imagina que se me echa encima el cuerpo de bomberos ...

Mientras no se te eche encima el cuerpo de un bombero ... :rolleyes:

Por dios, cuanto reparo hay en mostrar código, os veo muy tímidos :D :D

ArdiIIa 12-08-2007 19:36:09

Oyes, no te voy a dejar con las ganas...:D
Espero que ahora no se me echen encima los de RENFE

Código Delphi [-]
unit loquequieras;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  const
  ShapeSize = 40;


var
  Form1: TForm1;
  rShape : TRect;
  Step,XCli, Ycli,XCent, YCent : Integer;
  Ps : PaintStruct;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
rShape := GetClientRect;
rShape.Right   := XCent + ShapeSize;
rShape.Bottom  := YCent + ShapeSize;
rShape.Top     := yCent;
rShape.Left    := xCent;
xCent := xCent +Step;
If (xCent + ShapeSize >= xCli) or (xCent <=0) then
Step := -Step;
InvalidateRect(Handle,@rShape,True);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Ellipse(Canvas.Handle,5+xCent,29+yCent,15+xCent,39+yCent);
Ellipse(Canvas.Handle,25+xCent,29+yCent,35+xCent,39+yCent);
Rectangle(Canvas.Handle,2+xCent,19+yCent,37+xCent,29+yCent);
Rectangle(Canvas.Handle,17+xCent,0+yCent,23+xCent,19+yCent);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
Step := 2 ;
xCli := ClientRect.Right ;//div 2;
yCLi := ClientRect.Bottom div 2;
Invalidate;
end;

end.




Código:

object Form1: TForm1
  Left = 119
  Top = 268
  Width = 256
  Height = 85
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnPaint = FormPaint
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object Timer1: TTimer
    Interval = 5
    OnTimer = Timer1Timer
    Left = 32
    Top = 16
  end
end


seoane 12-08-2007 19:48:19

:D Excelente Ardilla, esto ya parecía un monologo.

ArdiIIa 12-08-2007 19:58:44

Este lo tenía de hace años, cuando empecé en Windows 3.1 y C

seoane 12-08-2007 20:31:39

Y siguiendo con los trucos para "aficionados" a la fotografía :rolleyes: Aquí dejo los pasos para ocultar un montón de fotografías a la vez.

Primero compactamos todas las fotografías en un solo archivo:
Código:

copy /b *.jpg fotos.pak
Y para terminar le ponemos un sombrero :D :
Código:

copy /b foto.jpg+fotos.pak oculto.jpg
Y os preguntareis, o quizá no :D, como desempaquetar la imágenes. Pues es sencillo, vais a mi pagina web :p , bajáis el código de JpegRecover, o el programa ya compilado, y tecleais algo como esto:
Código:

jpegrecover oculto.jpg %d.jpg

Caral 12-08-2007 22:10:11

Hola
Seoane, hay algunos de nosotros que hemos pensado en la posibilidad de hacer unos tutoriales y se nos presento una duda, ( Cuales son las preguntas mas expuestas en el club y de que temas).
Crees poder sacarte de la manga uno de tus programas algo asi como el Ejemplo44 ?
Nos seria de mucha utilidad y al club.
Te animas?.:)
Saludos

Ñuño Martínez 13-08-2007 07:56:38

Seoane, me has decepcionado: ¡Ese código es útil! :eek: :p :D

seoane 13-08-2007 12:29:05

Cita:

Empezado por Ñuño Martínez
Seoane, me has decepcionado: ¡Ese código es útil! :eek: :p :D

No tanto, no pasa de ser un truco para emergencias :)

Y aprovechando que se encuentra usted por aquí maestro Ñuño, no tiene ningún código que dejarnos ... :rolleyes:

Ñuño Martínez 13-08-2007 12:42:09

Cita:

Empezado por seoane
Y aprovechando que se encuentra usted por aquí maestro Ñuño, no tiene ningún código que dejarnos ... :rolleyes:

Pues tenía uno, pero ahora no lo encuentro. Tendré que reescribirlo. A ver si esta tarde saco tiempo antes de cenar y lo pongo por aquí.

Khronos 13-08-2007 15:33:02

Hola, esta weno este hilo. Me gustaria poner mi granito de arena aunque no sea nada en comparacion con el code de seoane :D
Con esta funcion puedes generar contraseñas con signos, letras, numeros..
No le veo utilidad ninguna pero a lo mejor les sirve:

Código Delphi [-]
function RandomWord(cifras: integer): string;
const
letras= 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; //tambien valen numeros, signos ...
   var
   i, u: integer;
  begin
   Randomize;
   for u:=1 to cifras do begin
     i:=Random(Length(Letras)) + 1;
    result:=result + Letras[i];
    end;
  end;



Para llamar a la funciona es sencillo:

Código Delphi [-]
showmessage(RandomWord(8)); //y te devuelve ocho letras

Salu2

ArdiIIa 14-08-2007 13:39:09

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.:D:D

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

seoane 14-08-2007 14:14:55

Cita:

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.:D:D

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

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 :p

Enan0 14-08-2007 14:46:48

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 :p
jaja Bueno saludos (no lo agrego) ya que no quiero saturar el server con basura :D

Neftali [Germán.Estévez] 14-08-2007 15:27:33

Cita:

Empezado por Enan0 (Mensaje 222874)
...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 14-08-2007 16:46:58

Cita:

Empezado por Neftali (Mensaje 222888)
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 :D

ArdiIIa 27-08-2007 13:35:09

1 Archivos Adjunto(s)
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 :D:D:D
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,'&amp;','&',[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 27-08-2007 13:59:23

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

seoane 27-08-2007 14:01:46

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

Código PHP:

unit UnitMain;

interface

uses
  Windows
SysUtils,  ClassesForms,Dialogs,  IdComponentIdTCPConnection,
  
IdHTTPIdCookieManagerIdBaseComponentExtCtrlsStdCtrlsControls,
  
IdTCPClient;

type
  TFormMain 
= class(TForm)
    
IdCookieManager1TIdCookieManager;
    
IdHTTPTIdHTTP;
    
Memo1TMemo;
    
Panel1TPanel;
    
Label1TLabel;
    
Edit1TEdit;
    
Label2TLabel;
    
Edit2TEdit;
    
Button1TButton;

    
procedure IdHTTPStatus(ASenderTObject; const AStatusTIdStatus; const AStatusTextString);
    
procedure Conectar;
    
procedure Extraer(Url String);
    
procedure Button1Click(SenderTObject);

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

var
  
FormMainTFormMain;
  
Perfil Integer;

implementation

{$R *.dfm}

procedure TFormMain.IdHTTPStatus(ASenderTObject;  const AStatusTIdStatus; const AStatusTextString);
begin
//Memo1.Lines.Add(AStatusText)
end;


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



procedure TFormMain.Conectar;
var
  
CamposTStringlist;
  
RespuestaTStringStream;
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;
  
Integer;
  
Desde Longitud Integer;
  
cTemp String;
Begin

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

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

    
//Procesar la salida
    
For := 0 to Contenido.Count -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,'&amp;','&',[rfReplaceAll]);
        
End;

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

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

      if 
Pos('Viendo Perfil de Usuario' ,Trim(Contenido[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
Código:

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


ArdiIIa 27-08-2007 14:04:24

Cita:

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

Solamente lo creés ??

Yo creo que si queda mejor...:D:D

BlackDaemon 27-08-2007 20:27:17

Aquí una función que convierte cifras numéricas a texto..
(lo saque de de una lista de correo)
Aunque no es exactamente inservible, por que hay componente que hacen lo mismo (Creo)

Código Delphi [-]
 function Letras( nNumero: Extended ): string;
const
  Y        = 'y '       ;
  F        = 'as '      ;
  M        = 'os '      ;
  MIL      = 'mil '     ;
  MILLON   = 'millón '  ;
  MILLONES = 'millones ';
  BILLON   = 'billón '  ;
  BILLONES = 'billones ';
var
  cEnLetra : string;
  cNumStr  : string;
  cUnidad  : string;
  cDecena  : string;
  cCentena : string;
  cDecStr  : string;
  cAux     : string;
  nGrupo   : Integer;
  aGrupos  : Array[1..5] of string;
  //**************************************************************************//
  function Decena( n1,n2: integer ): string;
  begin
    result := '';
    if ( n1 = 2 ) and ( n2 = 1 ) then
      if ( cUnidad = '0' ) then
        result := 'diez '
      else
        result := '';
    if n1 = 2 then
      case n2 of
         2: result := 'once ';
         3: result := 'doce ';
         4: result := 'trece ';
         5: result := 'catorce ';
         6: result := 'quince ';
         7: result := 'dieciseis ';
         8: result := 'diecisiete ';
         9: result := 'dieciocho ';
        10: result := 'diecinueve ';
      end;
    if ( n1 = 3 ) then
      if  ( cUnidad = '0' ) then
        result := 'veinte '
      else
        result := 'veinti';
    if ( n1 = 4 ) then
      if ( cUnidad <> '0' ) then
        result := 'treinta ' + Y
      else
        result := 'treinta ';
    if ( n1 = 5 ) then
      if ( cUnidad <> '0' ) then
        result := 'cuarenta ' + Y
      else
        result := 'cuarenta ';
    if ( n1 = 6 ) then
      if ( cUnidad <> '0' ) then
        result := 'cincuenta ' + Y
      else
        result := 'cincuenta ';
    if ( n1 = 7 ) then
      if ( cUnidad <> '0' ) then
        result := 'sesenta ' + Y
      else
        result := 'sesenta ';
    if ( n1 = 8 ) then
      if ( cUnidad <> '0' ) then
        result := 'setenta ' + Y
      else
        result := 'setenta ';
    if ( n1 = 9 ) then
      if ( cUnidad <> '0' ) then
        result := 'ochenta ' + Y
      else
        result := 'ochenta ';
    if ( n1 = 10 ) then
      if ( cUnidad <> '0' ) then
        result := 'noventa ' + Y
      else
        result := 'noventa ';
  end;
  //**************************************************************************//
  function Unidad    ( n    : integer ): string;
  var
    sNumero : Array [3..10] of string;
  begin
    result := '';
    sNumero[3] := 'dos '  ; sNumero[4] := 'tres '; sNumero[5] := 'cuatro ';
    sNumero[6] := 'cinco '; sNumero[7] := 'seis '; sNumero[8] := 'siete ';
    sNumero[9] := 'ocho ' ; sNumero[10] := 'nueve ';
    case n of
       1: if ( nNumero = 0 ) and ( nGrupo = 1 ) then
            result := 'cero';
       2: if ( cDecena = '1' ) then
            result := Decena( 2, StrToInt( cUnidad ) + 1 )
          else if ( aGrupos[nGrupo] = '001' ) and ( (nGrupo = 2 ) or ( nGrupo = 4 )) then
            result := ''
          else if ( nGrupo = 2 ) or ( nGrupo = 3 ) then
            result := 'un '
          else
            result := 'uno ';
       3..10: if ( cDecena = '1' ) then
            result := Decena( 2, StrToInt( cUnidad ) + 1 )
          else
            result := sNumero[n];
    end;
  end;
  //**************************************************************************//
  function Centena   ( n1   : integer ): string;
  begin
    result := '';
    case n1 of
       1: result := '';
       2: if ( cDecena + cUnidad ) = '00' then
            result := 'cien '
          else
            result := 'ciento ';
       3: result := 'doscientos ';
       4: result := 'trescientos ';
       5: result := 'cuatrocientos ';
       6: result := 'quinientos ';
       7: result := 'seiscientos ';
       8: result := 'setecientos ';
       9: result := 'ochocientos ';
      10: result := 'novecientos ';
    end;
  end;
  //**************************************************************************//
  function Conector( n1   : integer ): string;
  begin
    result := '';
    case n1 of
      1: result := '';
      2,4: if aGrupos[n1] > '000' then
          result := MIL;
      3: if ( aGrupos[3] > '000' ) or ( aGrupos[4] > '000' ) then
          if aGrupos[3] = '001' then
            result := MILLON
          else
            result := MILLONES;
      5: if ( aGrupos[5] > '000' ) then
          if aGrupos[5] = '001' then
            result := BILLON
          else
            result := BILLONES;
    end;
  end;
  //**************************************************************************//
begin
  cAux := Format( '%15.2f',[nNumero] );
  cNumStr := Trim(Format( '%15.15d',[Trunc(nNumero)] ));
  if nNumero - Trunc( nNumero ) = 0 then
    cDecStr := ''
  else
    cDecStr := 'con '+Copy( cAux,Length(cAux)-1,2)+'/100';
  for nGrupo := 1 to 5 do
    aGrupos[5-nGrupo+1] := Copy( cNumStr, (nGrupo - 1) * 3 + 1, 3);
  cEnLetra := '';
  for nGrupo := 5 downto 1 do
  begin
    cUnidad  := Copy( aGrupos[nGrupo],Length(aGrupos[nGrupo]),1);
    cDecena  := Copy( aGrupos[nGrupo], 2, 1 );
    cCentena := Copy( aGrupos[nGrupo], 1, 1 );
    //Componer la cifra en letra del grupo en curso.
    cEnLetra := cEnLetra + Centena ( StrToInt( cCentena ) + 1    ) +
                           Decena  ( StrToInt( cDecena  ) + 1, 1 ) +
                           Unidad  ( StrToInt( cUnidad  ) + 1    ) +
                           Conector( nGrupo                      );
  end;
  if Copy( cEnLetra, 1, 3 ) = 'mil' then
    result := 'un ' + cEnLetra + cDecStr
  else
    result := cEnLetra + cDecStr;
end;


saludos!

PD si no esta permitido este tipo de códigos quitadlo, solo quería colaborar.

seoane 27-08-2007 22:58:31

Cita:

Empezado por BlackDaemon (Mensaje 226354)
Aunque no es exactamente inservible, por que hay componente que hacen lo mismo

No es lo mismo inútil que inservible. Inútil es que no tiene utilidad, o no se le conoce, mientras que inservible es que no funciona :p :D
Cita:

Empezado por BlackDaemon (Mensaje 226354)
PD si no esta permitido este tipo de códigos quitadlo, solo quería colaborar.

No veo por que no, siempre que al autor del código no le importe. Aunque no estaría mal que citaras el sitio donde la encontraste.

ContraVeneno 27-08-2007 23:00:56

tanto que batallé en el pasado y ahora en el club delphi he visto 3 funciones diferentes para convertir de números a letras. :D

BlackDaemon 27-08-2007 23:59:25

Cita:

No veo por que no, siempre que al autor del código no le importe. Aunque no estaría mal que citaras el sitio donde la encontraste.
Pues una lista del grupo albor, y no se, desconozco quien haya sigo el creador de dicho código, me agarro los créditos xDD :D

saludos!

Casimiro Notevi 28-08-2007 08:52:14

Esa función de número a letras la escribió Carlos García Trujillo

************* Numero a Letra Versión 1.5 *****************
_________________________________________________________

Autor : Carlos García Trujillo
E-mail: cgar1136 @ yahoo.com
cgar1136 @ latinmail.com
http://www.geocities.com/ResearchTriangle/Node/2174/
_________________________________________________________
26 de Abril de 1999
Xalapa, Veracruz; México.

ArdiIIa 28-08-2007 09:02:15

Cita:

Empezado por Casimiro Notevi (Mensaje 226457)
Esa función de número a letras la escribió Carlos García Trujillo

Pues le va a encantar ver su código en una sección de codigo sin utilidad..:D
[casi broma]
Por cierto: Tengo un ERP de una empresa que podría ir todo él en esta sección, pero el hilo dejaría de ser visitado... :D
[/casi broma]

seoane 10-09-2007 16:38:23

1 Archivos Adjunto(s)
No se si hay alguien que todavía lea este hilo, pero yo sigo poniendo código, por si a alguien le interesa :p

La aplicación de hoy es un "Password hasher", que básicamente genera un password a partir de una etiqueta y una clave, bueno en realidad genera dos, una de ocho letras y otra diez.

Te preguntaras que utilidad tiene esto, pues muy simple, imagínate que necesitas utilizar contraseñas para acceder a 10 sitios de internet diferentes. Tienes varias alternativas, utilizar la misma contraseña en todos, lo cual no te recomiendo, o recordar 10 contraseñas diferentes. Este programa nos da otra tercera opción, recordar solo una clave (la que utilizamos en el programa), y generar una contraseña diferente para cada sitio, utilizando como "etiquetas" los nombres o direcciones de cada sitio.

Por ejemplo:
Código:

Sitio/etiqueta = clubdelphi.com
Clave=secreto
Hash generado -> Fu68DwJq / u6zSIXzd7v

Ventajas
  • Las contraseñas no se guardan en ningún sitio
  • Las contraseñas generadas son muy seguras
  • Solo hay que recordar una contraseña

PD: El algoritmo para generar las contraseñas se discutió en este hilo, ahí encontrarás otros algoritmos alternativos.

dec 10-09-2007 17:21:17

Hola,

Está muy curioso Domingo. Sin embargo hay algo que no termino de comprender bien. Con una "clave" (URL de un sitio Web, por ejemplo) y una "contraseña", se genera un "Hash"... o dos "Hash"... ¿por qué se parte en dos "lo que se genera"? ¿Y cuál de los dos "trozos" se supone que habría que usar? No lo entiendo... :( ;)

seoane 10-09-2007 17:40:29

Cita:

Empezado por dec (Mensaje 229714)
Sin embargo hay algo que no termino de comprender bien. Con una "clave" (URL de un sitio Web, por ejemplo) y una "contraseña", se genera un "Hash"... o dos "Hash"... ¿por qué se parte en dos "lo que se genera"? ¿Y cuál de los dos "trozos" se supone que habría que usar? No lo entiendo... :( ;)

Se generan dos por el precio de una :p

La primera (la de la izquierda) se genera utilizando md5 y tiene una longitud de 8 caracteres, las segunda se genera usando sha1 y tiene una longitud de 10 caracteres. Puedes usar la que prefieras, o juntar las dos, eso depende de la longitud de contraseña que necesites.

dec 10-09-2007 17:44:26

Hola,

Hum... ahora lo pillo entonces. Pues oyes, está bien. El asunto es que tengo una carpeta llena de subcarpetas con todas las contraseñas de sitios Web a los que me he registrado desde no se sabe cuándo muchos de ellos.

Y a veces he pensado en hacer algo con Delphi, algún programilla, porque, todos los que he visto por ahí... chico, no sé, unos por una cosa, otros por otra... son programas estupendos, pero, no me quedan a gusto.

Y bueno. Ese tercer "sistema" que has empleado para conseguir contraseñas me ha parecido curioso. Va a ser al final que no todo el código de este hilo es inútil del todo. :D :D


La franja horaria es GMT +2. Ahora son las 04:09:57.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi