I agree to Treatid! He is right!!!

Here is the sourcecode of the tool. Show me the line that adds something to the registry and you've won $1000!!!

Small utilities don't neen new entries in the registry if they don't have options which must be saved. And a programmer can choose how he wants to save the options! The registry or a file.
Did you see any options which I could save?

Kamil


Here is the sourcecode:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, GWebCache, AsUrlLabel, Menus, ShellAPI, GnuCon,
ComCtrls, ScktComp, ExtCtrls;

const
WM_KILLSOCKET = WM_USER + $100;

type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
AsUrlLabel1: TAsUrlLabel;
MainMenu1: TMainMenu;
File1: TMenuItem;
Start1: TMenuItem;
Stop1: TMenuItem;
N1: TMenuItem;
Help1: TMenuItem;
Help2: TMenuItem;
Homepage1: TMenuItem;
StatusBar1: TStatusBar;
GWebCache1: TGWebCache;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure GWebCache1VerifiedHost(Sender: TObject; IP: String;
Port: Integer);
procedure ListBox1Click(Sender: TObject);
procedure Edit1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure Start1Click(Sender: TObject);
procedure Stop1Click(Sender: TObject);
procedure Homepage1Click(Sender: TObject);
procedure Help2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
num:integer;
total:integer;
active:integer;
SocketList:TList;
procedure OnSockEventError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure KillSocket(var Message: TMessage); message WM_KILLSOCKET;
procedure OnSockConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure OnSockDisconnect(Sender: TObject; Socket: TCustomWinSocket);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if Button1.Caption='Start' then
begin
GWebCache1.Start;
StatusBar1.Panels.Items[0].Text:='Searching...';
Button1.Caption:='Stop';
end
else
begin
GWebCache1.Stop;
StatusBar1.Panels.Items[0].Text:='';
Button1.Caption:='Start';
end;
end;

procedure TForm1.GWebCache1VerifiedHost(Sender: TObject; IP: String;
Port: Integer);
var
c:TClientSocket;
begin
inc(total);
inc(active);
c:=TClientSocket.Create(self);
SocketList.Add(TObject(c));
c.Host:=IP;
c.Port:=Port;
c.OnConnect:=OnSockConnect;
c.OnError:=OnSockEventError;
c.OnDisconnect:=OnSockDisconnect;
c.Open;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
i:integer;
begin
for i:=0 to ListBox1.Items.Count-1 do
if ListBox1.Selected[i] then
begin
Edit1.Text:=copy(ListBox1.Items[i],1,pos(':',ListBox1.Items[i])-1);
Edit2.Text:=copy(ListBox1.Items[i],pos(':',ListBox1.Items[i])+1,length(ListBox1.Items[i]));
end;
end;

procedure TForm1.Edit1Click(Sender: TObject);
begin
(Sender AS TEdit).SelectAll;
(Sender AS TEdit).CopyToClipboard;
(Sender AS TEdit).SelLength:=0;;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Start1Click(Sender: TObject);
begin
GWebCache1.Start;
StatusBar1.Panels.Items[0].Text:='Searching...';
Button1.Caption:='Stop';
end;

procedure TForm1.Stop1Click(Sender: TObject);
begin
GWebCache1.Stop;
StatusBar1.Panels.Items[0].Text:='';
Button1.Caption:='Start';
end;

procedure TForm1.Homepage1Click(Sender: TObject);
begin
ShellExecute(Application.MainForm.Handle,NIL,PChar ('http://delphi.pogorzelski.de'),'','',SW_MAXIMIZE)
end;

procedure TForm1.Help2Click(Sender: TObject);
begin
Form2.ShowModal;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
num:=0;
total:=0;
active:=0;
SocketList:=TList.Create;
end;

procedure TForm1.OnSockEventError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
Socket.Close;
PostMessage(Handle, WM_KILLSOCKET, 0, lParam(Sender));
ErrorCode:=0;
end;

procedure TForm1.KillSocket(var Message: TMessage);
var
i:integer;
begin
try
i:=SocketList.IndexOf(TObject(Message.LParam));
if i<>-1 then
begin
SocketList.Items[i]:=nil;
TObject(Message.LParam).Free;
dec(active);
end;
finally
try
except
end;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i:integer;
begin
GWebCache1.Stop;
while SocketList.Count>0 do
begin
SocketList.Pack;
Application.ProcessMessages;
Sleep(10);
for i:=SocketList.Count-1 downto 0 do
begin
try
if SocketList.Items[i]<>nil then
SendMessage(Handle, WM_KILLSOCKET, 0, lParam(SocketList.Items[i]));
except;
end;
end;
end;
SocketList.Free;
Action:=caFree;
end;

procedure TForm1.OnSockConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
ListBox1.Items.Add(Socket.RemoteAddress+':'+IntToS tr(Socket.RemotePort));
inc(num);
StatusBar1.Panels.Items[1].Text:=inttostr(Num)+' IPs found of '+inttostr(total)+' (active: '+inttostr(active)+')';
Socket.Close;
PostMessage(Handle, WM_KILLSOCKET, 0, lParam(Sender));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels.Items[1].Text:=inttostr(Num)+' IPs found of '+inttostr(total)+' (active: '+inttostr(active)+')';
end;

procedure TForm1.OnSockDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
PostMessage(Handle, WM_KILLSOCKET, 0, lParam(Sender));
end;

end.