回答一个网友一个网络扫描的问题

原创已于 2026-01-01 21:57:48 修改 · 205 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#网络

于 2026-01-01 21:49:18 首次发布

Delphi开发技术分享专栏收录该内容

79 篇文章

订阅专栏

起因

有个网友加了俺的QQ好友，问俺一些网络扫描的问题。

结果

经过俺的细心的回答和例子的讲解，网友决定不写代码了。

事情是这样的

那是很久以前，有一天有个人加了俺QQ好友，问俺一些网络扫描的问题。经过一段时间的交流，这个网友就不打算写程序。下面就是网友写的，一个多线程的网络扫描程序。

TScan_Job = class 是个类，用于进行网络扫描。

MaxThreadCount 是最大的线程数

CriticalSection: TCriticalSection; 是临界区。delphi的临界区还是很方便的。

TScan_Thread = class(TThread) 是扫描线程

TScan_Item 是每个扫描记录

unit u_scan;

interface
uses Windows, Messages, Classes, SyncObjs;
const
  PWM_OnThreadTerminate = WM_USER + 1;
type


  TItemState = (isWaite, isDoing, isDone);
  PScan_Item = ^TScan_Item;
  TScan_Item = record
    ok: boolean;
    state: TItemState;
    data: Pointer;
    info: string;
  end;
  TScan_Thread = class;
  TScan_Job = class;

  ///////////////////////////
  TScan_Job = class
  private
    FItemList: TStringList;
    FMaxThreadCount: Integer;

    FStarted: Boolean;
    CriticalSection: TCriticalSection;
    FItemIndex: integer;
    FHWnd: THandle;
    FOK_Idx_list: array of Integer;
    function GetThreadCount: integer;
    procedure JobWndProc(var msg: TMessage);
    function GetItemCount: integer;
    function GetProgress: integer;
    function GetOKItemCount: integer;
  protected
    ThreadList: array of TScan_Thread;
    function createThread(): TScan_Thread; virtual;
    procedure createThreadList; virtual;
    procedure clearThreadList; virtual;
    procedure OnThreadTerminate(Sender: TObject);
    procedure CheckWillStop;
    procedure addOK_Idx(idx: Integer);
  public
    constructor Create();
    destructor Destroy; override;
    procedure clearItem;
    procedure AddItem(text: string; data: Pointer);

    procedure Start;
    procedure Stop;

    procedure RequestNewItem(var idx: integer; var flag: Boolean);
    function getPScan_Item(idx: integer): PScan_Item;
    function getScan_Thread(idx: integer): TScan_Thread;
    function getItem_Text(idx: integer): string;
    function getOKItem_idx(idx: integer): integer;

    property MaxThreadCount: integer read FMaxThreadCount write FMaxThreadCount;
    property ThreadCount: integer read GetThreadCount;
    property ItemCount: integer read GetItemCount;
    property Started: boolean read FStarted;
    property Progress: integer read GetProgress;
    property ItemIndex: integer read FItemIndex;
    property OKItemCount: integer read GetOKItemCount;
  end;
 //////////////
  TScan_Thread = class(TThread)
  private
    FScan_Job: TScan_Job;
    FLogs: TStringList;
  protected
    Itemidx: Integer;
    Scan_Item: PScan_Item;
    procedure writeLog(v: string);
    procedure Execute; override;
    procedure DoScan; virtual;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    property Scan_Job: TScan_Job read FScan_Job write FScan_Job;
    property Scan_Item_idx: Integer read Itemidx;
    property Scan_Job_Scan_Item: PScan_Item read Scan_Item;
  end;


function iptostr(ip: LongWord): AnsiString;
function strtoip(str: AnsiString): Longword;

function ItemStateToStr(ItemState: TItemState): string;
implementation

uses SysUtils, math;

{ TScan_Job }

function intFloor(const X: Extended): Integer;
begin
  Result := Integer(Trunc(X));
  if Frac(X) < 0 then
    Result := Result - 1;
end;

function strtoip(str: AnsiString): Longword;
var
  f_tmp, f_ip: Longword;
  temp: AnsiString;
begin
//  f_ip := inet_addr(pchar(str));
  temp := str;
  f_ip := StrToInt(Copy(temp, 1, AnsiPos('.', temp) - 1)) * 256 * 256 * 256;
//  f_ip := StrToInt(temp.SubString(1,temp.AnsiPos('.')-1))*256*256*256;
  Delete(temp, 1, AnsiPos('.', temp));
  f_tmp := StrToInt(Copy(temp, 1, AnsiPos('.', temp) - 1)) * 256 * 256;
  f_ip := f_ip + f_tmp;
  Delete(temp, 1, AnsiPos('.', temp));
  f_tmp := StrToInt(Copy(temp, 1, AnsiPos('.', temp) - 1)) * 256;
  f_ip := f_ip + f_tmp;
  Delete(temp, 1, AnsiPos('.', temp));
  f_tmp := StrToInt(temp);
  f_ip := f_ip + f_tmp;
  Result := f_ip;
end;

//------------------------------------------------------------------------

function ItemStateToStr(ItemState: TItemState): string;
begin
  case ItemState of
    isWaite: Result := '等待';
    isDoing: Result := '扫描中';
    isDone: Result := '完成';
  else
    Result := ''
  end;
end;
//------------------------------------------------------------------------

function iptostr(ip: LongWord): AnsiString;
var
  temp: AnsiString;
  i: LongWord;
  f: LongWord;
begin
  temp := '';
  i := ip;
  f := intFloor(i / (256 * 256 * 256));
  if ((f > 255)) then begin raise Exception.Create('IP转换错误!'); Result := ''; end;
  temp := IntToStr(f) + '.';
  i := i - f * (256 * 256 * 256);
  f := intFloor(i / (256 * 256));
  if ((f > 255)) then begin raise Exception.Create('IP转换错误!'); Result := ''; end;
  temp := temp + IntToStr(f) + '.';
  i := i - f * (256 * 256);
  f := intFloor(i / 256);
  if ((f > 255)) then begin raise Exception.Create('IP转换错误!'); Result := ''; end;
  temp := temp + IntToStr(f) + '.';
  i := i - f * 256;
  if ((i > 255)) then begin raise Exception.Create('IP转换错误!'); Result := ''; end;
  temp := temp + IntToStr(i);

  Result := temp;
end;


procedure TScan_Job.AddItem(text: string; data: Pointer);
var
  Scan_Item: PScan_Item;
begin
  if FStarted then
    begin
      raise Exception.Create('正在执行中,不能添加项目！');
    end;
  new(Scan_Item);
  Scan_Item^.ok := false;
  Scan_Item^.state := isWaite;
  Scan_Item^.data := data;
  FItemList.AddObject(text, TObject(Scan_Item));
end;

procedure TScan_Job.addOK_Idx(idx: Integer);
var
  i: integer;
begin
  CriticalSection.Enter;

  i := length(FOK_Idx_list);
  SetLength(FOK_Idx_list, i + 1);
  FOK_Idx_list[i] := idx;

  CriticalSection.Leave;
end;

procedure TScan_Job.CheckWillStop;
var
  i: integer;
begin
  for i := 0 to High(ThreadList) do
    begin
      if not ThreadList[i].Terminated then
        exit;
    end;
  Stop;
end;

procedure TScan_Job.clearItem;
var
  i: integer;
  Scan_Item: PScan_Item;
begin
  SetLength(FOK_Idx_list, 0);
  for i := 0 to FItemList.Count - 1 do
    begin
      Scan_Item := PScan_Item(FItemList.Objects[i]);
      Scan_Item^.info := '';
      if Scan_Item^.data <> nil then
        Dispose(Scan_Item^.data);
      Dispose(Scan_Item);
    end;
  FItemList.Clear;
end;

procedure TScan_Job.clearThreadList;
var
  i: integer;
begin
  for i := 0 to High(ThreadList) do
    begin
      ThreadList[i].Terminate;
    end;
  for i := 0 to High(ThreadList) do
    begin
      ThreadList[i].free;
      ThreadList[i] := nil;
    end;
  SetLength(ThreadList, 0);
end;

constructor TScan_Job.Create;
begin
  inherited Create;
  FItemList := TStringList.Create;
  FMaxThreadCount := 100;
  CriticalSection := TCriticalSection.Create;
  FItemIndex := -1;
  FHWnd := AllocateHWnd(JobWndProc)
end;



function TScan_Job.createThread: TScan_Thread;
begin
  Result := nil;
end;

procedure TScan_Job.createThreadList;
var
  i, count: Integer;
  Thread: TScan_Thread;
begin
  clearThreadList;
  SetLength(ThreadList, min(FMaxThreadCount, FItemList.Count));
  count := 0;
  for i := 0 to high(ThreadList) do
    begin
      Thread := createThread;
      if Thread = nil then
        Break;
      Thread.OnTerminate := OnThreadTerminate;
      Thread.Priority := tpNormal;
      Thread.FreeOnTerminate := false;
      Thread.Scan_Job := self;
      ThreadList[i] := Thread;
      inc(count);
    end;
  SetLength(ThreadList, count);
end;

destructor TScan_Job.Destroy;
begin
  if FStarted then
    Stop;
  clearItem;
  FreeAndNil(FItemList);
  FreeAndNil(CriticalSection);
  DeallocateHWnd(FHwnd);
  inherited;
end;

function TScan_Job.GetItemCount: integer;
begin
  Result := FItemList.Count;
end;

function TScan_Job.getItem_Text(idx: integer): string;
begin
  if (idx < 0) or (idx >= FItemList.Count) then
    Result := ''
  else
    Result := FItemList[idx];
end;

function TScan_Job.GetOKItemCount: integer;
begin
  Result := length(FOK_Idx_list);
end;

function TScan_Job.getOKItem_idx(idx: integer): integer;
begin
  if (idx < 0) or (idx > high(FOK_Idx_list)) then
    Result := -1
  else
    Result := FOK_Idx_list[idx];
end;

function TScan_Job.GetProgress: integer;
begin
  Result := (FItemIndex + 1) * 100 div ItemCount;
end;

function TScan_Job.getPScan_Item(idx: integer): PScan_Item;
begin
  if (idx < 0) or (idx >= FItemList.Count) then
    raise Exception.Create(format('错误的idx:%d ', [idx]));
  Result := PScan_Item(FItemList.Objects[idx]);
end;

function TScan_Job.getScan_Thread(idx: integer): TScan_Thread;
begin
  if (idx < 0) or (idx > high(ThreadList)) then
    Result := nil;
  Result := ThreadList[idx];
end;

function TScan_Job.GetThreadCount: integer;
begin
  Result := length(ThreadList);
end;

procedure TScan_Job.JobWndProc(var msg: TMessage);
begin
  case msg.msg of
    PWM_OnThreadTerminate: CheckWillStop;
  end;
end;

procedure TScan_Job.OnThreadTerminate(Sender: TObject);
begin
  TThread(Sender).Terminate;
  PostMessage(FHWnd, PWM_OnThreadTerminate, 0, 0);
end;

procedure TScan_Job.RequestNewItem(var idx: integer; var flag: Boolean);
begin
  CriticalSection.Enter;
  flag := false;
  if FItemIndex < FItemList.Count - 1 then
    begin
      inc(FItemIndex);
      idx := FItemIndex;
      flag := true;
    end;
  CriticalSection.Leave;
end;

procedure TScan_Job.Start;
var
  i: integer;
begin
  if FStarted then
    exit;

  FStarted := true;
  SetLength(FOK_Idx_list, 0);
  clearThreadList;
  createThreadList;
  FItemIndex := -1;
  for i := 0 to high(ThreadList) do
    ThreadList[i].Resume;
end;

procedure TScan_Job.Stop;
begin
  FStarted := false;

  clearThreadList;
end;

{ TScan_Thread }

constructor TScan_Thread.Create(CreateSuspended: Boolean);
begin
  FLogs := TStringList.Create;
  Scan_Item := nil;
  inherited Create(CreateSuspended);
end;

destructor TScan_Thread.Destroy;
begin
  FreeAndNil(FLogs);
  inherited;
end;

procedure TScan_Thread.DoScan;
begin
  Scan_Item^.ok := false;
end;

procedure TScan_Thread.Execute;
var
  flag: Boolean;
begin
  while not Terminated do
    begin
      if not Scan_Job.Started then
        Break;

      Scan_Job.RequestNewItem(Itemidx, flag);
      if not flag then
        Break;
      Scan_Item := Scan_Job.getPScan_Item(Itemidx);
      Scan_Item^.state := isDoing;
      if Terminated then
        Break;
      if not Scan_Job.Started then
        Break;

      DoScan;

      if Terminated then
        Break;
      if not Scan_Job.Started then
        Break;
      if Scan_Item^.ok then
        Scan_Job.addOK_Idx(Itemidx);
      Scan_Item^.state := isDone;
    end;
end;

procedure TScan_Thread.writeLog(v: string);
begin
  FLogs.Add(v);
end;

end.

随着个网友的交流，网友告诉俺，他是一个高三的学生，高考是失误了。他就在他自己的房间里不出来，连吃饭都是爸妈放在门口，敲下门。他在家，不出门，打算学习网络知识，打算以后成为一个黑客，于是就加了俺的QQ好像，从网络扫描开始。经过俺的一通交流，他走出了房间，能够和爸妈一起吃饭，然后去了复读班去复读了，当然也就不学习程序开发了。