网上抄下来的。
原来的作者是：深圳市福田区联合广场41楼恒星威电子有限公司GPS部 艾真保 518026
mailto:Aizb@aidelphi.com
HomePage:
http://www.aidelphi.com}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,WInSock, ExtCtrls,ScktComp;
const WM_SOCKET=WM_USER+1; //socket消息
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
Label1: TLabel;
EditConnecting: TEdit;
EditConnected: TEdit;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
Sockhd : integer; //socket句柄
Serv_Addr : Tsockaddr;//目标地址
procedure SockEvent(var msg: TCMSocketMessage);message WM_SOCKET; //处理cocket消息
procedure DspMsg(msg : string); //显示信息
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
Uses Consts;
{$R *.DFM}
function lookup_hostname(const hostname:string):longint; //把域名转化成IP地址
var
RemoteHost : PHostEnt; (* no, don't free it! *)
ip_address: longint;
begin
ip_address:=-1;
try
if hostname='' then
begin (* no host given! *)
lookup_hostname:=ip_address;
EXIT;
end else
begin
ip_address:=Winsock.Inet_Addr(PChar(hostname)); (* try a xxx.xxx.xxx.xx first *)
if ip_address=SOCKET_ERROR then
begin
RemoteHost:=Winsock.GetHostByName(PChar(hostname));
if (RemoteHost=NIL) or (RemoteHost^.h_length<=0) then
begin
lookup_hostname:=ip_address;
EXIT; (* host not found *)
end else
ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
end;
end;
except
ip_address:=-1;
end;
lookup_hostname:=ip_address;
end;
procedure TFOrm1.DspMsg(msg: string);
begin
memo1.Lines.Add(msg);
end;
function CheckSocketResult(ResultCode: Integer; const Op: string): Integer;
begin
if ResultCode <> 0 then
begin
Result := WSAGetLastError;
if Result <> WSAEWOULDBLOCK then
raise ESocketError.CreateResFmt(@sWindowsSocketError,[SysErrorMessage(Result), Result, Op]);
end else Result := 0;
end;
procedure TForm1.SockEvent(var msg : TCMSocketMessage); //处理socket消息
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Size:=0;
case msg.SelectEvent of
FD_READ:
begin //标识可以读数据,当然肯定已经链接上了
Size := SizeOf(SockAddrIn);
getpeername(msg.Socket, SockAddrIn, Size);//, 'getpeername');
if ntohs(SockAddrIn.sin_port)<>0 then
dspmsg('可以读取数据 Port:'+IntToStr(ntohs(SockAddrIn.sin_port))+' IP:'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b1))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b2))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b3))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b4)));
//do what you want do
end;
FD_WRITE:
begin
Size := SizeOf(SockAddrIn);
getpeername(msg.Socket, SockAddrIn, Size);//, 'getpeername');
if ntohs(SockAddrIn.sin_port)<>0 then
dspmsg('可以发送数据 Port:'+IntToStr(ntohs(SockAddrIn.sin_port))+' IP:'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b1))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b2))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b3))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b4)));
//do what you want do
end;
FD_CLOSE:
Begin
Size := SizeOf(SockAddrIn);
getpeername(msg.Socket, SockAddrIn, Size);//, 'getpeername');
if ntohs(SockAddrIn.sin_port)<>0 then
dspmsg('服务器断开连接 Port:'+IntToStr(ntohs(SockAddrIn.sin_port))+' IP:'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b1))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b2))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b3))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b4)));
//对方关闭连接
end;
FD_CONNECT:
begin
Size := SizeOf(SockAddrIn);
getpeername(msg.Socket, SockAddrIn, Size);//, 'getpeername');
if ntohs(SockAddrIn.sin_port)<>0 then
dspmsg('连结服务器 Port:'+IntToStr(ntohs(SockAddrIn.sin_port))+' IP:'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b1))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b2))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b3))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b4)));
//表示对方端口开放
end;
FD_ACCEPT:
begin
Size := SizeOf(SockAddrIn);
getpeername(msg.Socket, SockAddrIn, Size);//, 'getpeername');
if ntohs(SockAddrIn.sin_port)<>0 then
dspmsg('接收一个请求 Port:'+IntToStr(ntohs(SockAddrIn.sin_port))+' IP:'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b1))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b2))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b3))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b4)));
// dspmsg('接收一个请求');
//这个消息只有服务端可能出现
end;
else
begin
Size := SizeOf(SockAddrIn);
getpeername(msg.Socket, SockAddrIn, Size);//, 'getpeername');
if ntohs(SockAddrIn.sin_port)<>0 then
dspmsg('未知请求 Port:'+IntToStr(ntohs(SockAddrIn.sin_port))+' IP:'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b1))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b2))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b3))+'.'+IntToStr(ORD(SockAddrIn.sin_addr.S_un_b.s_b4)));
end;
end;
if ntohs(SockAddrIn.sin_port)>0 then
begin
Application.ProcessMessages;
EditConnected.Text:=IntToStr(ntohs(SockAddrIn.sin_port));
end;
closesocket(msg.Socket);
end;
procedure TForm1.FormCreate(Sender: TObject);
var wsaData:TwsaData;
begin //启动winsock动态链接库
Memo1.Clear;
if WSAStartup (makeword(2,2), wsaData)<>0 then
begin
messagebox(application.handle,'无法启动winsock动态连接库!','警告',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
Application.Terminate;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin //关闭dll
WSACleanup;
end;
procedure TForm1.Button1Click(Sender: TObject);
Var i:Integer;
begin
Memo1.Clear;
DspMsg('Get IP Address');
Serv_addr.sin_addr.s_addr:= lookup_hostname(edit1.Text); //主机名
if Serv_addr.sin_addr.s_addr=-1 then
begin
DspMsg('Get IP Address error!');
Exit;
end;
Serv_addr.sin_family := PF_INET;
For i:=0 to 32767 do
begin
Sockhd := socket(AF_INET,SOCK_STREAM,0); //创建socket句柄
if Sockhd<0 then
begin
messagebox(application.handle,'无法创建句柄!','警告',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
exit;
end;
if WSAAsyncSelect(Sockhd,handle,WM_SOCKET,{FD_ACCEPT or }FD_CONNECT{ or FD_CLOSE or FD_READ or FD_WRITE})=SOCKET_ERROR
then
begin
messagebox(application.handle,'无法创建句柄!','警告',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
exit;
end; //异步socket
Serv_addr.sin_port := htons(i); //any port you want to connect
EditConnecting.Text:=IntToStr(i);
Application.ProcessMessages;
connect(sockhd,serv_addr,sizeof(serv_addr)); //连接,结果会在前面的处理函数处理
end;
end;
end.
