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: