delphi 快速多线程扫描端口  
官方Delphi 学习QQ群： 682628230（三千人）
频道

  1. 人气：
  2. 放大
  3. 缩小
  4. 二维码
  5. 赞赏

delphi 快速多线程扫描端口

Delphi 2010 编写的注意了类型定义,应该可以在D7下直接编译

首先是MainProg.DFM文件

object SPForm: TSPForm
  Left = 215
  Top = 153
  BorderIcons = [biSystemMenu]
  BorderStyle = bsSingle
  Caption = #25195#25551#31471#21475
  ClientHeight = 380
  ClientWidth = 556
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = #23435#20307
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 12
  object Label1: TLabel
    Left = 16
    Top = 17
    Width = 84
    Height = 12
    Caption = #35831#36755#20837#36215#22987'IP'#65306
  end
  object Label2: TLabel
    Left = 16
    Top = 43
    Width = 84
    Height = 12
    Caption = #35831#36755#20837#32467#26463'IP'#65306
  end
  object Label3: TLabel
    Left = 234
    Top = 17
    Width = 60
    Height = 12
    Caption = #31471#21475#33539#22260#65306
  end
  object Label4: TLabel
    Left = 296
    Top = 43
    Width = 198
    Height = 12
    Caption = #20363#22914#65306'135,139,1433-2000,3389,4000'
  end
  object Label5: TLabel
    Left = 16
    Top = 69
    Width = 48
    Height = 12
    Caption = #32447#31243#25968#65306
  end
  object Label8: TLabel
    Left = 378
    Top = 95
    Width = 96
    Height = 12
    Caption = #36830#25509#36229#26102#65288#31186#65289#65306
  end
  object IPStart: TEdit
    Left = 106
    Top = 13
    Width = 121
    Height = 20
    TabOrder = 0
    Text = '192.168.2.1'
  end
  object IPEnd: TEdit
    Left = 106
    Top = 39
    Width = 121
    Height = 20
    TabOrder = 1
    Text = '192.168.2.1'
  end
  object Ports: TEdit
    Left = 294
    Top = 13
    Width = 243
    Height = 20
    TabOrder = 2
    Text = '1'
  end
  object StartBtn: TButton
    Left = 185
    Top = 63
    Width = 75
    Height = 25
    Caption = #24320#22987#25195#25551
    TabOrder = 3
    OnClick = StartBtnClick
  end
  object ThreadCount: TComboBox
    Left = 106
    Top = 65
    Width = 63
    Height = 20
    AutoComplete = False
    TabOrder = 4
    Text = '1'
    Items.Strings = (
      '1'
      '5'
      '10'
      '20'
      '30'
      '40'
      '50'
      '100'
      '200'
      '300')
  end
  object SendaCharCK: TCheckBox
    Left = 16
    Top = 93
    Width = 255
    Height = 17
    Caption = #21457#36865#19968#20010#23383#31526#65288#24403#36830#25509#25104#21151#26102#26469#20445#35777#20934#30830#24615#65289
    Checked = True
    State = cbChecked
    TabOrder = 5
  end
  object OutMemo: TMemo
    Left = 16
    Top = 116
    Width = 250
    Height = 256
    Color = clBlack
    Font.Charset = GB2312_CHARSET
    Font.Color = 33023
    Font.Height = -12
    Font.Name = #23435#20307
    Font.Style = []
    ParentFont = False
    ScrollBars = ssBoth
    TabOrder = 6
  end
  object ProcSel: TComboBox
    Left = 266
    Top = 65
    Width = 271
    Height = 20
    Style = csDropDownList
    ItemIndex = 0
    TabOrder = 7
    Text = #25353#29031'IP'#20998#37197#20219#21153#65288#36866#21512#20110'IP'#22810#65292#31471#21475#23569#30340#24773#20917#65289
    Items.Strings = (
      #25353#29031'IP'#20998#37197#20219#21153#65288#36866#21512#20110'IP'#22810#65292#31471#21475#23569#30340#24773#20917#65289
      #36880#20010'IP'#20998#37197#20219#21153#65288#36866#21512#20110'IP'#23569#65292#31471#21475#22810#30340#24773#20917#65289)
  end
  object TimeOut: TEdit
    Left = 480
    Top = 91
    Width = 57
    Height = 20
    TabOrder = 8
    Text = '2'
  end
  object PB: TProgressBar
    Left = 277
    Top = 116
    Width = 260
    Height = 21
    TabOrder = 9
  end
  object Timer: TTimer
    Enabled = False
    OnTimer = TimerTimer
    Left = 280
    Top = 152
  end
end


接下来是MainProg.pas

unit MainProg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls , WinSock, ComCtrls, ExtCtrls;

Const
  WM_THREAD_MSG           = WM_USER + $1;
  WM_THREAD_MSG_W_RunOver = 1;
  WM_THREAD_MSG_W_OneSucc = 2;

type
  TSPForm = class(TForm)
    Label1: TLabel;
    IPStart: TEdit;
    Label2: TLabel;
    IPEnd: TEdit;
    Label3: TLabel;
    Ports: TEdit;
    Label4: TLabel;
    StartBtn: TButton;
    ThreadCount: TComboBox;
    Label5: TLabel;
    SendaCharCK: TCheckBox;
    OutMemo: TMemo;
    ProcSel: TComboBox;
    TimeOut: TEdit;
    Label8: TLabel;
    PB: TProgressBar;
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure StartBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StopBtnClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
  private
    Function ReadInputPorts : Boolean;
    procedure OnThreadMsg(var Msg : TMessage); message WM_THREAD_MSG;
  public
  end;

//简化提示框
Function MsgBox(Msg : WideString; Title : WideString = '提示'; 
                Flag : integer = MB_OK or MB_ICONWARNING) : integer;

var
  SPForm: TSPForm;

implementation

{$R *.dfm}

Type
  TTryIPPortThread = class(TThread)    //扫描线程
  private
    procedure TryIPPortsByIP;
    procedure TryIPPorts;
    Function GetNextIPPort(var IP : AnsiString; var Port : integer) : Boolean;
  protected
    procedure Execute; override;
  end;

var
  piStartIP , piEndIP , piIPIndex : DWORD;      //要扫描的IP范围
  paPortArray : array of integer;               //端口列表
  piPortIndex , piPortArrayHigh : DWORD;        //端口取值及，列表High
  piThreadBusyCount : integer;                  //工作中的线程记数
  FormHandle : THandle;                         //主窗口句柄
  pbSendaChar : Boolean;                        //是否发送一个字符
  pbRuning : Boolean;                           //控制运行标记
  piProcSel : integer;                          //扫描方式选择
  piTimeOut : integer;                          //设置连接超时
  prLock : TRTLCriticalSection;                 //列表锁


//提示框
Function MsgBox(Msg : WideString; Title : WideString = '提示'; 
                Flag : integer = MB_OK or MB_ICONWARNING) : integer;
begin
  Result := Application.MessageBox(Pointer(Msg) , Pointer(Title) , Flag);
end;

//取间隔字串
Function CopyStrEx(SourceStr : WideString; JGZF : WideChar; Index : integer) : WideString;
var
  P : PWideChar;
  i : integer;
begin
  Result := '';
  P := Pointer(SourceStr);
  for i:=0 to Length(SourceStr)-1 do begin
    if P^ = JGZF then 
      begin
        Dec(Index);
        if Index=0 then Break;
        Result := '';
      end
    else if Index<=1 then Result := Result + P^;
    inc(P);
  end;
end;

Function IPV4ToInt(IP : WideString) : integer;
begin
  Result := StrToInt(CopyStrEx(IP , '.' , 1));
  Result := Result SHL 8;
  Result := Result + StrToInt(CopyStrEx(IP , '.' , 2));
  Result := Result SHL 8;
  Result := Result + StrToInt(CopyStrEx(IP , '.' , 3));
  Result := Result SHL 8;
  Result := Result + StrToInt(CopyStrEx(IP , '.' , 4));
end;

Function IntToIPV4(LInt : LongInt) : AnsiString;
begin
  Result := IntToStr((Lint SHR 24) and $FF) + '.';
  Result := Result + IntToStr((Lint SHR 16) and $FF) + '.';
  Result := Result + IntToStr((Lint SHR 8) And $FF) + '.';
  Result := Result + IntToStr(Lint AND $FF);
end;

procedure TSPForm.FormCreate(Sender: TObject);
var
  WSA : TWSAData;
begin
  WSAStartup(MakeWord(2,2),WSA);
  InitializeCriticalSection(prLock);
end;

procedure TSPForm.FormDestroy(Sender: TObject);
begin
  WSACleanup();
end;

procedure TSPForm.FormShow(Sender: TObject);
begin
  Self.OnShow := NIL;
  FormHandle := Handle;
end;

procedure TSPForm.OnThreadMsg(var Msg: TMessage);
var
  PS : PAnsiString;
begin
  Case Msg.WParam of
    WM_THREAD_MSG_W_RunOver :
    begin
      StartBtn.Caption := '开始扫描';
      StartBtn.OnClick := StartBtnClick;
      StartBtn.Enabled := True;
      Timer.Enabled    := False;
      PB.Position      := 0;
    end;
    WM_THREAD_MSG_W_OneSucc :
    begin
      PS := Ptr(Msg.LParam);
      try
        OutMemo.Lines.Add(PS^);
        Dispose(PS);
      finally
      end;
    end;
  end;
end;

procedure AppendToPorts(Port : integer);
var
  n : integer;
begin
  if Port>0 then begin
    n := Length(paPortArray);
    SetLength(paPortArray , n+1);
    paPortArray[n] := Port;
  end;
end;

procedure AppendToPorts2(var si : integer ; Port : integer);
var
  i : integer;
begin
  if si<0 then AppendToPorts(Port)
  else begin
    for i := si to Port do AppendToPorts(i)
  end;
  si := -1;
end;

//整理用户输入的端口到列表中
//用户端口可以采用多种方式输入，如
//21,23,80,135,1433-3389,8080
//可以是一段端口，也可以是指定的端口
function TSPForm.ReadInputPorts: Boolean;
var
  S , FS : WideString;
  i , si , ei : integer;
  P : PWideChar;
begin
  Result := False;
  S := Trim(Ports.Text);
  if S='' then begin
    MsgBox('请输入端口');
    Ports.SetFocus;
    exit;
  end;
  SetLength(paPortArray,0);
  S := S + ',';
  P := Pointer(S);
  FS := '';
  si := -1;
  for i := 0 to Length(S) - 1 do begin
    if P^=',' then
      begin
        ei := StrToIntDef(Trim(FS) , -1);
        if ei<=0 then begin
          MsgBox('请输入有效的端口');
          exit;
        end;
        AppendToPorts2(si , ei);
        FS := '';
      end
    else if P^='-' then
      begin
        si := StrToIntDef(Trim(FS) , -1);
        if si<=0 then begin
          MsgBox('请输入有效的端口');
          exit;
        end;
        FS := '';
      end
    else FS := FS + P^;
    inc(P);
  end;
  Result := Length(paPortArray)>0;
end;

procedure TSPForm.StartBtnClick(Sender: TObject);
var
  i , n : integer;
begin
  try
    piStartIP := IPV4ToInt(IPStart.Text);
  except
    MsgBox('请输入有效的IP V4 地址');
    IPStart.SetFocus;
    exit;
  end;
  try
    piEndIP := IPV4ToInt(IPEnd.Text);
  except
    MsgBox('请输入有效的IP V4 地址');
    IPEnd.SetFocus;
    exit;
  end;
  if piStartIP>piEndIP then begin
    MsgBox('请起始IP不能大于结束IP.');
    IPStart.SetFocus;
    exit;
  end;
  //整理用户输入的端口到列表中
  if not ReadInputPorts then exit;

  n := StrToIntDef(ThreadCount.Text , 0);
  if n<=0 then begin
    MsgBox('请输入线程数');
    ThreadCount.SetFocus;
    exit;
  end;

  if n>1000 then begin
    MsgBox('请输入合理的线程数');
    ThreadCount.SetFocus;
    exit;
  end;
  //初始化线程要使用的参数
  pbSendaChar := SendaCharCK.Checked;
  piThreadBusyCount := 0;
  piPortIndex := DWORD(-1);
  piIPIndex := piStartIP;
  piPortArrayHigh := High(paPortArray);
  pbRuning := True;
  OutMemo.Clear;
  StartBtn.Caption := '停止扫描';
  StartBtn.OnClick := StopBtnClick;
  piProcSel := ProcSel.ItemIndex;
  piTimeOut := StrToIntDef(TimeOut.Text , 2);
  if piTimeOut<=0 then piTimeOut := 2;
  PB.Max := piEndIP - piStartIP + 1;
  PB.Position := 0;

  for i := 0 to n-1 do begin
    with TTryIPPortThread.Create(True) do begin
      FreeOnTerminate := True;
      Resume;
    end;
  end;
  Timer.Enabled := True;
end;

procedure TSPForm.StopBtnClick(Sender: TObject);
begin
  StartBtn.Enabled := False;
  pbRuning := False;
end;

procedure TSPForm.TimerTimer(Sender: TObject);
begin
  PB.Position := piIPIndex - piStartIP;
end;

{ TTryIPPortThread }

procedure LockInc(Adr : PDWORD);
asm
  LOCK INC DWORD PTR [EAX];
end;

procedure LockDec(Adr : PDWORD);
asm
  LOCK DEC DWORD PTR [EAX];
end;

Function LockXInc(Adr : PDWORD) : DWORD;
asm
  MOV  EDX , Adr;
  MOV  EAX , 1;
  LOCK XADD DWORD PTR [EDX] , EAX;
end;

procedure TTryIPPortThread.Execute;
begin
  LockInc(@piThreadBusyCount);
  if piProcSel=0 then TryIPPortsByIP
  else TryIPPorts;
  LockDec(@piThreadBusyCount);
  if piThreadBusyCount=0 then
    PostMessage(FormHandle , WM_THREAD_MSG , WM_THREAD_MSG_W_RunOver , $111);
end;

Function TryIPPort(Const IP : AnsiString; Port : integer) : Boolean;
var
  Sock : TSocket;
  SA   : TSockaddr;
  n , ul : integer;
  TV : TTimeVal;
  FDSet : TFDSet;
begin
  FillChar(SA , SizeOf(SA) , 0);
  SA.sin_family      := AF_INET;
  SA.sin_port        := htons(Port);
  SA.sin_addr.S_addr := inet_addr(Pointer(IP));
  Sock               := Socket(AF_INET , SOCK_STREAM , IPPROTO_IP);
  Result             := Sock<>invalid_socket;
  if Result then begin
    n := piTimeOut * 1000;
    ul := 1;
    if (SetSockopt(Sock , SOL_SOCKET , SO_SNDTIMEO , @n , SizeOf(n))<>SOCKET_ERROR) and
       (SetSockopt(Sock , SOL_SOCKET , SO_RCVTIMEO , @n , SizeOf(n))<>SOCKET_ERROR) and
       (ioctlsocket(Sock, FIONBIO, ul)<>SOCKET_ERROR) then begin
      Connect(Sock , SA , SizeOf(SA));
      FD_ZERO(FDSet);
      FD_SET(Sock , FDSet);
      TV.tv_sec := piTimeOut;
      TV.tv_usec := 0;
      Result := select(0, NIL , @FDSet , NIL , @TV)>0;

      if Result and pbSendaChar then
        Result := Send(Sock , SA , 1 , 0) = 1;
    end;
    CloseSocket(Sock);
  end;
end;

//获取扫描的任务
function TTryIPPortThread.GetNextIPPort(var IP: AnsiString;
  var Port: integer): Boolean;
var
  i : integer;
  nIP : DWORD;
begin
  Result := True;
  EnterCriticalSection(prLock);
  if piPortIndex=piPortArrayHigh then
    begin
      inc(piIPIndex);
      Result := piIPIndex <= piEndIP;
      if Result then piPortIndex := 0;
    end
  else inc(piPortIndex);
  i := piPortIndex;
  nIP := piIPIndex;
  LeaveCriticalSection(prLock);
  if Result then begin
    IP := IntToIPV4(nIP);
    Port := paPortArray[i];
  end;
end;

//扫描总循环
procedure TTryIPPortThread.TryIPPorts;
var
  IP : AnsiString;
  Port : integer;
  PS : PAnsiString;
begin
  while pbRuning and GetNextIPPort(IP , Port) do begin
    if TryIPPort(IP , Port) then begin
      New(PS);
      PS^ := IP + ':'+IntToStr(Port);
      PostMessage(FormHandle , WM_THREAD_MSG , WM_THREAD_MSG_W_OneSucc , integer(PS));
    end;
  end;
end;

//这是我喜欢的方式，比如扫描一个D段的1433端口，那将很快
procedure TTryIPPortThread.TryIPPortsByIP;
var
  nIP : DWORD;
  IP : AnsiString;
  i , Port : integer;
  PS : PAnsiString;
begin
  while pbRuning do begin
    nIP := LockXInc(@piIPIndex);
    if nIP>piEndIP then Break;
    IP := IntToIPV4(nIP);
    for i := 0 to piPortArrayHigh do begin
      Port := paPortArray[i];
      if TryIPPort(IP , Port) then begin
        New(PS);
        PS^ := IP + ':'+IntToStr(Port);
        PostMessage(FormHandle , WM_THREAD_MSG , WM_THREAD_MSG_W_OneSucc , integer(PS));
      end;
    end;
  end;
end;

end.

推荐分享
最新信息 delphi13 多线程优化 TThreade... delphi 如何 FastMM配置 delphi13 FireDAC增强 并行备份... delphi12 Embarcadero ld... delphi 查看 cpu 核心数
热门信息 delphi 动态数组的使用 delphi多线程TThread详解 delphi try except语句 和 try finally语... delphi中常用字符串处理函数 delphi Inc函数和Dec函数的用法
推荐区 txt文本处理 查询128 说一段 简搜 短笑话 IP查询 正则大全 在线加密解密工具 在线文本筛选工具 1234828网址导航 windows库
图文皆来源于网络，内容仅做公益性分享，版权归原作者所有，如有侵权请告知删除！
  1. 关于我们
  2. 联系我们
 

Copyright © 2014 DelphiW.com 开发 源码 文档 技巧 All Rights Reserved
晋ICP备14006235号-8 晋公网安备 14108102000087号

执行时间: 0.041209936141968 seconds