Trucos sobre tWebBrowser ( II )

A continuación tenéis más procedimientos relacionados con el componente tWebBrowser:

CREAR UN tWebBrowser EN RUNTIME
procedure TForm1.Button1Click(Sender: TObject);
var
wb: TWebBrowser;
begin
wb := TWebBrowser.Create(Form1);
TWinControl(wb).Name := 'MyWebBrowser';
TWinControl(wb).Parent := Form1;
wb.Align := alClient;
// TWinControl(wb).Parent := TabSheet1; ( To put it on a TabSheet )
wb.Navigate('http://delphimagic.blogspot.com');
end;

DESHACER, REHACER, SELECCIONAR TODO
Añadir
uses ActiveX;

y al final de la unit

initialization
OleInitialize(nil);
finalization
OleUninitialize;

// Deshacer
procedure TForm1.Button2Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

//Rehacer
procedure TForm1.Button3Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_REDO, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;


// Seleccionar todo
procedure TForm1.Button4Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;


GUARDAR TODAS LAS IMÁGENES
uses
UrlMon;

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0,
nil) = 0;
except
Result := False;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
k, p: Integer;
Source, dest, ext: string;
begin
for k := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
begin
Source := WebBrowser1.OleObject.Document.Images.Item(k).Src;
p := LastDelimiter('.', Source);
ext := UpperCase(Copy(Source, p + 1, Length(Source)));
if (ext = 'GIF') or (ext = 'JPG') then
begin
p := LastDelimiter('/', Source);
dest := ExtractFilePath(ParamStr(0)) + Copy(Source, p + 1,
Length(Source));
DownloadFile(Source, dest);
end;
end;
end;


HACER UN ZOOM DE UNA PÁGINA
procedure TForm1.Button1Click(Sender: TObject);
begin
//75% del tamaño original
WebBrowser1.OleObject.Document.Body.Style.Zoom := 0.75;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//Tamaño original
WebBrowser1.OleObject.Document.Body.Style.Zoom := 1;
end;


COMPROBAR QUE LA PÁGINA ES SEGURA (SSL)
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if Webbrowser1.Oleobject.Document.Location.Protocol = 'https:' then
label1.Caption := 'Página segura'
else
label1.Caption := 'Página no segura';
end;


COMPROBAR QUE LA PÁGINA SE ENCUENTRA EN EL DISCO LOCAL
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if Webbrowser1.Oleobject.Document.Location.Protocol = 'file:' then
begin
label1.Caption := 'El archivo está en el disco local'
end;
end;

Trucos sobre tWebBrowser

tWebBrowser es un componente de Delphi que nos permite incorporar un visualizador de páginas web dentro de nuestras aplicaciones. Depende de la habilidad de nosotros el que podamos realizar un "Internet Explorer", "Firefox", "Opera"...
En este y posteriores artículos os mostraré algunos trucos interesantes:

PROCEDIMIENTOS SOBRE IMPRESIÓN DE PÁGINAS

IMPRIME UNA PÁGINA SIN VENTANA DE DIÁLOGO
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,
vaIn, vaOut);
end;

IMPRIME UNA PÁGINA CON VENTANA DE DIÁLOGO
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

IMPRIME UNA VISTA PREVIA DE LA PÁGINA
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

MUESTRA LA VENTANA "CONFIGURAR IMPRESORA"
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;


PROCEDIMIENTOS PARA EL MANEJO DEL CLIPBOARD
añadir

uses ActiveX

initialization
OleInitialize(nil);

finalization
OleUninitialize;

COPIA EL TEXTO SELECCIONADO AL CLIPBOARD
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

CORTA EL TEXTO SELECCIONADO AL CLIPBOARD
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_CUT, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

BORRA EL TEXTO SELECCIONADO
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_DELETE, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;


COMPROBAR QUE EL COMANDO "COPY" ESTÁ ACTIVO
procedure TForm1.Button1Click(Sender: TObject);
begin
if Webbrowser1.OleObject.Document.queryCommandEnabled('Copy') then
ShowMessage('Copy está activo');
end;

PROCEDIMIENTOS PARA IMPLEMENTAR LOS BOTONES "Siguiente, Anterior, Stop"
procedure TForm1.ButtonBackClick(Sender: TObject);
begin
WebBrowser1.GoBack
end;

procedure TForm1.ButtonForwardClick(Sender: TObject);
begin
WebBrowser1.GoForward
end;

procedure TForm1.ButtonCancelClick(Sender: TObject);
begin
WebBrowser1.Stop;
end;


VARIOS

IR A UNA PÁGINA WEB
WebBrowser.Navigate( URL.Text );

REEMPLAZAR LAS IMÁGENES DE UNA PÁGINA WEB
procedure TForm1.Button1Click(Sender: TObject);
var
li: Word;
begin
// Busca todas las imágenes de una página
for li := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
// y las cambia por "MiImagen.gif"
WebBrowser1.OleObject.Document.Images.Item(0).Src := 'c:\MiImagen.gif';
end;


OCULTA LAS BARRAS DE SCROLL
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.OleObject.Document.Body.Style.OverflowX := 'hidden';
WebBrowser1.OleObject.Document.Body.Style.OverflowY := 'hidden';
end;


GRABA UNA PÁGINA HTML EN UN ARCHIVO
uses
ActiveX, MSHTML_TLB, SHDocVw_TLB,
ComCtrls, OleCtrls;

procedure TForm1.Button1Click(Sender: TObject);
var
HTMLDocument: IHTMLDocument2;
PersistFile: IPersistFile;
begin
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
PersistFile := HTMLDocument as IPersistFile;
PersistFile.Save(StringToOleStr('c:\MiPaginaWeb.html'), System.True);
end;

DESACTIVA LOS MENUS POPUP
Poner un componente tApplicationEvents en el form y en el evento onMessage poner lo siguiente

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if (Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONDBLCLK) then
begin
if IsChild(Webbrowser1.Handle, Msg.hwnd) then
begin
// Muestra tu propio popup o lo que tú quieras
Handled := True;
end;
end;
end;

OTRO MÉTODO PARA DESACTIVAR LAS VENTANAS EMERGENTES
En el evento OnNewWindow2 poner lo siguiente:
procedure TForm1.WebBrowserNewWindow2(Sender: TObject;var ppDisp: IDispatch; var Cancel: WordBool);
begin
Cancel := True;
end;

Webcam con Delphi ( III )

Continuando con el proyecto de manejo de una webcam con Delphi os presento el procedimiento para detener la grabación de una secuencia de video:



Tenéis que crear un tButton llamado "PararVideo" y en el evento Onclick teclear lo siguiente:



PROCEDURE TForm1.PararVideoClick(Sender: TObject);

BEGIN

IF ventana <> 0 THEN

BEGIN

SendMessage(ventana, WM_CAP_STOP, 0, 0);

END;

END;







UNIT WEBCAM

============

unit Webcam;
interface
uses
  Windows, Messages;
type
  TWebcam = class
    constructor Create(
      const WindowName: String = '';
      ParentWnd: Hwnd = 0;
      Left: Integer = 0;
      Top: Integer = 0;
      Width: Integer = 0;
      height: Integer = 0;
      Style: Cardinal = WS_CHILD or WS_VISIBLE;
      WebcamID: Integer = 0);
    public
      const
        WM_Connect     = WM_USER + 10;
        WM_Disconnect  = WM_USER + 11;
        WM_GrabFrame   = WM_USER + 60;
        WM_SaveDIB     = WM_USER + 25;
        WM_Preview     = WM_USER + 50;
        WM_PreviewRate = WM_USER + 52;
        WM_Configure   = WM_USER + 41;
    public
      procedure Connect;
      procedure Disconnect;
      procedure GrabFrame;
      procedure SaveDIB(const FileName: String = 'webcam.bmp');
      procedure Preview(&on: Boolean = True);
      procedure PreviewRate(Rate: Integer = 42);
      procedure Configure;
    private
      CaptureWnd: HWnd;
  end;
implementation
function capCreateCaptureWindowA(
  WindowName: PChar;
  dwStyle: Cardinal;
  x,y,width,height: Integer;
  ParentWin: HWnd;
  WebcamID: Integer): Hwnd; stdcall external 'AVICAP32.dll';
{ TWebcam }
procedure TWebcam.Configure;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Configure, 0, 0);
end;
procedure TWebcam.Connect;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Connect, 0, 0);
end;
constructor TWebcam.Create(const WindowName: String; ParentWnd: Hwnd; Left, Top,
  Width, height: Integer; Style: Cardinal; WebcamID: Integer);
begin
  CaptureWnd := capCreateCaptureWindowA(PChar(WindowName), Style, Left, Top, Width, Height,
    ParentWnd, WebcamID);
end;
procedure TWebcam.Disconnect;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Disconnect, 0, 0);
end;
procedure TWebcam.GrabFrame;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_GrabFrame, 0, 0);
end;
procedure TWebcam.Preview(&on: Boolean);
begin
  if CaptureWnd <> 0 then
    if &on then
      SendMessage(CaptureWnd, WM_Preview, 1, 0)
    else
      SendMessage(CaptureWnd, WM_Preview, 0, 0);
end;
procedure TWebcam.PreviewRate(Rate: Integer);
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_PreviewRate, Rate, 0);
end;
procedure TWebcam.SaveDIB(const FileName: String);
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_SaveDIB, 0, Cardinal(PChar(FileName)));
end;
end.

=================

EJEMPLO DE USO

===============

en el evento OnCreate:

... 

  private
    { Private declarations }
  public
    { Public declarations }
    camera: TWebcam;
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  camera := TWebcam.Create('WebCaptured', Panel1.Handle, 0, 0,
    1000, 1000);
end;

ENCENDIDO Y APAGADO DE LA CAMARA:

================================= 

procedure TForm1.Button1Click(Sender: TObject);
const
  str_Connect = 'Encender la camara';
  str_Disconn = 'Apagar la camara';
begin
  if (Sender as TButton).Caption = str_Connect then  begin
    camera.Connect;
    camera.Preview(true);
    Camera.PreviewRate(4);
    (Sender as TButton).Caption:=str_Disconn;
  end
  else begin
    camera.Disconnect;
    (Sender as TButton).Caption:=str_Connect;
  end;
end; 

CAPTURA DE LA FOTO

==================

procedure TForm1.Button2Click(Sender: TObject);
var
  PanelDC: HDC;
begin
if not Assigned(Image1.Picture.Bitmap) then
    Image1.Picture.Bitmap := TBitmap.Create
  else
  begin
    Image1.Picture.Bitmap.Free;
    Image1.picture.Bitmap := TBitmap.Create;
  end;
  Image1.Picture.Bitmap.Height := Panel1.Height;
  Image1.Picture.Bitmap.Width  := Panel1.Width;
  Image1.Stretch := True;
  PanelDC := GetDC(Panel1.Handle);
  try
    BitBlt(Image1.Picture.Bitmap.Canvas.Handle,
      0,0,Panel1.Width, Panel1.Height, PanelDC, 0,0, SRCCOPY);
  finally
    ReleaseDC(Handle, PanelDC);
  end;
end;

Webcam con Delphi ( II )

A continuación os muestro nuevas utilidades para usar una webcam con Delphi.



ALMACENAR UNA SECUENCIA DE VIDEO

Nuevos componentes del form:



tSaveDialog,Definición de propiedades:

- Name = Guardar



tButtonDefinición de propiedades:

- Name = BtnAlmacenarVideo

- Caption = AlmacenarVideo



En el Evento Onclic del tButton poner

PROCEDURE TForm1.BtnAlmacenarVideoClick(Sender: TObject);
BEGIN
   IF Ventana <> 0 THEN
   BEGIN
      Guardar.Filter := 'Fichero AVI (*.avi)*.avi';
      Guardar.DefaultExt := 'avi';
      Guardar.FileName := 'FicheroAvi';
      IF Guardar.Execute THEN
      BEGIN
         SendMessage(Ventana, WM_CAP_FILE_SET_CAPTURE_FILEA, 0,
            Longint(pchar(Guardar.Filename)));
         SendMessage(Ventana, WM_CAP_SEQUENCE, 0, 0);
      END;
   END;
END;

GUARDAR UNA FOTO DE LA VENTANA DE CAPTURA

Añadir un tButton



tButtonDefinición de propiedades:

- Name = BtnGuardarImagen

- Caption = Guardar Imagen



Código del Botón

PROCEDURE TForm1.BtnGuardarImagenClick(Sender: TObject); 
BEGIN
IF Ventana <> 0 THEN
BEGIN
Guardar.FileName := 'Captura de la imagen';
Guardar.DefaultExt := 'bmp';
Guardar.Filter := 'Fichero Bitmap (*.bmp)*.bmp';
IF Guardar.Execute THEN
SendMessage(Ventana, WM_CAP_SAVEDIB, 0,
longint(pchar(Guardar.FileName)));
END;
END;

Webcam con Delphi (I)

A continuación os presento el software que os permitirá manejar vuestra Webcam con Delphi.



Primeramente tenéis que instalar en vuestro sistema el software "Microsoft Video for Windows SDK " que contiene la librería Avicap32.dll.

Dentro de las funciones que contiene utilizaremos "capCreateCaptureWindowA" para inicializar el driver y capturar la imagen.

Después para manejar la ventana de captura tendremos que usar la función "SendMessage" lo que facilita y simplifica muchísimo el trabajo a los programadores.

Ahora vamos con el programa:



Como variables globales añadimos:



Ventana: hwnd; //Handle de la ventana de captura



En la sección "const" escribimos:





WM_CAP_START = WM_USER;

WM_CAP_STOP = WM_CAP_START + 68;

WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;

WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;

WM_CAP_SAVEDIB = WM_CAP_START + 25;

WM_CAP_GRAB_FRAME = WM_CAP_START + 60;

WM_CAP_SEQUENCE = WM_CAP_START + 62;

WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;

WM_CAP_EDIT_COPY = WM_CAP_START + 30;

WM_CAP_SET_PREVIEW = WM_CAP_START + 50;

WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;





En la sección "implementation":





FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; STDCALL EXTERNAL 'AVICAP32.DLL';





Es la llamada a la librería externa Avicap32.dll



Elementos de la interface:



-Botón "iniciar" (Al pulsarlo empezará la captura de la imagen procedente de la Webcam)



-Botón "detener" (Para parar la captura de la imagen)



-Control de Imagen "tImage" (lo llamaremos "Image1")

El código que se incluirá dentro de los botones es el siguiente:



Botón "Iniciar"

PROCEDURE TForm1.Button1Click(Sender: TObject);
BEGIN
  Ventana := capCreateCaptureWindowA('Ventana de captura',
     WS_CHILD OR WS_VISIBLE, image1.Left, image1.Top, image1.Width,
     image1.Height, form1.Handle, 0);
  IF Ventana <> 0 THEN
  BEGIN
     TRY
        SendMessage(Ventana, WM_CAP_DRIVER_CONNECT, 0, 0);
        SendMessage(Ventana, WM_CAP_SET_PREVIEWRATE, 40, 0);
        SendMessage(Ventana, WM_CAP_SET_PREVIEW, 1, 0);
     EXCEPT
        RAISE;
     END;
  END
  ELSE
  BEGIN
     MessageDlg('Error al conectar Webcam', mtError, [mbok], 0);
  END;
END;

Botón "Detener"

PROCEDURE TForm1.Button2Click(Sender: TObject);
BEGIN
  IF Ventana <> 0 THEN
  BEGIN
     SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
     Ventana := 0;
  END;
END;

En el evento Onclose deberemos hacer una llamada al procedimiento incluido en el botón "Detener".

Y eso es todo por ahora, en posteriores artículos iremos añadiendo más utilidades.

Calcular el PageRank con Delphi

A continuación os presento cómo calcular el pagerank de una página web con Delphi.

¿ QUÉ ES PAGERANK ?

Es una marca registrada y patentada por Google el 9 de enero de 1999 que ampara una familia de algoritmos utilizados para asignar de forma numérica la relevancia de los documentos (o páginas web) indexados por un motor de búsqueda

El algoritmo inicial lo podemos encontrar en el documento original donde sus creadores presentaron el prototipo de Google: “The Anatomy of a Large-Scale Hypertextual Web Search Engine"

INSTALACIÓN DEL COMPONENTE

1) Descargar el archivo prfree.zip desde http://www.irnis.net/files/prfree.zip
2) Crear una carpeta llamada “pagerank” y descomprimir allí el archivo anterior
3) Abrir la carpeta “pagerank”
4) Para los que tengan Delphi 2007 hacer clic sobre la carpeta “delphi10”
5) Abrir el archivo “pagerank_d10.dpk”

6) Con el botón derecho del ratón hacer clic sobre el item “pagerank_d10.bpl”
Sobre el menú emergente activar los items “Compilar” e “Instalar”
Si todo va bien tendréis en la paleta de componentes llamada “Internet” dos nuevos componentes llamados tPageRank y tPageRankControl

CÓDIGO DEL PROGRAMA

Ahora ya estamos en condiciones de crear nuestra aplicación Delphi.

En el Form colocar los controles tPageRank y tPageRankControl así como un tButton y un tEdit (aquí escribiremos la URL de la página web de la cual queremos conocer su page rank)

En la propiedad Linkage-PageRank del componente tPageRankControl asignar el valor "PageRank1"


En el “uses” de la unit añadir WinInet.

DESCRIPCIÓN DE PROCEDIMIENTOS Y FUNCIONES


En el método “Onclick” del botón poner el siguiente código

procedure TMainForm.Button1Click(Sender: TObject);
begin
PageRank1.Page := URLEdit.Text;
PageRank1.NonBlock := true;
PageRank1.UpdatePageRank;
PageRankControl1.ShowText := true;
PageRankControl1.BarWidth := 7;
end;

En el evento OnGetRank del componente tPageRank guardar el siguiente código:

function Tform1.PageRank1GetRank(const URL: string; var Rank: string): Boolean;
var
Root, Connect, Request: HINTERNET;
I, L, RetVal: Longword;
S, Server, Document: string;
P: Pointer;
begin
Result := FALSE; if UpperCase(Copy(URL, 1, 7)) <> 'HTTP://' then Exit;

I := 8; L := Length(URL); while (I <= L) and (URL[I] <> '/') do Inc(I);
if I > L then Exit;

Server := Copy(URL, 8, I - 8); Document := Copy(URL, I, L - I + 1);

RetVal := InternetAttemptConnect(0);
if RetVal <> ERROR_SUCCESS then RaiseError(RetVal);

Root := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Root = nil then RaiseError(Windows.GetLastError);
try
Connect := InternetConnect(Root, PChar(Server), INTERNET_DEFAULT_HTTP_PORT,
nil, nil, INTERNET_SERVICE_HTTP, 0, 0);

if Connect = nil then RaiseError(Windows.GetLastError);
try
Request := HttpOpenRequest(Connect, nil, PChar(Document), nil, nil,
nil, INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_RELOAD, 0);

if Request = nil then RaiseError(Windows.GetLastError);
try
SetLength(S, 1024);
repeat
if not HttpSendRequest(Request, nil, 0, nil, 0) then RaiseError(Windows.GetLastError);
RetVal := InternetErrorDlg(GetDesktopWindow(), Request, GetLastError,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);
if RetVal = ERROR_CANCELLED then Exit;
until RetVal = ERROR_SUCCESS;

Rank := '';
repeat
SetLength(S, 1024);
if not InternetReadFile(Request, PChar(S), 1024, L)
then RaiseError(Windows.GetLastError);
SetLength(S, L); Rank := Rank + S
until L (menor que) 1024;
Result := TRUE
finally
InternetCloseHandle(Request);
end
finally
InternetCloseHandle(Connect)
end
finally
InternetCloseHandle(Root)
end
end;

Añadir el siguiente procedimiento para gestión de errores:

procedure TForm1.RaiseError(Error: LongWord);
var
S: string;
I: LongWord;
begin
I := 1024; SetLength(S, I);
if Error = ERROR_INTERNET_EXTENDED_ERROR then
repeat
if InternetGetLastResponseInfo(Error, PChar(S), I) then Break;
if GetLastError = ERROR_INSUFFICIENT_BUFFER then SetLength(S, I) else Break;
until FALSE
else FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_FROM_HMODULE,
Pointer(GetModuleHandle('wininet.dll')), Error, 0, PChar(S), I, nil);
S := PChar(S) + ' (' + IntToStr(Error) + ')';
if PageRank1.NonBlock then
MessageBox(0, PChar(S), nil, MB_ICONERROR or MB_OK or MB_TASKMODAL);
raise Exception.Create(S);
end;

Ahora ya podremos ejecutar nuestra aplicación, que quedará de la siguiente forma:

Buscar en Google con Delphi

A continuación os presento cómo hacer búsquedas en la web utilizando la API de Google Search desde un programa en Delphi.

PASOS PREVIOS

- Ir a http://www.google.com/apis/
- Descargar el Kit de desarrollo
- Crear una cuenta en Google
- Escribir tu programa usando la clave de licencia proporcionada por Google

DENTRO DE DELPHI

1) Crear un Form incorporando un objeto tEdit, tMemo, tButton.

2) En el Uses añadir la unit GoogleSearch

Descargar la unit desde aquí: http://JJavierPareja.googlepages.com/GoogleSearch.dcu

3) En el evento onclic del tButton incluir el siguiente código:

PROCEDURE TForm1.Button1Click(Sender: TObject);

VAR
NumeroDeResultadosDelaBusqueda : Integer;
Resultados: GoogleSearchResult;
i: Integer;

BEGIN

NumeroDeResultadosDelaBusqueda:=10;
Resultados := GetGoogleSearchPort.doGoogleSearch('1WpiIaxr+k+hbyYbRLZOJfg7X9NgI837',
Edit1.Text, 0, NumeroDeResultadosDelaBusqueda, True, '', True, 'lang_es', 'latin1', 'latin1');
label1.Caption := Format('%d resultados en %.2n segundos',
[Resultados.estimatedTotalResultsCount, Resultados.searchTime]);
FOR i := Low(Resultados.resultElements) TO High(Resultados.resultElements) DO
BEGIN
Memo1.lines.add('');
Memo1.lines.add('====================================');
Memo1.lines.add('');
Memo1.lines.add(IntToStr(Succ(i)));
Memo1.lines.add(Resultados.resultElements[i].title);
Memo1.lines.add(Resultados.resultElements[i].URL);
Memo1.lines.add(Resultados.resultElements[i].cachedSize);
END
END;

Ahora ya se puede iniciar el programa.

- Teclear el texto a buscar dentro de la caja de texto (P. ej. "Museos de España" )y pulsar el botón.

Si todo es correcto se mostrará unos resultados similares a los que os aparecería al utilizar el buscador Google desde una página web, pero dentro de vuestra propia aplicación.




INFORMACIÓN COMPLEMENTARIA:

Google Search API es una librería que te permite embeber la búsqueda Google en tus aplicaciones.

El número de resultados de cada búsqueda tiene que ser de 10 o menor.

El uso de Google API es gratuito (por lo que yo sé) pero se necesita una clave personal que te permite 1000 búsquedas por día, además tiene que ser para un uso no comercial. Para usar esta clave necesitas registrarte con un email y un password. Se te enviará un e-mail para verificar tu dirección de correo. Después de que hayas recibido el mensaje y clickeado en el link que contiene, recibirás un segundo mensaje con tu "Google Search Key". Esta clave hay que incluirla en el código fuente de tu aplicación como ves en el ejemplo superior.

Los parámetros del procedimiento doGoogleSearch son:

Key: Es el “Licence Key”.
Q: Es la consulta.
Star: Posición del primer elemento a partir del cual solicitamos la búsqueda.
MaxResults: Número máximo de elementos que contendrá la respuesta.
Filter: Indica si se debe realizar la búsqueda filtrando los elementos similares a otros mostrados.
Restrict: Permite restringir la búsqueda a un almacén de búsqueda determinado.
SafeSearch: Permite filtrar contenidos no aptos para menores.
lr. Restringe la búsqueda a un idioma determinado.
ie. Codificación de entrada.
oe. Codificación de salida

Utilizar Google Maps en Delphi

Para utilizar Google Maps en tus aplicaciones Delphi, tienes que proceder de la siguiente forma:

1) Inicia una nueva aplicación VCL

2) Pon un botón en tu form, y en el evento asociado “OnClick” pon el siguiente código:

procedure TForm1.Button1Click(Sender: TObject);

var

Doc2: IHTMLDocument2;

begin

with WebBrowser1.Document as IHTMLDocument2 do

with parentWindow do

execScript('createMapMarker("31.05173494","-122.03160858", "Marcador de prueba")', 'JavaScript');

end;

En el uses hay que añadir la unit MSHTML en Delphi 2007

3) Pon un control TWebBrowser

4) En el evento OnCreate del Form pon el siguiente código

WebBrowser1.Navigate('http://www.stevetrefethen.com/files/googlemap.htm');

Al ejecutar este programa lo que hace es generar un marcador en la posición indicada con el texto “Marcador de prueba”




REQUISITOS PREVIOS

Tienes que solicitar a Google una “Google Maps Api Key”, te pedirá además un dominio para asociarlo a la clave.

Una vez que la recibas, tienes que incluirla en la página web donde quieras mostrar un mapa.

Además tienes que saber que la Api Key va asociada directamente al dominio, de tal forma que si la pones en una página web con otro dominio distinto Google Maps no funcionará.

Para hacer pruebas, circula por Internet una Api Key para el dominio localhost.

Como proteger tu codigo

Los crackers utilizan desensambladores que permiten ver el código de una forma más clara, para ello ponen breakpoints (típicamente en llamadas de windows o mensajes) y modifican el código antes del siguiente salto.

Por tanto para dificultar el desensamblado, lo que hacemos es insertar código ASM en nuestros procedimientos



Las declaraciones condicionales ASM que insertan código son de este tipo:



JMP aquí

DB byte,byte,byte,byte ; datos basura



Lo que vamos a realizar es un archivo que se insertará en nuestro programa, que genere complejidad en el conjunto de instrucciones ASM, pero que sea transparente a nuestra aplicación.



----- Este es el archivo include: AsmParam.inc: ------

{$IFDEF Param4}

{$UNDEF Param1}

{$UNDEF Param2}

{$UNDEF Param3}

{$UNDEF Param4}

{$ENDIF}

{$IFDEF Param3}

{$IFNDEF Param4}

asm

DB $EB,$06,$55,$44,$55,$03,$a8,$09;

end;

{$DEFINE Param4}

{$ENDIF}

{$ENDIF}

{$IFDEF Param2}

{$IFNDEF Param3}

{$IFNDEF Param4}

asm

DB $EB,$04,$75,$13,$a2,$14;

end;

{$DEFINE Param3}

{$ENDIF}

{$ENDIF}

{$ENDIF}

{$IFNDEF Param1}

{$IFNDEF Param2}

{$IFNDEF Param3}

{$IFNDEF Param4}

asm

DB $EB,$04,$55,$03,$a7,$44;

end;

{$DEFINE Param2}

{$ENDIF}

{$ENDIF}

{$ENDIF}

{$ENDIF}

;

---- Fin del archivo include----





Una vez que tenemos este archivo se inserta entre las líneas de código del evento Onclic de un botón.

El procedimiento se ejecuta normalmente, con la diferencia de que en este caso se incluye un montón de código basura.



procedure TForm1.Button1Click(Sender: TObject);

begin

{$I AsmParam.inc}

ShowMessage('1');

{$I AsmParam.inc}

ShowMessage('2');

{$I AsmParam.inc}

ShowMessage('3');

{$I AsmParam.inc}

ShowMessage('4');

{$I AsmParam.inc}

ShowMessage('1');

end;

Esto puede convertir el desensamblado en una pesadilla incluso con procedimientos simples como Showmessage. El archivo ".inc" puede ser mejorado para producir código aleatorio.

Redes Neuronales y Bolsa - Neural Networks and financial markets

Ahora que en todos los medios de comunicación se habla de la Bolsa, creo que podría ser interesante utilizar el componente TFFNN del que os hablé hace unos días para que veáis cómo se puede utilizar para predecir un valor de una serie temporal basándose en datos anteriores.

Supongamos que tenemos las cotizaciones de cierre de Telefónica, S.A. (p.ej. 1000 valores) y queremos saber cual será el valor de cierre del día N sabiendo la cotización del día N-1, N-2, N-3, N-4 y N-5



Lo primero que hay que hacer es:

Asignar los parámetros de la red neuronal

FFNN1.InputCount:=6   //Son 5 valores + el valor a predecir
FFNN1.OutputCount:=1
FFNN1.InputMax := MAX; //Valor máximo de la serie de cotizaciones
FFNN1.InputMin := MIN; //Valor mínimo de la serie de cotizaciones
FFNN1.OutputMax := MAX; //Valor máximo de la serie de cotizaciones
FFNN1.OutputMin := MIN; ;//Valor mínimo de la serie de cotizaciones

El "Valor máximo" y el "Valor mínimo" es el valor máximo y mínimo de los 1000 valores que componen la serie ( No de los 5 valores )

CÓDIGO PARA ENTRENAR LA RED

VecesQueSeRepite := 1; NumsALeer := 6;
//Este bucle se repetirá 5000 veces o
//hasta que el error sea menor que 0.001
REPEAT

//Bucle que sirve para leer las cotizaciones y
//entrenar la red
REPEAT

//Puntero: Es un apuntador a la serie de valores que salta de 6 en 6
//FicheroEntrada: tStringlist que almacena las 1000 cotizaciones de Telefónica
//NumsLeidos:VAR Array de 6 valores de tipo real
//NoSePuedenLeerMasNumeros:Variable Booleana que se pone a TRUE
//al llegar al final del Fichero de Entrada
//Lee las cotizaciones de Telefónica de 6 en 6
LeeNNums(Puntero, ficheroEntrada, NumsLeidos,
NoSePuedenLeerMasNumeros);

//Almacena en la red 5 cotizaciones procedentes del array "NumsLeidos"
FOR i := 1 TO NumsALeer - 1 DO
FFNN1.Input[i] := NumsLeidos[i];
FFNN1.DesiredOutput[1] := NumsLeidos[NumsALeer];
FFNN1.BackProp; //Entrena la red con el par (In, Out).

UNTIL NoSePuedenLeerMasNumeros;


//Vuelve a tomar los datos de entrada de la red ya entrenada y
//calcula el valor de salida
Puntero := Numvalores DIV 2;
NoSePuedenLeerMasNumeros := false;
REPEAT

//coge las cotizaciones de Telefónica de 6 en 6
LeeNNums(Puntero, FicheroEntrada, NumsLeidos,
NoSePuedenLeerMasNumeros);
FOR i := 1 TO NumsALeer - 1 DO
FFNN1.Input[i] := NumsLeidos[i];
FFNN1.calcOut;
rdo := FFNN1.output[1];
FFNN1.DesiredOutput[1] := NumsLeidos[NumsALeer];
Error := FFNN1.GetMaxError;

UNTIL NOT NoSePuedenLeerMasNumeros;


Inc(VecesQueSeRepite);
UNTIL (VecesQueSeRepite > 5000) OR (Error<0 .001="">

MOSTRAR RESULTADOS



Ahora una vez que hemos terminado de entrenar la red podemos crear un form con 6 cajas de texto.
En 5 de ellas teclearemos cotizaciones diarias de Telefónica y en la sexta caja tendremos el valor predicho por la red neuronal.

El código sería este:

VAR


ValorPredichoPorLaRedNeuronal:Real;

begin

FFNN1.Input[1] := strtofloat(edit1.text);

FFNN1.Input[2] := strtofloat(edit2.text);

FFNN1.Input[3] := strtofloat(edit3.text);

FFNN1.Input[4] := strtofloat(edit4.text);

FFNN1.Input[5] := strtofloat(edit5.text);

ffnn1.calcOut;

ValorPredichoPorLaRedNeuronal := ffnn1.output[1];

Edit6.text:= FloatToStr( ValorPredichoPorLaRedNeuronal )

end;

MEJORAS
- Se puede entrenar el sistema con las cotizaciones de más empresas para mejorar la predicción,

-Es conveniente normalizar los valores antes de introducirlos en la red neuronal.

-Se puede aumentar el número de capas (FFNN1.NLayers) y el número de neuronas de cada capa para ver en qué momento tenemos la mejor estimación.

-Si utilizáis un tchart para ir visualizando los valores calculados en cada iteración se puede ver gráficamente cómo poco a poco se va ajustando la curva de valores calculados respecto a la curva de valores reales (es impresionante)

Marketing para la venta de software online

Después de haber desarrollado un buen proyecto de software en Delphi, una de las opciones que tenemos es intentar obtener un rendimiento económico que nos compense por el tiempo y el esfuerzo invertido en su programación, desarrollo y puesta a punto.

Ahí es donde interviene el marketing (mercadotecnia).

Marketing según la R.A.E. es el conjunto de principios y prácticas que buscan el aumento del comercio, especialmente de la demanda.

Pues bien, hace unos días di con este video de una charla que dio Wil Shipley, cofundador de delicious monster, donde se tratan con mucha profundidad y detalle aspectos esenciales en el proceso de venta de software para mac online, aunque creo que se puede aplicar a casi cualquier producto intangible que se venda en internet.

Lamentablemente hay que saber inglés y disponer de una hora y media para verlo entero, pero vale la pena, Wil es gracioso y toca temas intersantes, como la creación del “hype”, como NO combatir la piratería, como anunciarse, etc.

Video: Monster marketing por Wil Shipley

Vía: Cocoia blog

Redes neuronales con Delphi - Neural net with Delphi

En este post os presento el componente TFFNN que os ayudará a realizar redes neuronales.

Utiliza el algoritmo de retropropagación o propagación hacia atrás de los errores (en inglés backpropagation), método usado habitualmente para el entrenamiento de redes.



Se puede descargar desde aquí



www.datalandsoftware.com/files/ffnn.zip



Descomprimimos el componente sobre una carpeta llamada (p.ej) "redes neuronales" y desde nuestro Delphi accedemos a

File->Open



Seleccionamos FFNNPackage.dpk de la carpeta "redes neuronales" y pulsamos "Abrir"



En el ProjectGroup1 hacemos clic con el botón derecho del ratón sobre FNNPackage.bpl y activamos el menú "Install"









Con lo que se instalará el componente TFFNN en la pestaña "Dataland" de la paleta de componentes.

Guardamos y cerramos el ProjectGroup1 con File->Save All, y después File->Close.

Ahora vamos a crear una nueva aplicación de prueba:

File->New-> VCL Forms Application - Delphi for Win32





Arrastramos de la paleta de componentes (pestaña "dataland") "TFFNN" a nuestro Form, creamos un TMemo, y 4 botones (Entrenar, Mostrar, Cargar patrón de entrenamiento, Guardar patrón de entrenamiento)











Después tendremos que indicar los parámetros de nuestra red neuronal:

InputCount (Nº de entradas)=1

InputMax (Máximo número de entradas)=8

InputMin (Mínimo número de entradas)=-1

OutputCount (Nº de salidas)=1

OutputMax (Máximo número de salidas)=10

OutputMin (Mínimo número de salidas)=9

En NLayers indicaremos el número de capas de nuestra red (En este caso tendrá sólo una capa) y el número de neuronas de cada capa=2

Hay que indicar que cuanto mayor sea el número de capas y de neuronas más tiempo tardará la red en conseguir un entrenamiento óptimo.





OBJETIVO DE LA RED

Es la simulación de la función: y= 10 + x





DEFINICIÓN DE BOTONES:

Botón "Cargar patrón de entrenamiento":

FFNN1.LoadFromFile('redneural1.txt');



Botón "Guardar patrón de entrenamiento":

FFNN1.SaveToFile('redneural1.txt');



RedNeural1.txt es un fichero de texto con los parámetros y variables de nuestra red neuronal, que no hay que modificar bajo ningún concepto.



Botón "Entrenar":

procedure TForm1.EntrenarClick(Sender: TObject);
var
i: Integer;
begin
for i:=1 to 10000 do begin

FFNN1.Input[1]:=i mod 7; //Pone la entrada
FFNN1.DesiredOutput[1]:=func( i mod 7 ); //Pone lo que queremos que salga
FFNN1.BackProp; //Entrena la red con este par de valores(In, Out).
{ Cuando se usan vectores: Input, Output y DesiredOutput usan índices entre 1 y Count (Input[1], Input[2], Output[1]...
Los índices: Input[0], Output[0] y DesiredOutput[0] son reservados por la aplicación }
end;
end;

Quizás en este caso no sea necesario llegar a que el índice del bucle "i" llegue a 10000 ya que lo que se hace es que cuando el valor del error cuadrático medio sea menor que 0,01 (P.ej) se detenga el cálculo.

El Error cuadrático medio se calcula desde FFNN1.GetAvgError







Botón "Mostrar":

procedure TForm1.MostrarClick(Sender: TObject);
var
r, t: Real;
i: Integer;
begin
for i:=0 to 6 do begin
r:=i;
FFNN1.Input[1]:=r; //Pone un valor a la neurona de entrada nº 1
FFNN1.CalcOut; //Calcula la salida de la red neuronal. Después de esta linea podremos leer la salida
t:=FFNN1.Output[1];
FFNN1.DesiredOutput[1]:=func( i ); //Calculamos el valor que deseamos tenga en la salida
Memo1.Lines.Add(Format('%f %f %f %f', [r, t, FFNN1.GetAvgError, FFNN1.GetMaxError]));
//Ambos errores son los mismos ya que tenemos 1 output (Avg = Max)
end;
end;

function TForm1.func(x: Real): Real;
begin
//Entrenamos a la red para reproducir esta función
Result:=10 + x;
end;

Abajo os muestro los resultados después de entrenar a la red, como véis los resultados obtenidos se parecen bastante a los esperados con lo que podemos afirmar que la red ha sido entrenada correctamente.

Ahora debemos guardar los parámetros de la red con FFNN1.SaveToFile('redneural1.txt'), de tal forma que la próxima vez que queramos simular la función y=10+x no sea necesario entrenarla ya que bastaría con cargar el patrón de red previamente guardado con FFNN1.LoadFromFile('redneural1.txt').

Como hacer hablar a Delphi - How to make Delphi to speak

Para que nuestras aplicaciones en Delphi puedan "hablar" lo primero que tenemos que hacer es guardar en la paleta "Additional" todos los componentes de la librería "Microsoft Speech Object Library" de la siguiente forma:

Ir a File->New-> Package Delphi for win 32

en el menú Component->Import Component y seleccionar "Import a type library"




Pulsar "Next>>" y en la relación de librerías registradas en tu sistema seleccionar

"Microsoft Speech Object Library" y pulsar "Next"

En la ventana siguiente indicar en Palette Page el item "additional" que es donde se guardarán cada uno de los componentes de esta librería

En la ventana siguiente marca "Add unit to ...."

y pulsa el botón "Finish"

Ahora vamos a cambiar el nombre al Package1.bpl y lo llamaremos SAPI.BPL

Pulsamos con el botón derecho del ratón sobre SAPI.BPL y ejecutamos el menú

"Compile" y después "Install"

Con lo que tendremos en la paleta "Additional" todos los componentes de la librería Microsoft Speech Object Library

Para que nuestra aplicación pueda reproducir voces (por ahora en inglés)

Tenemos que arrastrar el componente TSpVoice de la paleta "Additional" a nuestro Form y crear un botón con el siguiente código



procedure TForm1.Button1Click(Sender: TObject);

begin

spvoice1.Speak('hello who are you',0)

end;

How to convert a web app to use AJAX using D4PHP

How to update a MySQL DB with AJAX using D4PHP

GRN and CodeGear Delphi: King of Languages

Some Code Editor and Refactoring features in CodeGear Delphi

CodeGear C++ Builder... True RAD

ECO VCL.NET development with CodeGear RAD Studio

Build a Wordpad-like application with Delphi