delphi端口扫描源程序

{
  ------------------------------------------------
     本程序由“啊D”制作!
     QQ:9269563
     E-Mail:paf@163.net
     主页:Http://coold.cn99.com
     制作于:2002.8.27

  **你可以随意修改代码! 但在转载时请保留此声名!**
  ------------------------------------------------
}
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, ComCtrls,winsock,SearchPortThread, Spin;

type
  TForm1 = class(TForm)
    M1: TMemo;
    Port1: TEdit;
    Port2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Search: TSpeedButton;
    SB1: TStatusBar;
    MaxThread: TSpinEdit;
    Label4: TLabel;
    IP: TComboBox;
    AboutButton: TSpeedButton;
    procedure SearchClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure AboutButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    procedure Search_ST;
    procedure ThreadDone(Sender: TObject);
    procedure Search_Exit;
    function HostNameToIP(S: string): DWord;
    procedure AddComboBox(CB: TcomboBox);
    procedure SearchOK;
      { Private declarations }
  public
    ThreadList: array of TSearchPortThread;   //线程数组
    Portlist:Tlist; //线程要用到的Strings
    PortIndex:integer; //正在处理的端口号
    MaxPort,MinPort:integer; //保存最大和最小的端口号的变量
    addr:Tsockaddr; //
    About:string; //关于
    StopThread:boolean; //停止线程标记

    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{
=============================
=          自定义函数       =
=============================
}

//==== 开始扫描 ====
procedure TForm1.Search_ST();
var
i,j:integer;
Address: DWord;
begin
try
//-- 检测部分 --
Address := HostNameToIP(PChar(IP.text));// 检测IP是否有效!
if (Address = INADDR_NONE) then begin
    showmessage('输入的IP、域名无效或网络不通!');
    exit;
end;

if MaxThread.Value < 2 then begin //检测线程数
    showMessage('线程数请选择 2-300 之间的值!');
    exit;
end;

Maxport:=strtoint(port2.text); //最大端口号
Minport:=strtoint(port1.text); //最小端口号
PortIndex:=Minport;

if Minport > Maxport then begin
    showMessage('[开始端口]不能大于[结束端口]的值!');
    exit;
end;
//端口范围检测
if (minport < 1) or (minport >65535) or (Maxport < 1) or (Maxport >65535) then begin
    showMessage('输入数值超过了指定的范围!'#13#10'数值范围:1-65535');
    exit;
end;
//------扫描部分-------
search.Caption := '停止扫描';
search.tag :=1;
AddComboBox(IP); //把IP或域名加入列表!
m1.lines.Clear;
m1.Lines.Add('正在扫描: ' + ip.text + #13#10'[端口] | [说明]'#13#10'-------------------------------------');
m1.Update;
  SetLength(ThreadList,MaxThread.Value);  //创建 MaxThread.Value 个线程数组
  if (length(threadlist) >1) then j:=length(threadlist)-1;
  if (maxport-minport)<j then j:=maxport-minport;

  for i:=0 to j do
  begin
    addr.sin_family:=AF_INET; //
    addr.sin_addr.S_addr:=Address;  //地址
    addr.sin_port:=htons(PortIndex); //端口

    threadlist[i]:=TSearchPortThread.Create(m1,addr);  //创建线程1
    threadlist[i].OnTerminate :=ThreadDone; //线程处理完后要处理的事
    Portlist.Add(threadlist[i]);  //把线程加入 Portlist
    sb1.Panels[0].Text :=format('已扫描端口: %s',[inttostr(Portindex)]);
    PortIndex:=PortIndex+1;
end;
//出错处理代码
except
showMessage('出错了!');
end;
end;
//===== END =====

//==== 线程退出代码 ======
procedure TForm1.ThreadDone(Sender: TObject);
var
Index:integer;
begin
try

if (PortIndex >= maxport) and (StopThread=false) then begin
    SearchOK();
    StopThread:=true;
    exit;
end;
if (PortIndex > maxport) or (StopThread = true) then exit;

Index := PortList.IndexOf(Sender); //在Filst 中查找刚才的线程对象
PortList.Delete(Index);

addr.sin_port:=htons(portindex); //端口
threadlist[Index]:=TSearchPortThread.Create(m1,addr);  //创建线程1
threadlist[Index].OnTerminate :=ThreadDone; //线程处理完后要处理的事
Portlist.Add(threadlist[Index]);  //把线程加入 Portlist
sb1.Panels[0].Text :='已扫描端口: ' + inttostr(Portindex);
PortIndex:=PortIndex+1;
except //错误处理
//    sb1.Panels[0].Text :='程序出错[线程退出]!';
end;
end;
//===== END =====

//==== 停止扫描 =====
Procedure Tform1.Search_Exit;
var
i:integer;
temp:TSearchPortThread;
begin
try
 m1.Lines.Add('[ 用户中断 ]');
 sb1.Panels[0].Text :='正在关闭线程.....';
for i:=0 to portlist.Count  - 1 do
begin
    temp:=portlist.Items[i];
    temp.Terminate;  //结束线程
end;
      SearchOK(); //显示开始扫描
      StopThread:=true; //StopThread为真，为停止扫描

except //错误处理
//   sb1.Panels[0].Text :='程序出错[停止扫描]!';
end;
end;
//===== END =====

// ===== 扫描完成 =========
procedure Tform1.SearchOK();
begin
      search.Caption :='开始扫描';
      search.Enabled :=true;
      search.tag:=0;
      sb1.Panels[0].Text :='扫描完成';
      m1.Lines.Add('-------------------------------------'#13#10'扫描完成!');
      portlist.Free;//释放PortList的内存空间
end;
//==== END ====

//==== 域名、IP自动转为IP ====
function TForm1.HostNameToIP(S:string):DWord;
const
  INADDR_NONE = $FFFFFFFF;
var
Host:pHostent;
Address:DWord;
begin
Address := inet_addr(PChar(S));
if (Address = INADDR_NONE) then begin
   Host:=GetHostByName(Pchar(S));
   if Host = nil then begin
        HostNameToIP:=INADDR_NONE;
        exit;
   end
   else begin
        hostNametoip:=longint(pointer(Host^.h_addr_list^)^);
        exit;
   end;
end
else begin
  HostNameToIP:=Address;
  exit;
end;
end;
//==== END ====

//==== 自动把ComboBox控件的内容里没有的内容加入列表中 =====！
procedure Tform1.AddComboBox(CB:TcomboBox);
var
a :integer;
begin
    a:=CB.Items.IndexOf(CB.Text);
    if a=-1 then CB.Items.Add(CB.Text);
end;
//== END ===

// ◎◎◎ 自定义函数 END ◎◎◎

 

{
=============================
          控件部分
==============================
}

//==== Search按钮 =====
procedure TForm1.SearchClick(Sender: TObject);
begin
if search.tag =0 then begin
    portlist:=Tlist.Create; //创建Tstring
    Search_ST(); //开始
    StopThread:=false; //停止为假时，为扫描
end
else begin
    Search_Exit(); //停止
end;
end;
//===== END =====

//===== Form 创建 =====
procedure TForm1.FormCreate(Sender: TObject);
var
Wsadata:Twsadata;
begin
WSAStartup(Makeword(2,0),Wsadata);//
About:=m1.Text; //把简介内容保存到About变量中
end;
//===== END =====

//===== Form 退出 ======
procedure TForm1.FormDestroy(Sender: TObject);
begin
//PortList.free; //释放PortList的内存空间
WSAcleanUP;//
end;
//===== END ======

//===== 当按‘回车’、‘Esc’键时的动作 ======
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (key =#13) and (search.Tag=0) then  SearchClick(Sender); //开始扫描
if (key =#27) and (search.Tag=1) then  SearchClick(Sender); //停止扫描
end;
//===== END ======

 

//==== 关于 =====
procedure TForm1.AboutButtonClick(Sender: TObject);
begin
showMessage(About +
'地址:深圳市龙岗区坪山镇石井太阳村'#13#10#13#10 +
'注:'#13#10 +
'本软件为免费软件,对使用本软件产生'#13#10 +
'的后果,本人不承担任何的责任！'#13#10#13#10 +
'本程序用Delphi编写,如要源码,请和作者联系!'#13#10#13#10 +
'制作时间: 2002年8月27日'
);
//m1.Text:=About;
end;
//==== END =====

//====== 窗口居中 ======
procedure TForm1.FormShow(Sender: TObject);
begin
     Left := (Screen.Width - Width) div 2;
     Top := (Screen.Height - Height) div 2;
end;
//===== END ====

// ◎◎◎ 控件部分 END ◎◎◎

end.

 

 

 

____________________________________________________________________________________________

 

果你写扫描程序可千万不要直接去连接,应该使用别的链接方法,否则你的踪迹会被别人
发现.例如使用sys扫描或者fin扫描:
我给你异步socket的api代码:
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,WInSock, ExtCtrls;

const WM_SOCKET=WM_USER+1;   //socket消息

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Panel1: TPanel;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    Sockhd : integer;   //socket句柄
    Serv_Addr : Tsockaddr;//目标地址

  procedure SockEvent(var msg: Tmessage);message WM_SOCKET;   //处理cocket消息
  procedure DspMsg(msg : string);   //显示信息
    { Private declarations }
  public
    { Public declarations }
  end;

  Form1: TForm1;

implementation
{$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+'...');
 if Memo1.Lines.Count>200 then Memo1.Lines.Delete(0);
end;

procedure TForm1.SockEvent(var msg : tmessage);  //处理socket消息
begin
 case msg.LParam of
  FD_READ: begin    //标识可以读数据,当然肯定已经链接上了
    dspmsg('可以读取数据');
    //do what you want do
  end;

  FD_WRITE: begin
    dspmsg('可以发送数据');
    //do what you want do
  end;

  FD_ERROR: begin
    dspmsg('发生错误');
     //如果你是客户端,则应该是连接不上,即端口没有开
  end;

  FD_CLOSE: Begin
    dspmsg('服务器断开连接');
    //对方关闭连接
  end;

  FD_CONNECT: begin
    dspmsg('连结上服务器');
    //表示对方端口开放
  end;

  FD_ACCEPT: begin
    dspmsg('接收一个请求');
   //这个消息只有服务端可能出现
  end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
 var  wsaData:TwsaData;
begin                 //启动winsock动态链接库
  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);
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;
  Serv_addr.sin_addr.s_addr:= lookup_hostname(edit1.Text);  //主机名
  Serv_addr.sin_family := PF_INET;
  Serv_addr.sin_port := htons(23);      //any port you want to connect

  if WSAAsyncSelect(Sockhd,Form1.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
  connect(sockhd,serv_addr,sizeof(serv_addr));  //连接,结果会在前面的处理函数处理
end;

end.
相信应该可以满足你的要求