Utilizamos cookies propias y de terceros. Al navegar entendemos que aceptas el uso de cookies. +Info.
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Proponer
· Temas
· Top 10
· Trucos
· Tutoriales
· Usuario
· Wiki

Nick


Contraseña


Nuevo usuario


English

Delphi: Cómo hacer robot indexación páginas web Delphi AjpdSoft Capturador páginas web
AjpdSoft


Tutorial donde explicamos paso a paso cómo desarrollar una aplicación semejante a un robot de indexación de páginas web. Mostramos cómo realizar una aplicación en Delphi 6 y base de datos Paradox para acceder a páginas web (especificando la URL o la IP), obtener el contenido HTML y guardarlo en una base de datos. Es el fundamento de los motores de búsqueda como Google, Bing, Yahoo, etc..

Robot de indexación de contenidos web

Un robot de indexación de contenidos web suele ser un conjunto de equipos informáticos, en el caso de buscadores como Google, Yahoo, Bing suelen ser miles e incluso cientos de miles, que están continuamente buscando páginas web mediante varios mecanismos (recorriendo IPs, recorriendo URL de otros sitios web ya indexados, a petición del usuario, etc. Obtienen el contenido de dichas páginas web y lo almacenan en una base de datos. De esta forma cuando el usuario introduce alguna palabra o palabras en un buscador, este accede a su base de datos y muestra los resultados por relevancia.

El proceso de un robot es un poco más complejo de lo indicado anteriormente, si bien su tarea principal es la de capturar y almacenar información para futuras búsquedas.

Existen muchos tipos de robot en función del tipo de buscador que los implemente. A continuación mostramos las características principales de los buscadores jerárquicos (arañas o spiders) que suelen ser los que usan los robots para retroalimentar sus bases de datos:

  • Las arañas (también llamadas "spiders") de los motores de búsqueda, recorren las páginas recopilando información sobre los contenidos de las páginas. Cuando se busca una información concreta en los buscadores, ellos consultan su base de datos y presentan resultados clasificados por su relevancia para esa búsqueda concreta. Los buscadores pueden almacenar en sus bases de datos desde la página de entrada de cada web, hasta todas las páginas que residan en el servidor, una vez que las arañas (spiders) las hayan reconocido e indexado.
  • Si se busca una palabra, en los resultados que ofrecerá el motor de búsqueda aparecerán páginas que contengan esta palabra en alguna parte de su texto de contenido.
  • Si consideran que un sitio web es importante para el usuario, tienden a registrar todas sus páginas. Si no la consideran importante, no se almacenan todas.
  • Cada cierto tiempo, los motores revisan los sitios web, para actualizar los contenidos de su base de datos, por tanto puede que los resultados de la búsqueda estén desactualizados.
  • Los buscadores jerárquicos tienen una colección de programas simples y potentes con diferentes cometidos. Se suelen dividir en tres partes. Los programas que exploran la red -arañas (spiders)-, los que construyen la base de datos y los que utiliza el usuario, el programa que explota la base de datos.
  • Si se paga, se puede aparecer en las primeras posiciones de resultados, aunque los principales buscadores delimitan estos resultados e indican al usuario que se trata de anuncios (resultados esponsorizados o patrocinados). Hasta el momento, aparentemente, esta forma de publicidad es indicada explícitamente. Los buscadores jerárquicos se han visto obligados a comercializar este tipo de publicidad para poder seguir ofreciendo a los usuarios el servicio de forma gratuita.

 

Cómo hacer un robot de indexación de contenidos web casero con Delphi y Paradox

A continuación mostramos los pasos para desarrollar una aplicación que accederá a las páginas web previamente indicadas (por URL o por rango de IP), obtendrá su contenido HTML y lo guardará en base de datos para su posterior explotación.

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

En primer lugar crearemos la tabla de la base de datos Paradox que contendrá la información capturada o indexada por la aplicación. Dicha tabla "capturas.DB" está disponible ya creada en la descarga gratuita de la aplicación completa con código fuente AjpdSoft Capturador de páginas web.

Si queremos crearla manualmente, usaremos Borland Database Desktop, una aplicación "antigua" pero aún funcional que nos permitirá crear tablas Paradox. Podemos descargarla desde la URL:

No necesita instalación, la descargaremos desde la URL anterior, descomprimiremos el fichero "bdd.zip" y ejecutaremos el fichero "DBD32.EXE", en equipos con Windows Vista, Windows 7 y Windows 8 puede mostrar un mensaje como el siguiente, pulsaremos en "Ejecutar programa":

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

Con el texto: Asistente para la compatibilidad de programas. Este programa tiene problemas de compatibilidad conocidos. Busque si hay una solución en línea en el sitio web de Microsoft. Si se encuentra una solución, Windows mostrará automáticamente un sitio web con los pasos que puede seguir. Borland Delphi 7.0 no es compatible con esta versión de Windows. Para obtener más información póngase en contacto con Borland.

Nos mostrará otro error que aceptaremos pulsando en "Aceptar":

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

Con el texto: Private directory is invalid or undefined. Using temporary directory instead.

Si nos aparece este otro error:

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

Con el texto: Could not initialize BDE. File or directory does not exist.

Es debido a que o bien no tenemos instalado el BDE (Borland Database Engine) o bien estamos ejecutando la aplicación Borland Database Desktop en una carpeta y subcarpeta demasiado larga, en este caso copiaremos la carpeta de Database Desktop a una carpeta del tipo:

C:/DatabaseDesktop

Si no tenemos instalado el BDE (Borland Database Engine) podremos instalarlo siguiendo los pasos de este tutorial:

Una vez abierto Database Desktop, pulsaremos en el menú "File" - "New" - "Table":

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

Elegiremos "Paradox 7" en "Table type" y pulsaremos "OK":

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

Añadiremos todos los campos para la tabla "capturas.DB" con su tipo de datos, como se muestra en las dos imágenes siguientes:

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

Guardaremos pulsando en "Save As":

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

Indicaremos la carpeta y nombre del fichero que contendrá la tabla para almacenar las web indexadas, en nuestro caso "capturas.DB":

Crear tabla en base de datos Paradox para almacenar las páginas web indexadas con Database Desktop

Nota: la tabla "capturas.DB" está disponible ya creada en la descarga gratuita de la aplicación completa con código fuente AjpdSoft Capturador de páginas web.

 

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Abriremos Delphi 6, crearemos un nuevo proyecto de tipo Application, desde el menú "File" - "New" - "Application". Esta aplicación completa con código fuente está disponible gratuitamente en la descarga:

En el primer formulario que se crea automáticamente añadiremos los siguientes componentes:

  • PageControl: contenedor para albergar el resto de componentes en pestañas o solapas.

En la primera pestaña del PageControl, en "Capturar" añadiremos los siguientes componentes:

  • Button: para "Iniciar captura" y para "Cancelar captura".
  • Memo: para mostrar el log de resultados de indexación de páginas.
  • ProgressBar: para mostrar el progreso de la indexación.
  • StatusBar: para mostrar algunos resultados e información de progreso.

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

En la segunda pestaña del PageControl, "Configurar", añadiremos los siguientes componentes:

  • CheckBox: para la pestaña de configuración, para establecer el método de búsqueda de sitios web, por IP, por URL, para guardar log con el resultado y para volver a capturar las páginas ya indexadas en base de datos.
  • Edit: para introducir la IP desde y la IP hasta a recorrer por el indexador.
  • Memo: para almacenar las páginas web a capturar o indexar.

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

En la tercera solapa o pestaña del PageControl, "Datos capturados" añadiremos los siguientes componentes:

  • DBNavigator: barra de botones que irá enlazada con la tabla "capturas" para desplazarnos por los registros (siguiente, anterior, primero, último, eliminar, editar, refrescar, cancelar).
  • DBGrid: para mostrar los datos indexados en la tabla "capturas" en una rejilla de datos.
  • Button: para "Abrir BD", "Visualizar HTML" y "Visualizar".
  • Table, DataSource, Query: componentes no visibles para enlace con tabla "capturas" y para inserción de registro nuevo.

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Enlazaremos los componentes de acceso a base de datos Paradox no visuales entre ellos, los Table con los DataSource mediante la propiedad DataSet del DataSource:

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

En los Table, en la propiedad DatabaseName añadiremos la ubicación (ruta, carpeta) donde guardaremos el fichero "capturas.db" con la tabla creada anteriormente. En la propiedad TableName de los Table indicaremos el nombre del fichero "capturas.DB". De esta forma enlazaremos los componentes no visuales a la tabla Paradox:

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Pulsando sobre el Table con el botón derecho del ratón y seleccionando "Fields Editor" podremos añadir los campos de la tabla "capturas":

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Pulsaremos con el botón derecho sobre la ventana que se abre y seleccionaremos "Add all fields":

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Una vez añadidos los campos podremos editar sus propiedades y establecer el DisplayLabel (título) y el DisplayWidth (tamaño):

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

 

Por último enlazaremos los componentes visuales DBNavigator y DBGrid a los no visuales de acceso a datos mediante la propiedad DataSource del DBGrid y del DBNavigator:

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Pulsando con el botón derecho del ratón sobre el DBGrid y eligiendo "Add All Fields":

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

De esta forma quedarán los campos añadidos al DBGrid y podremos elegir en qué posición aparecerán y lo que queramos ocultar o mostrar:

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Añadiremos una unidad donde introduciremos los procedimientos de captura de página web mediante TidHTTP y otros que necesitaremos para la aplicación, para ello pulsaremos en el menú "File" - "New" - "Unit":

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Introduciremos el nombre para la nueva unidad y la guardaremos. Añadiremos el código fuente que indicamos aquí:

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Añadiremos también un formulario para mostrar el código HTML indexado del registro seleccionado, para ello pulsaremos en "File" - "New" - "Form":

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

Este formulario solo contendrá un Memo donde mostraremos el contenido HTML de una web indexada:

Desarrollar aplicación Delphi para indexar páginas web y almacenar el HTML en base de datos Paradox

 

El código fuente de la unidad principal está disponible aquí. Y la descarga de la aplicación completa con el código fuente gratuito en Delphi 6:

 

AjpdSoft Capturador de páginas web en funcionamiento - Código fuente completo gratuito en Delphi 6

A continuación mostramos el funcionamiento de AjpdSoft Capturador de páginas web, en primer lugar en la pestaña "Configurar" deberemos especificar el rango de IPs a indexar o bien las URL a indexar o ambos métodos a la vez:

AjpdSoft Capturador de páginas web en funcionamiento - Código fuente completo gratuito en Delphi 6

Una vez especificadas las URL/IP en la pestaña "Capturar" pulsaremos en "Iniciar captura", la aplicación AjpdSoft Capturador de páginas web navegará a cada URL/IP especificada y obtendrá el contenido HTML y lo guardará en una base de datos:

AjpdSoft Capturador de páginas web en funcionamiento - Código fuente completo gratuito en Delphi 6

En la pestaña "Datos capturados", pulsando "Abrir BD", podremos consultar los datos capturados/indexados por AjpdSoft Capturador de páginas web:

AjpdSoft Capturador de páginas web en funcionamiento - Código fuente completo gratuito en Delphi 6

Si quieremos ver el contenido HTML capturado de un registro concreto lo seleccionaremos y pulsaremos en "Visualizar HTML". Si queremos visualizar el HTML en un navegador web pulsaremos en "Visualizar":

AjpdSoft Capturador de páginas web en funcionamiento - Código fuente completo gratuito en Delphi 6

Como vemos AjpdSoft Capturador de páginas web es un sencillo ejemplo de cómo desarrollar una aplicación similar a un robot de indexación de páginas web como los usados por Google, Yahoo, Bing, etc. Esta aplicación servirá de ejemplo para desarrolladores. Está en fase Beta y está descontinuada, pero es útil para realizar pruebas y como base para realizar otras aplicaciones.

 

Anexo

  • Código fuente unidad UnidadProcedimientos.pas:
unit UnidadProcedimientos;

interface

function ObtenerWeb(webIP : string) : string;
function obtenerURLdeIP (ip : string) : string;
function obtenerEtiqueta (contenidoWeb : string; etiquetaIni : string;
    etiquetaFin : string) : string;
function obtenerIPdeURL (url : string) : string;

var
  errorCaptura : string;
  numErrores : double;
  numAciertos : double;

implementation


uses  IdHTTP, Classes, Sockets, SysUtils;


//Obtener IP pública pc local
function ObtenerWeb(webIP : string) : string;
var
  obtenerHTTP : TidHTTP;
  web : TStringList;
begin
  errorCaptura := '';
  web := TStringList.Create;
  obtenerHTTP := TidHTTP.Create(nil);
  try
    web.Text := obtenerHTTP.Get('http://' + webIP);
    numAciertos := numAciertos + 1;
  except
    on e: exception do
    begin
      errorCaptura := e.Message;
      numErrores := numErrores + 1;
      obtenerHTTP.Free;
    end;
  end;
  ObtenerWeb := web.Text;
end;

function obtenerTagWeb (contenido : string) : string;
begin
//
end;

//obtiene la URL de una IP
function obtenerURLdeIP (ip : string) : string;
var
  ctURL : TTcpServer;
begin
  ctURL := TTCPServer.Create (nil);
  obtenerURLdeIP := ctURL.LookupHostName (ip);
end;

//obtiene la IP de una URL
function obtenerIPdeURL (url : string) : string;
var
  ctURL : TTcpServer;
begin
  ctURL := TTCPServer.Create (nil);
  obtenerIPdeURL := ctURL.LookupHostAddr (url);
end;

function obtenerEtiqueta (contenidoWeb : string; etiquetaIni : string;
   etiquetaFin : string) : string;
var
  lineas : TStringList;
  i : integer;
  titulo, lineaActual : string;
begin
  lineas := TStringList.Create;
  lineas.Text := contenidoWeb;
  titulo := '';
  etiquetaIni := AnsiUpperCase(etiquetaIni);
  etiquetaFin := AnsiUpperCase(etiquetaFin);
  for i := 0 to lineas.Count - 1 do
  begin
    lineaActual := lineas.Strings[i];
    //si encuentra las dos etiquetas en la misma línea
    if (Pos (etiquetaIni, AnsiUpperCase(lineaActual)) <> 0)
        and (Pos (etiquetaFin, AnsiUpperCase(lineaActual)) <> 0)then
    begin
      titulo := copy (lineaActual,
          Pos (etiquetaIni, AnsiUpperCase(lineaActual)) + length (etiquetaIni),
          Pos (etiquetaFin, AnsiUpperCase(lineaActual)) - length (etiquetaFin) - 1);
      Break;
    end;
    //si en la línea sólo aparece el inicio del título
    if (Pos (etiquetaIni, AnsiUpperCase(lineaActual)) <> 0)
        and (Pos (etiquetaFin, AnsiUpperCase(lineaActual)) = 0)then
    begin
      titulo := copy (lineaActual, Pos (etiquetaIni,
         AnsiUpperCase(lineaActual)), length(lineaActual));
    end;
    //si en la línea sólo aparece el fin del título
    if (Pos (etiquetaIni, AnsiUpperCase(lineaActual)) = 0) and
        (Pos (etiquetaFin, lineaActual) <> 0)then
    begin
      titulo := titulo + copy (lineaActual,
          Pos (etiquetaFin, AnsiUpperCase(lineaActual)), length(lineaActual));
      break;
    end;
  end;
  obtenerEtiqueta := titulo;
end;

end.

  • Código fuente unidad UnidadMenuPrincipal.pas:

unit UnidadMenuPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ActnList, DB, DBTables, ExtCtrls,
  DBCtrls,  
  IdBaseComponent, IdComponent, shellapi, Grids, DBGrids;

type
  TformMenuPrincipal = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    be: TStatusBar;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    bIniciarCaptura: TButton;
    ActionList1: TActionList;
    actIniciarCaptura: TAction;
    tTabla: TTable;
    dBD: TDataSource;
    tTablaIP: TStringField;
    tTablaURL: TStringField;
    tTablaContenido: TMemoField;
    tTablaFechaInicial: TDateField;
    tTablaFechaUltimaCaptura: TDateField;
    tTablaNumeroCapturas: TFloatField;
    tTablaValoracion: TFloatField;
    tTablaTitle: TStringField;
    tTablaAUTHOR: TStringField;
    tTablaCOPYRIGHT: TStringField;
    tTablaKEYWORDS: TMemoField;
    tTablaGENERATOR: TStringField;
    tTablaROBOTS: TStringField;
    tTablaREVISIT: TStringField;
    Label6: TLabel;
    txtD1: TEdit;
    Label3: TLabel;
    txtD2: TEdit;
    Label5: TLabel;
    txtD3: TEdit;
    Label7: TLabel;
    txtD4: TEdit;
    txtH4: TEdit;
    Label11: TLabel;
    txtH3: TEdit;
    Label10: TLabel;
    txtH2: TEdit;
    Label9: TLabel;
    txtH1: TEdit;
    Label8: TLabel;
    txtWebEspecificas: TMemo;
    tTablaHoraUltimaCaptura: TTimeField;
    tTablaError: TStringField;
    tTablaInsertar: TTable;
    dBDInsertar: TDataSource;
    tTablaInsertarIP: TStringField;
    tTablaInsertarURL: TStringField;
    tTablaInsertarTitle: TStringField;
    tTablaInsertarAUTHOR: TStringField;
    tTablaInsertarCOPYRIGHT: TStringField;
    tTablaInsertarKEYWORDS: TMemoField;
    tTablaInsertarGENERATOR: TStringField;
    tTablaInsertarROBOTS: TStringField;
    tTablaInsertarREVISIT: TStringField;
    tTablaInsertarContenido: TMemoField;
    tTablaInsertarFechaInicial: TDateField;
    tTablaInsertarFechaUltimaCaptura: TDateField;
    tTablaInsertarHoraUltimaCaptura: TTimeField;
    tTablaInsertarNumeroCapturas: TFloatField;
    tTablaInsertarValoracion: TFloatField;
    tTablaInsertarError: TStringField;
    opCapturarEspecificas: TCheckBox;
    opCapturarIPs: TCheckBox;
    Button1: TButton;
    actCancelarCaptura: TAction;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    DBNavigator1: TDBNavigator;
    Button2: TButton;
    tConsulta: TQuery;
    bp: TProgressBar;
    actAbrirBD: TAction;
    tabla: TDBGrid;
    actVisualizar: TAction;
    actVisualizarHTML: TAction;
    Button3: TButton;
    Button4: TButton;
    GroupBox4: TGroupBox;
    opGuardarLog: TCheckBox;
    opCapturarBD: TCheckBox;
    txtLog: TMemo;
    LWEB: TLabel;
    procedure actIniciarCapturaExecute(Sender: TObject);
    procedure txtD1Change(Sender: TObject);
    procedure txtD1KeyPress(Sender: TObject; var Key: Char);
    procedure txtD2Change(Sender: TObject);
    procedure txtD2KeyPress(Sender: TObject; var Key: Char);
    procedure txtD3Change(Sender: TObject);
    procedure txtD3KeyPress(Sender: TObject; var Key: Char);
    procedure txtD4Change(Sender: TObject);
    procedure txtD4KeyPress(Sender: TObject; var Key: Char);
    procedure txtH4Exit(Sender: TObject);
    procedure txtH4KeyPress(Sender: TObject; var Key: Char);
    procedure insertarWeb (webCaptura : string; IPCaptura : string);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure actCancelarCapturaExecute(Sender: TObject);
    procedure actAbrirBDExecute(Sender: TObject);
    procedure actVisualizarExecute(Sender: TObject);
    procedure actVisualizarHTMLExecute(Sender: TObject);
    procedure LWEBClick(Sender: TObject);
  private
    { Private declarations }
    cancelarProceso : boolean;
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;


implementation

uses UnidadProcedimientos, UnidadVisualizador, UnidadVisualizacion;


{$R *.dfm}

procedure TformMenuPrincipal.insertarWeb (webCaptura : string;
    IPCaptura : string);
var
  contenidoWeb : string;
  eqTitle, eqKeywords, eqCopyright : string;
  numero : double;
begin
  contenidoWeb := ObtenerWeb(webCaptura);
  if contenidoWeb <> '' then
  begin
    if tTablaInsertar.Locate('IP', IPCaptura, []) then
    begin
      tTablaInsertar.edit;
      if not varisnull(tTablaInsertarNumeroCapturas.Value) then
      begin
        numero := tTablaInsertarNumeroCapturas.value;
        numero := numero + 1;
        tTablaInsertarNumeroCapturas.Value := numero;
      end
      else
        tTablaInsertarNumeroCapturas.Value := 1;
    end
    else
    begin
      tTablaInsertar.Insert;
      tTablaInsertarNumeroCapturas.Value := 1;      
      tTablaInsertarIP.Value := IPCaptura;
    end;
    eqTitle := obtenerEtiqueta (contenidoWeb, '', '');
    eqKeywords := obtenerEtiqueta (contenidoWeb,
        '');
    eqCopyright := obtenerEtiqueta (contenidoWeb,
        '');
    tTablaInsertarURL.Value := webCaptura;
    tTablaInsertarContenido.Value := contenidoWeb;
    tTablaInsertarFechaInicial.Value := date;
    tTablaInsertarFechaUltimaCaptura.Value := date;
    tTablaInsertarHoraUltimaCaptura.Value := time;    
    tTablaInsertarTitle.Value := eqTitle;
    tTablaInsertarKEYWORDS.Value := eqKeywords;
    tTablaInsertarCOPYRIGHT.Value := eqCopyright;
    tTablaInsertarError.Value := errorCaptura;
    tTablaInsertar.Post;
  end
  else
  begin
    if tTablaInsertar.Locate('IP', IPCaptura, []) then
      tTablaInsertar.edit
    else
      tTablaInsertar.Insert;
    tTablaInsertarIP.Value := IPCaptura;
    tTablaInsertarURL.Value := webCaptura;
    tTablaInsertarContenido.Value := '';
    tTablaInsertarFechaInicial.Value := date;
    tTablaInsertarFechaUltimaCaptura.Value := date;
    tTablaInsertarHoraUltimaCaptura.Value := time;
    tTablaInsertarTitle.Value := '';
    tTablaInsertarKEYWORDS.Value := '';
    tTablaInsertarError.Value := errorCaptura;
    tTablaInsertar.Post;
  end;
end;


procedure TformMenuPrincipal.actIniciarCapturaExecute(Sender: TObject);
var
  i : integer;
  ipCapturar, url : string;
begin
  cancelarProceso := false;
  numErrores := 0;
  numAciertos := 0;
  actCancelarCaptura.Enabled := true;
  if opCapturarBD.Checked then
  begin
    tTablaInsertar.Open;
    tConsulta.Close;
    tConsulta.SQL.Clear;
    tConsulta.SQL.Add('SELECT URL, IP FROM Capturas');
    tConsulta.Open;
    bp.Min := 1;
    bp.Max := tConsulta.RecordCount;
    while not tConsulta.Eof do
    begin
      Application.ProcessMessages;
      bp.Position :=  tConsulta.RecNo;
      bp.Refresh;
      be.Panels[0].Text := 'Capturando Web BD ' +
          inttostr(tConsulta.RecNo) +  '/' +
          IntToStr(tConsulta.RecordCount);
      be.Refresh;
      if cancelarProceso then
        Break;
      if not varisnull(tConsulta.fieldbyname('URL').Value) then
        url := tConsulta.fieldbyname('URL').Value
      else
        url := '';
      ipCapturar := tConsulta.fieldbyname('IP').Value;
      if url <> '' then
      begin
        if Pos ('http://', url) <> 0 then
          url := copy (url, 8, length (url));
        if Pos ('https://', url) <> 0 then
          url := copy (url, 9, length (url));
        if url <> '' then
        begin
          be.panels[1].text := 'Obteniendo contenido web: ' + url;
          be.Refresh;
          ipCapturar := obtenerIPdeURL (url);
          if ipCapturar <> '' then
          begin
            insertarWeb (url, ipCapturar);
            if errorCaptura <> '' then
              txtLog.Lines.Add(datetostr(date) + timetostr(time) +
                  ' IP ' + ipCapturar + ' URL: ' + url +
                  '  -> Error: ' + errorCaptura)
            else
              txtLog.Lines.Add(datetostr(date) + timetostr(time) +
                  ' IP ' + ipCapturar + ' URL: ' + url + '  -> Correcto');
            be.Panels[2].Text := 'E: ' + floattostr(numErrores) +
                ' C: ' + floattostr(numAciertos);
            be.Refresh;
          end;
        end;
      end;
      tConsulta.Next;
    end;
  end;

  if opCapturarIPs.Checked then
  begin
    tTablaInsertar.Open;
    if txtD1.Text <> '' then
    begin
      //obtenemos las webs del rango de ips especificado
      for i := strtoint(txtD4.Text) to strtoint (txtH4.Text) do
      begin
        Application.ProcessMessages;
        //be.Panels[0].Text := 'Capturando IP ' + inttostr() +
        //    IntToStr(tConsulta.RecordCount);
        //be.Refresh;
        if cancelarProceso then
          Break;
        ipCapturar := txtD1.Text + '.' + txtD2.Text + '.' +
            txtD3.Text + '.' + IntToStr(i);
        be.panels[1].text := 'Obteniendo contenido web: ' + ipCapturar;
        be.Refresh;
        if ipCapturar <> '' then
        begin
          be.panels[1].text := 'Obteniendo contenido web: ' + ipCapturar;
          be.Refresh;
          url := '';
          url := obtenerURLdeIP(ipCapturar);
          be.panels[1].text := 'Obteniendo contenido web: ' + url;
          be.Refresh;
          insertarWeb (url, ipCapturar);
          if errorCaptura <> '' then
            txtLog.Lines.Add(datetostr(date) + timetostr(time) +
                ' IP ' + ipCapturar + ' URL: ' + url +
                '  -> Error: ' + errorCaptura)
          else
            txtLog.Lines.Add(datetostr(date) + timetostr(time) +
                ' IP ' + ipCapturar + ' URL: ' + url + '  -> Correcto');
          be.Panels[2].Text := 'E: ' + floattostr(numErrores) +
              ' C: ' + floattostr(numAciertos);
          be.Refresh;

        end;
      end;
    end;
  end;
  
  //obtenemos las webs de las URLs especificadas
  if opCapturarEspecificas.Checked then
  begin
    bp.Min := 1;
    bp.Max := txtWebEspecificas.Lines.Count;
    tTablaInsertar.Open;
    for i := 0 to txtWebEspecificas.Lines.Count - 1 do
    begin
      Application.ProcessMessages;
      be.Panels[0].Text := 'Capturando Web específica ' +
          inttostr(i + 1) +  '/' +
          IntToStr(txtWebEspecificas.Lines.Count);
      be.Refresh;
      bp.Position := i;
      if cancelarProceso then
        Break;
      url := txtWebEspecificas.Lines.Strings[i];
      if Pos ('http://', url) <> 0 then
        url := copy (url, 8, length (url));
      if Pos ('https://', url) <> 0 then
        url := copy (url, 9, length (url));
      if url <> '' then
      begin
        be.panels[1].text := 'Obteniendo contenido web: ' + url;
        be.Refresh;
        ipCapturar := obtenerIPdeURL (url);
        if ipCapturar <> '' then
        begin
          insertarWeb (url, ipCapturar);
          if errorCaptura <> '' then
            txtLog.Lines.Add(datetostr(date) + timetostr(time) +
                ' IP ' + ipCapturar + ' URL: ' + url +
                '  -> Error: ' + errorCaptura)
          else
            txtLog.Lines.Add(datetostr(date) + timetostr(time) +
                ' IP ' + ipCapturar + ' URL: ' + url + '  -> Correcto');
          be.Panels[2].Text := 'E: ' + floattostr(numErrores) +
              ' C: ' + floattostr(numAciertos);
          be.Refresh;
        end;
      end;
    end;
  end;

  if opGuardarLog.checked then
    txtLog.Lines.savetofile(extractfilepath(application.exename) + 'log.txt');
  be.panels[1].text := 'Proceso finalizado';
  actCancelarCaptura.Enabled := false;  
end;

procedure TformMenuPrincipal.txtD1Change(Sender: TObject);
begin
  try
    if Length(txtD1.Text) = 3 then
      txtD2.SetFocus;
    txtH1.Text := txtD1.Text;
  except
  end;
end;

procedure TformMenuPrincipal.txtD1KeyPress(Sender: TObject; var Key: Char);
begin
  if key = '.' then
  begin
    txtD2.SetFocus;
    Key := chr(0);
  end;
end;

procedure TformMenuPrincipal.txtD2Change(Sender: TObject);
begin
  try
    if Length(txtD2.Text) = 3 then
      txtD3.SetFocus;
    txtH2.Text := txtD2.Text;
  except
  end;
end;

procedure TformMenuPrincipal.txtD2KeyPress(Sender: TObject; var Key: Char);
begin
  if key = '.' then
  begin
    txtD3.SetFocus;
    Key := chr(0);
  end;
end;

procedure TformMenuPrincipal.txtD3Change(Sender: TObject);
begin
  try
    if Length(txtD3.Text) = 3 then
      txtD4.SetFocus;
    txtH3.Text := txtD3.Text;
  except
  end;
end;

procedure TformMenuPrincipal.txtD3KeyPress(Sender: TObject; var Key: Char);
begin
  if key = '.' then
  begin
    txtD4.SetFocus;
    Key := chr(0);
  end;
end;

procedure TformMenuPrincipal.txtD4Change(Sender: TObject);
begin
  try
    if Length(txtD4.Text) = 3 then
      txtH4.SetFocus;
    txtH4.Text := txtD4.Text;
  except
  end;
end;

procedure TformMenuPrincipal.txtD4KeyPress(Sender: TObject; var Key: Char);
begin
  if key = '.' then
  begin
    txtH4.SetFocus;
    Key := chr(0);
  end;
end;

procedure TformMenuPrincipal.txtH4Exit(Sender: TObject);
begin
 if StrToInt(txtH4.Text) < StrToInt(txtD4.Text) then
 begin
   MessageDlg ('La IP desde la que desee hacer ping no puede ser menor ' +
       'que la IP hasta la que desee hacer ping', mtWarning, [mbok], 0);
   txtH4.SetFocus;
 end;
end;

procedure TformMenuPrincipal.txtH4KeyPress(Sender: TObject; var Key: Char);
begin
  if key = '.' then
  begin
    Key := chr(0);
  end;
end;

procedure TformMenuPrincipal.FormCreate(Sender: TObject);
begin
  if FileExists(ExtractFilePath(Application.ExeName) + 'webs.txt') then
    txtWebEspecificas.Lines.LoadFromFile(ExtractFilePath(Application.ExeName) +
    'webs.txt');
  if FileExists(ExtractFilePath(Application.ExeName) + 'log.txt') then
    txtLog.Lines.LoadFromFile(ExtractFilePath(Application.ExeName) + 'log.txt');

  tTabla.Close;
  tTabla.DatabaseName := ExtractFilePath(Application.ExeName) + 'datos';
//  tTabla.Open;
  tTablaInsertar.Close;
  tTablaInsertar.DatabaseName := ExtractFilePath(Application.ExeName) + 'datos';
 // tTablaInsertar.Open;
  tConsulta.Close;
  tConsulta.DatabaseName := ExtractFilePath(Application.ExeName) + 'datos';
end;

procedure TformMenuPrincipal.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  txtWebEspecificas.Lines.SaveToFile(ExtractFilePath(Application.ExeName) +
      'webs.txt');;
end;

procedure TformMenuPrincipal.actCancelarCapturaExecute(Sender: TObject);
begin
  cancelarProceso := true;
end;

procedure TformMenuPrincipal.actAbrirBDExecute(Sender: TObject);
begin
  tTabla.Open;
  ttabla.Refresh;
end;

procedure TformMenuPrincipal.actVisualizarExecute(Sender: TObject);
begin
  if tTabla.RecordCount > 0 then
  begin
    tTablaContenido.SaveToFile(ExtractFilePath (Application.ExeName) +
        tTablaURL.Value + '.html');
    ShellExecute(Handle, Nil, PChar(ExtractFilePath (Application.ExeName) +
        tTablaURL.Value + '.html'),
        Nil, Nil, SW_SHOWNORMAL);
  end;
end;

procedure TformMenuPrincipal.actVisualizarHTMLExecute(Sender: TObject);
begin
  if tTabla.RecordCount > 0 then
  begin
    if not varisnull(tTablaContenido.Value) then
    begin
      formVisualizacionHTML.mHTML.Text := tTablaContenido.Value;
      formvisualizacionHTML.show;
    end;
  end;
end;

procedure TformMenuPrincipal.LWEBClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION),
      Nil, Nil, SW_SHOWNORMAL);
end;

end.

 

Artículos relacionados

 

Créditos

Artículo realizado íntegramente por Alonsojpd miembro fundador del Proyecto AjpdSoft.

Artículo en inglés.


Anuncios


Enviado el Lunes, 07 julio a las 22:04:46 por ajpdsoft
Este sitio web NO CONTIENE malware, todos los programas con código fuente aquí. Autor: Alonso Javier Pérez Díaz Google+ Síguenos en Google+