【奉上100分寻求问题的解决方案】

[ShadowPgxun]

急需Win98/2000下可行的多线程扫描Web服务器（即端口80）的Delphi源代码！

源代码请发E-Mail到：[e-mail]

一经核实，即刻结贴分配分数！

[huojiehai]

这是一个HTTP代理的例子，可以清楚看到用户上网的所有信息，包括登录的密码，用户，太恐怖了

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
RXShell, Menus, StdCtrls, ExtCtrls, ScktComp;
type
session_record=record
Used:boolean;
SS_Handle:integer;
CSocket:Tclientsocket;
Lookingup:boolean;
LookupTime:integer;
Request:boolean;
request_str:string;
client_connected:boolean;
remote_connected:boolean;
end;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
ClientSocket1: TClientSocket;
Timer1: TTimer;
Label1: TLabel;
Edit1: TEdit;
Memo1: TMemo;
PopupMenu1: TPopupMenu;
menuopen: TMenuItem;
menuclose: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
RxTrayIcon1: TRxTrayIcon;
N3: TMenuItem;
N4: TMenuItem;
btopen: TButton;
btclose: TButton;
Button3: TButton;
bthide: TButton;
menuhide: TMenuItem;
Button1: TButton;
procedure AppException(sender:TObject;e:Exception);
procedure menuopenClick(Sender: TObject);
procedure menucloseClick(Sender: TObject);
procedure menuexit(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Write(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
procedure bthideClick(Sender: TObject);
procedure menuhideClick(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
Server_Enabled:boolean;
session:array of session_record;
sessions:integer;
LookupTimeOut:integer;
InvalidRequests:integer;
end;

[huojiehai]

var
Form1: TForm1;

implementation

{$R *.DFM}
procedure TForm1.AppException (sender:TObject;E:Exception);
begin
//
end;
procedure TForm1.menuopenClick(Sender: TObject);
begin
serversocket1.active:=true;
end;

procedure TForm1.menucloseClick(Sender: TObject);
begin
serversocket1.Active :=false;
server_enabled:=false;
menuopen.Enabled :=true;
btopen.Enabled :=true;
menuclose.Enabled :=false;
btclose.Enabled :=false;
end;

procedure TForm1.menuexit(Sender: TObject);
begin
application.Terminate ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
server_enabled:=false;
sessions:=0;
invalidrequests:=0;
LookupTimeOut:=60000;
timer1.Enabled :=true;
menuopen.Enabled :=false;
btopen.Enabled :=false;
menuclose.Enabled :=true;
btclose.Enabled :=true;
serversocket1.Port :=988;
serversocket1.Active :=true;
//application.OnActionExecute :=appexception;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timer1.Enabled :=false;
if server_enabled then serversocket1.Active:=false;
end;

procedure TForm1.ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
server_enabled:=true;
menuopen.Enabled :=false;
btopen.Enabled :=false;
menuclose.Enabled :=true;
btclose.Enabled :=true;
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var i,j:integer;
begin
j:=-1;
for i:=1 to sessions do
if not session[i-1].Used and not session[i-1].CSocket.active then
begin
j:=i-1;
session[j].Used :=true;
break;
end
else
if not session[i-1].Used and session[i-1].CSocket.active then session[j].CSocket .active:=false ;
if j=-1 then
begin
j:=sessions;
inc(sessions);
setlength(session,sessions);
session[j].Used :=true;
session[j].CSocket :=Tclientsocket.Create (nil);
session[j].CSocket.onconnect:=clientsocket1connect;
session[j].CSocket.ondisconnect:=clientsocket1disconnect;
session[j].CSocket.onerror:=clientsocket1error;
session[j].CSocket.onread:=clientsocket1read;
session[j].CSocket .onwrite:=clientsocket1write;
session[j].CSocket .onlookup:=clientsocket1lookup;
session[j].CSocket .onconnecting:=clientsocket1connecting;
session[j].lookingup:=false;
end;
session[j].SS_Handle :=socket.SocketHandle ;
session[j].Request :=false;
session[j].client_connected :=true;
session[j].remote_connected :=false;
edit1.Text :=inttostr(sessions);
end;

[huojiehai]

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var i,j,k:integer;
begin
for i:=1 to sessions do
if (session[i-1].SS_Handle =socket.sockethandle) and session[i-1].Used then
begin
session[i-1].client_connected :=false;
if session[i-1].remote_connected then
session[i-1].CSocket.active:=false
else
session[i-1].Used :=false;
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do
begin
if session[j-i].Used then break;
inc(k);
end;
if k>0 then
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.Text :=inttostr(sessions);
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var i:integer;
begin
for i:=1 to sessions do
if (session[i-1].Csocket.socket.sockethandle=socket.SocketHandle) and session[i-1].Used then
begin
session[i-1].CSocket.tag:=socket.sockethandle;
session[i-1].remote_connected :=true;
session[i-1].Lookingup :=false;
break;
end;
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j,k:integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle ) and session[i-1].Used then
begin
session[i-1].remote_connected :=false;
if not session[i-1].client_connected then
session[i-1].Used :=false
else
for k:=1 to serversocket1.Socket.ActiveConnections do
if (serversocket1.Socket.Connections [k-1].SocketHandle =session[i-1].SS_Handle ) and session[i-1].Used then
begin
serversocket1.Socket.Connections[k-1].Close ;
break;
end;
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do
begin
if session[j-i].Used then
break;
inc(k);
end;
if k>0 then
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
i,j,k:integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle ) and session[i-1].Used then
begin
socket.Close ;
session[i-1].remote_connected :=false;
if not session[i-1].client_connected then
session[i-1].Used :=false
else
for k:=1 to serversocket1.Socket.ActiveConnections do
if (serversocket1.Socket.Connections[k-1].SocketHandle =session[i-1].SS_Handle ) and session[i-1].Used then
begin
serversocket1.Socket.Connections [k-1].Close;
break;
end;
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do
begin
if session[j-i].Used then
break;
inc(k);
end;
errorcode:=0;
if k>0 then
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.Text :=inttostr(sessions);
end;

procedure TForm1.ClientSocket1Write(Sender: TObject;
Socket: TCustomWinSocket);
var i:integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle ) and session[i-1].Used then
begin
if session[i-1].Request then
begin
socket.SendText(session[i-1].request_str);
session[i-1].Request :=false;
end;
break;
end;
end;

[huojiehai]

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j,rec_bytes:integer;
rec_buffer:array[0..2047] of char;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle ) and session[i-1].used then
begin
rec_bytes:=socket.ReceiveBuf (rec_buffer,2048);
for j:=1 to serversocket1.Socket.ActiveConnections do
if serversocket1.Socket.Connections [j-1].SocketHandle =session[i-1].SS_Handle then
begin
serversocket1.Socket.Connections [j-1].SendBuf (rec_buffer,rec_bytes);
break;
end;
break;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i,j:integer;
begin
for i:=1 to sessions do
if session[i-1].Used and session[i-1].Lookingup then
begin
inc(session[i-1].LookupTime );
if session[i-1].LookupTime >lookuptimeout then
begin
session[i-1].Lookingup :=false;
session[i-1].CSocket.active:=false;
for j:=1 to serversocket1.socket.activeconnections do
if serversocket1.Socket.Connections[j-1].sockethandle=session[i-1].ss_handle then
begin
serversocket1.socket.connections[j-1].close;
break;
end;
end;
end;

end;


procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var i,j,k:integer;
begin
for i:=1 to sessions do
if (session[i-1].SS_Handle=socket.sockethandle) and session[i-1].Used then
begin
session[i-1].client_connected:=false;
if session[i-1].remote_connected then
session[i-1].CSocket.active:=false
else
session[i-1].Used:=false;
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do
begin
if session[j-i].Used then
break;
inc(k);
end;
if k>0 then
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
errorcode:=0;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
tmp,line,host:string;
i,j,port:integer;
begin
for i:=1 to sessions do
if session[i-1].Used and (session[i-1].SS_Handle=socket.sockethandle) then
begin
session[i-1].request_str:=socket.receivetext;
tmp:=session[i-1].request_str;
memo1.lines.add(tmp);
j:=pos(char(13)+char(10),tmp);
while j>0 do begin
line:=copy(tmp,1,j-1);
delete(tmp,1,j+1);
j:=pos('Host',line);
if j>0 then
begin
delete(line,1,j+5);
j:=pos(':',line);
if j>0 then
begin
host:=copy(line,1,j-1);
delete(line,1,j-1);
try
port:=strtoint(line);
except
port:=80
end;
end
else
begin
host:=trim(line);
port:=80;
end;
if not session[i-1].remote_connected then
begin
session[i-1].request:=true;
session[i-1].CSocket.host:=host;
session[i-1].CSocket.port:=port;
session[i-1].CSocket.active:=true;
session[i-1].lookingup:=true;
session[i-1].lookuptime:=0;
end
else
session[i-1].Csocket.socket.sendtext(session[i-1].request_str);
break;
end;
j:=pos(char(13)+char(10),tmp);
end;
break;
end;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
form1.Show;
end;

procedure TForm1.RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
form1.Show;
end;

procedure TForm1.ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
begin
//
end;

procedure TForm1.bthideClick(Sender: TObject);
begin
form1.Hide ;
end;

procedure TForm1.menuhideClick(Sender: TObject);
begin
form1.Hide ;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
if form1.WindowState =wsminimized then showmessage('aaaa');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
form1.WindowState :=wsminimized;
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
//
end;

end.

[leapmars]

mark

[ShadowPgxun]

To huojiehai(海天子) ：
非常感谢你的回复！ 你回答的也确实非常“恐怖”（“光用看的就要看上半年吧”，呵呵）。分配分数时，我会记住你的。

不过，大侠回答的好像有些文不对题。我需要的是【多线程扫描Web服务器IP的 Delphi源码】，不好意思，请继续回复，谢谢！

请大家多多帮忙！

[nhdj]

晕，搂主真是贪心阿，这还不够

[dickeybird888]

(@ * @)