Подскажите не вредоносный-ли это код!?

Подскажите, что за код такой и что он делает?

unit uLoad;

interface

uses

Classes, SysUtils, Windows, Messages, Forms, Controls,

DB, FIBQuery, pFIBQuery, FIBDatabase, pFIBDatabase,

MSHTML, ActiveX, SHDocVw_EWB, EmbeddedWB;

type

TBlockInfo = record

id: String;

UserName: String;

URL: String;

end;

TLoad = class(TThread)

private

fUserName: String;

fPassword: String;

fDelayNavigate: Integer;

fDelayView: Integer;

fFormHandle, FH: THandle;

WB: TEmbeddedWB;

Doc: IHTMLDocument2;

Disp: IDispatch;

Col: IHTMLElementCollection;

El: IHTMLElement;

DB: TpFIBDatabase;

TR: TpFIBTransaction;

QI, QS: TpFIBQuery;

URL: String;

limit: Integer;

Info: array of TBlockInfo;

procedure WndProc(var Message: TMessage);

protected

procedure Execute; override;

public

procedure ProcessMessages;

procedure WaitWB;

procedure FillForm;

function CheckLogin: Boolean;

property MainFormHandle: THandle read fFormHandle write fFormHandle;

property UserName: String read fUserName write fUserName;

property Password: String read fPassword write fPassword;

property DelayNavigate: Integer read fDelayNavigate write fDelayNavigate;

property DelayView: Integer read fDelayView write fDelayView;

function ProcessMessage(var Msg: TMsg): Boolean;

end;

implementation

uses Math;

function TLoad.ProcessMessage(var Msg: TMsg): Boolean;

begin

Result := False;

if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then

begin

Result := True;

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

end;

procedure TLoad.ProcessMessages;

var LMsg: TMsg;

begin

while ProcessMessage(LMsg) do;

end;

procedure TLoad.SendLog(S: String);

var cd: TCopyDataStruct;

begin

S := FormatDateTime('hh:nn:ss zzz', now) + ' ' + S;

cd.cbData := Length(S) + 1;

cd.lpData := PChar(S);

SendMessage(fFormHandle, WM_COPYDATA, 0, LParam(@cd));

end;

procedure TLoad.WndProc(var Message: TMessage);

begin

Message.Result := DefWindowProc(FH, Message.Msg, Message.WParam, Message.LParam);

end;

procedure TLoad.WaitWB;

begin

while not WB.Busy do

begin

ProcessMessages;

Sleep(100);

end;

while WB.Busy do

begin

ProcessMessages;

Sleep(100);

end;

end;

// ----------------------------------------------------------------------------

// ----------------------------------------------------------------------------

procedure TLoad.Execute;

var

i, j: Integer;

begin

FreeOnTerminate := true;

CoInitializeEx(nil, COINIT_APARTMENTTHREADED);

FH := AllocateHWnd(WndProc);

WB:= TEmbeddedWB.Create(nil);

TWinControl(WB).ParentWindow := FH;

TWinControl(WB).HandleNeeded;

WB.DownloadOptions := [DontDownloadActiveX, DontExecuteActiveX, DontExecuteJava, DontExecuteScripts];

WB.UserAgent := 'FireFox';

DB := TpFIBDatabase.Create(nil);

TR := TpFIBTransaction.Create(nil);

QI := TpFIBQuery.Create(nil);

QS := TpFIBQuery.Create(nil);

QS.SQL.Text := 'SELECT Count(id) FROM ACCOUNT WHERE ID_USER = :ID_USER';

QI.SQL.Text := 'INSERT INTO ACCOUNT (LastVisit, Name, ID_USER) VALUES (:LastVisit, :Name, :ID_USER);';

with DB do

begin

DatabaseName := ExtractFilePath(ParamStr(0)) + 'ODNOKLASSNIKI.FDB';

if not FileExists(DatabaseName) then

begin

SendLog('Не найден файл Базы Данных!' + #13 + DatabaseName);

Terminate;

end;

LibraryName := 'fbclient.dll';

ConnectParams.UserName := 'SYSDBA';

ConnectParams.Password := 'masterkey';

ConnectParams.CharSet := 'WIN1251';

SQLDialect := 3;

DefaultTransaction := TR;

end;

TR.DefaultDatabase := DB;

TR.TRParams.Clear;

TR.TRParams.Add('write');

TR.TRParams.Add('nowait');

TR.TRParams.Add('rec_version');

TR.TRParams.Add('read_committed');

DB.Open;

QI.Database := DB;

QI.Transaction := TR;

QS.Database := DB;

QS.Transaction := TR;

DB.Open;

try

try

Login;

except

on E: Exception do

SendLog('Ошибка! ' + E.Message);

end;

limit := 0; //

repeat

until Terminated;

finally

if TR.InTransaction then TR.Commit;

QS.Free;

QI.Free;

DB.Close;

TR.Free;

DB.Free;

WB.Free;

DeallocateHWnd(FH);

CoUninitialize;

end;

end;

end.