⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tools.pas

📁 最好的局域网搜索软件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit Tools;

interface

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

type
  TNbtRecord = packed record
    IpAddr, GroupName, HostName, UserName: string[15]; //array [1..15] of char;
    MacAddr: string[17]; //array [1..17] of char;
    //Separator: char;
  end;

  TToolsForm = class(TForm)
    PageCtrl: TPageControl;
    FindIpTabSheet: TTabSheet;
    TopPanel: TPanel;
    BtnCheckIP: TSpeedButton;
    Label1: TLabel;
    Edit1: TEdit;
    IPListView: TListView;
    Panel2: TPanel;
    Radio1: TRadioButton;
    Radio2: TRadioButton;
    NbtTabSheet: TTabSheet;
    Panel1: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    btnNbtStart: TSpeedButton;
    edtNbtIP1: TEdit;
    edtNbtIP2: TEdit;
    spInterval: TSpinEdit;
    lvNbt: TListView;
    btnNbt: TSpeedButton;
    pnlStatus: TPanel;
    cbIP: TCheckBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    cbAddToTree: TCheckBox;
    TCPScanTabSheet: TTabSheet;
    Panel3: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    SpeedButton1: TSpeedButton;
    btnScanPort: TSpeedButton;
    edtScanIP1: TEdit;
    edtScanIP2: TEdit;
    spTimeOut: TSpinEdit;
    lvPortScan: TListView;
    Panel4: TPanel;
    Label11: TLabel;
    cbAddToTree2: TCheckBox;
    PingTabSheet: TTabSheet;
    Panel5: TPanel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    SpeedButton2: TSpeedButton;
    btnPing: TSpeedButton;
    edtPing1: TEdit;
    edtPing2: TEdit;
    spPingTime: TSpinEdit;
    lvPing: TListView;
    Panel6: TPanel;
    cbAddToTree3: TCheckBox;
    Label16: TLabel;
    SendMsgTabSheet: TTabSheet;
    memMsg: TMemo;
    Panel7: TPanel;
    btnSendMsg: TSpeedButton;
    Label17: TLabel;
    cbToHost: TComboBox;
    cbClearMsg: TCheckBox;
    lvSendMsg: TListView;
    Splitter1: TSplitter;
    Panel8: TPanel;
    SaveDlg: TSaveDialog;
    NbtDbTabSheet: TTabSheet;
    lvNbtDb: TListView;
    Panel9: TPanel;
    lvSearchResult: TListView;
    Splitter2: TSplitter;
    Panel10: TPanel;
    cbField: TComboBox;
    btnSearchField: TButton;
    Label18: TLabel;
    Label19: TLabel;
    edtSearch: TEdit;
    Panel11: TPanel;
    Label20: TLabel;
    IPCfgTabSheet: TTabSheet;
    btnSort: TSpeedButton;
    Panel16: TPanel;
    Panel14: TPanel;
    lvIpAddr: TListView;
    Panel15: TPanel;
    memIpCfg: TMemo;
    Splitter3: TSplitter;
    btnRefreshIpCfg: TButton;
    Splitter4: TSplitter;
    Panel12: TPanel;
    Label23: TLabel;
    btnNbtAddrUp: TSpeedButton;
    btnNbtAddrDown: TSpeedButton;
    btnScanAddrDown: TSpeedButton;
    btnScanAddrUp: TSpeedButton;
    btnPingAddrDown: TSpeedButton;
    btnPingAddrUp: TSpeedButton;
    btnNbtLocalLan: TSpeedButton;
    btnScanLocalLan: TSpeedButton;
    btnPingLocalLan: TSpeedButton;
    PageSaveRange: TPageControl;
    TabHistory: TTabSheet;
    lvIpAddrRange: TListView;
    Panel17: TPanel;
    btnDelIpRange: TButton;
    TabSave: TTabSheet;
    lvSaveRange: TListView;
    Panel13: TPanel;
    Button1: TButton;
    Panel18: TPanel;
    edtPort: TEdit;
    clbPort: TCheckListBox;
    Label10: TLabel;
    Label22: TLabel;
    cbScanPort1: TComboBox;
    Label21: TLabel;
    cbScanPort2: TComboBox;
    rbUseList: TRadioButton;
    rbUseFromTo: TRadioButton;
    btnAddPort: TButton;
    Bevel1: TBevel;
    Bevel3: TBevel;
    cbNbtDataLoad: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure BtnCheckIPClick(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Radio1Click(Sender: TObject);
    procedure Radio2Click(Sender: TObject);
    procedure btnNbtClick(Sender: TObject);
    procedure lvNbtDblClick(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnScanPortClick(Sender: TObject);
    procedure lvPortScanDblClick(Sender: TObject);
    procedure PageCtrlChange(Sender: TObject);
    procedure btnPingClick(Sender: TObject);
    procedure lvPingDblClick(Sender: TObject);
    procedure btnSendMsgClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lvSendMsgDblClick(Sender: TObject);
    procedure btnSearchFieldClick(Sender: TObject);
    procedure btnSortClick(Sender: TObject);
    procedure cbScanPort1Change(Sender: TObject);
    procedure lvIpAddrDblClick(Sender: TObject);
    procedure btnRefreshIpCfgClick(Sender: TObject);
    procedure cbNbtDataLoadClick(Sender: TObject);
    procedure lvIpAddrRangeDblClick(Sender: TObject);
    procedure btnDelIpRangeClick(Sender: TObject);
    procedure btnNbtAddrUpClick(Sender: TObject);
    procedure btnNbtAddrDownClick(Sender: TObject);
    procedure btnScanAddrUpClick(Sender: TObject);
    procedure btnScanAddrDownClick(Sender: TObject);
    procedure btnPingAddrUpClick(Sender: TObject);
    procedure btnPingAddrDownClick(Sender: TObject);
    procedure btnNbtLocalLanClick(Sender: TObject);
    procedure btnScanLocalLanClick(Sender: TObject);
    procedure btnPingLocalLanClick(Sender: TObject);
    procedure lvIpAddrRangeColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure lvSaveRangeDblClick(Sender: TObject);
    procedure lvSaveRangeColumnClick(Sender: TObject; Column: TListColumn);
    procedure Button1Click(Sender: TObject);
    procedure rbUseListClick(Sender: TObject);
    procedure rbUseFromToClick(Sender: TObject);
    procedure btnAddPortClick(Sender: TObject);
  private
    { Private declarations }
    NbtHasItem: boolean;
    PingHasItem: boolean;
    PortScanHasItem: boolean;
    
    CurListView: TListView;
    //SaveFileName: string;
    PreviousPortScanIP: string;

    procedure SaveNbtData;
    procedure LoadNbtData;
    procedure AddNbtData(Item: TListItem);
    
    procedure SaveList;
    procedure LoadList;

    procedure SaveIpRange;
    procedure LoadIpRange;

    //----------------nbtstat---------------
    procedure NbtEndEvent(Sender: TObject);
    procedure NbtSendEvent(Sender: TObject);
    procedure NbtAddNodeEvent(Sender: TObject);

    //--------------scan prot---------------
    procedure PortShowProgress(Sender: TObject);
    procedure PortOnConnect(Sender: TObject);
    procedure PortOnExitScan(Sender: TObject);

    //--------------ping--------------------
    procedure PingReply(Sender: TObject);
    procedure PingBegin(Sender: TObject);
    procedure PingEnd(Sender: TObject);
    procedure PingSend(Sender: TObject);

    //--------------send message-------------
    procedure SendMsgResultEvent(Sender: TObject);

  public
    { Public declarations }
    //StrListIP:TStringList;
    procedure AddIpAddrRange(ip1, ip2: string);
    procedure SaveRange(ip1, ip2: string);
    procedure IPAddrUpDown(edtIP1, edtIP2: TEdit; up: boolean);
  end;

type CheckType = (Name2IP, IP2Name);

TGetIPThread=class(TThread)
public
  //index:integer;
  check_type:CheckType;
  sIP,hostName:string;
  MyListitem:TListitem;
protected
  procedure Execute; override;
  procedure AddItem;
  Procedure AddResult;
  //procedure SaveToList;
end;

var
  ToolsForm: TToolsForm;

implementation
uses Main, Nbtstat, TCPScan, FmxUtils, PingThread, SendMsgUnit, IpCfg;
{$R *.DFM}

procedure TGetIPThread.AddItem;
var
  listitem: TListitem;
begin
  with ToolsForm do
  begin
      ListItem:=IPListview.Items.Insert(0);
      MyListItem:=ListItem;
      MyListItem.Caption := hostName;
      MyListitem.SubItems.add(sIP);
  end;
end;

procedure TGetIPThread.AddResult;
begin
  with ToolsForm do
  begin
      MyListItem.Caption := hostName;
      MyListitem.SubItems[0]:=sIP;
  end;
end;

procedure TGetIPThread.Execute;
var
  WSAData: TWSAData;
  HostEnt: PHostEnt;
  netaddr: u_long;
begin

  synchronize(AddItem);

  WSAStartup(2, WSAData);

  case check_type of
    Name2IP:
    begin
      HostEnt := gethostbyname(PChar(hostName));
      if HostEnt <> nil then
      with HostEnt^ do
      sIP := Format('%d.%d.%d.%d', [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])])
      else sIP:='未知';
    end;
    IP2Name:
    begin
      netaddr:=inet_addr(Pchar(sIP));
      HostEnt:=GetHostbyaddr(pchar(@netaddr),30,0);
      if HostEnt <> nil then HostName:=strpas(HostEnt.h_name)
      else HostName:='未知';
    end;
  end;//end of case;

  WSACleanup;

  synchronize(AddResult);
  //synchronize(SaveToList);

end;

procedure TToolsForm.FormCreate(Sender: TObject);
var
  i: integer;
begin
  //StrListIP:=TStringList.Create;
  if bk<>nil then Brush.Bitmap :=  bk;

  Nbt := TNbt.Create(self);
  Nbt.MyListView := lvNbt;
  
  edtNbtIP1.Text := Nbt_IP1;
  edtNbtIP2.Text := Nbt_IP2;

  edtScanIP1.Text := ScanPort_IP1;
  edtScanIP2.Text := ScanPort_IP2;

  edtPing1.Text := Ping_IP1;
  edtPing2.Text := Ping_IP2;

  //if FileExists('SendToHost.txt') then cbToHost.Items.LoadFromFile('SendToHost.txt');

  if (not MainForm.bNotAutoSaveNbt) then
  begin
    LoadNbtData;
  end
  else
  begin
    cbNbtDataLoad.Checked := true;
    lvSearchResult.Enabled := false;
    lvNbtDb.Enabled := false;
    label18.Enabled := false;
    label19.Enabled := false;
    label20.Enabled := false;
    cbField.Enabled := false;
    edtSearch.Enabled := false;
    btnSearchField.Enabled := false;
    btnSort.Enabled := false;
  end;

  for i := 0 to lvNbtDb.Columns.Count - 1 do cbField.Items.Add(lvNbtDb.Columns[i].Caption);
  cbField.ItemIndex := 0;
  PageSaveRange.ActivePageIndex := 0;

  SetWindowLong(edtPort.Handle, GWL_STYLE,
                  GetWindowLong(edtPort.Handle, GWL_STYLE) or ES_NUMBER);
  rbUseListClick(Self);
  for i := 0 to clbPort.Items.Count-1 do clbPort.Checked[i] := true;

  EnumInterfaces;

  LoadIpRange;
  //LoadFavoRange;
  LoadList;

end;

procedure TToolsForm.BtnCheckIPClick(Sender: TObject);
var GetIPThread:TGetIPThread;
begin

  if Radio1.Checked then   //主机名->IP地址
  begin
    GetIPThread:=TGetIPThread.Create(true);
    GetIPThread.FreeOnTerminate := true;
    GetIPThread.check_type := Name2IP;
    GetIPThread.hostName := Edit1.Text;
    GetIPThread.sIP:='正在查找.....';
    GetIPThread.Resume;
  end
  else
  begin
    if IsLegalIP(Edit1.Text) then  //IP地址->主机名
    begin
      GetIPThread:=TGetIPThread.Create(true);
      GetIPThread.FreeOnTerminate := true;
      GetIPThread.check_type := IP2Name;
      GetIPThread.sIP:=Edit1.Text;
      GetIPThread.hostName := '正在查找.....';
      GetIPThread.Resume;
    end
    else ShowMessage(Edit1.text+'不是合法的IP地址');
  end;
  Edit1.Text := '';

end;

procedure TToolsForm.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=vk_return then  BtnCheckIPClick(Self);
end;

procedure TToolsForm.Radio1Click(Sender: TObject);
begin
  Label1.Caption := '主机名(域名):';
  Edit1.SetFocus;
end;

procedure TToolsForm.Radio2Click(Sender: TObject);
begin
  Label1.Caption := 'IP地址:';
  Edit1.SetFocus;
end;

procedure TToolsForm.btnNbtClick(Sender: TObject);
begin

  if btnNbt.Tag = 0 then
  begin
    btnNbt.Tag := 1;
    btnNbt.Caption := '停止';
    NbtHasItem := false;

    if (not IsLegalIP(edtNbtIP1.Text))or(not IsLegalIP(edtNbtIP2.Text))  then
    begin
      ShowMessage('IP地址非法,请重新输入');
      exit;
    end;

    //btnNbt.Enabled := False;
    edtNbtIP1.Enabled := false;
    edtNbtIP2.Enabled := false;
    spInterval.Enabled := false;
    //BorderIcons := [{biSystemMenu,}biMaximize];

    {Nbt := TNbt.Create(self);
    Nbt.MyListView := lvNbt; }  //FormCreate

    cbAddToTree.Enabled := false;
    if cbAddToTree.Checked then
    begin
      MainForm.IpTree.Items[0].ImageIndex := 133;
      MainForm.IpTree.Items[0].SelectedIndex := 133;
    end;

    Nbt.StartIP := edtNbtIP1.Text;
    Nbt.EndIP := edtNbtIP2.Text;
    Nbt.wait_time := spInterval.Value;
    Nbt.OnEndEvent := NbtEndEvent;
    Nbt.OnSendEvent := NbtSendEvent;
    Nbt.OnAddNodeEvent := NbtAddNodeEvent;
    Nbt.Start;
  end
  else
  begin
    btnNbt.Tag := 0;
    btnNbt.Caption := '开始';
    Nbt.Stop;

    if NbtHasItem then AddIpAddrRange(edtNbtIP1.Text, edtNbtIP2.Text); //
  end
 
end;

procedure TToolsForm.lvNbtDblClick(Sender: TObject);
begin
  if lvNbt.Selected <> nil then
  with MainForm do
  begin
    LeftPageCtrl.ActivePageIndex := 2;
    if not cbIP.Checked then Edit1.Text := trim(lvNbt.Selected.SubItems[1])
    else Edit1.Text := trim(lvNbt.Selected.Caption);
    BtnFindClick(Self);
  end;
end;

procedure TToolsForm.NbtEndEvent(Sender: TObject);
begin
  //btnNbt.Enabled := true;
  btnNbt.Tag := 0;
  btnNbt.Caption := '开始';
  edtNbtIP1.Enabled := true;
  edtNbtIP2.Enabled := true;
  spInterval.Enabled := true;
  pnlStatus.Caption := '双击以搜索该主机';

  if cbAddToTree.Checked then
  begin
    MainForm.IpTree.Items[0].ImageIndex := 132;
    MainForm.IpTree.Items[0].SelectedIndex := 132;
  end;
  cbAddToTree.Enabled := true;

  if WindowState = wsMinimized then ShowWindow(Handle, SW_RESTORE);
  //BorderIcons := [biSystemMenu,biMaximize];

  if NbtHasItem then AddIpAddrRange(edtNbtIP1.Text, edtNbtIP2.Text);
end;

procedure TToolsForm.NbtSendEvent(Sender: TObject);
begin
  pnlStatus.Caption := Nbt.StatusString;
end;

procedure TToolsForm.NbtAddNodeEvent(Sender: TObject);
var
  TemNode       : TTreeNode;
  host          : string;
  MyItemPtr     : PMyTreeItem;
begin

  NbtHasItem := true;
  //caption := string(Sender);
  if cbAddToTree.Checked then
  with MainForm do
  begin
    LeftPageCtrl.ActivePageIndex := 0;
    SearchPageCtrl.ActivePageIndex := 1;
    host := '\\' + string(Sender);
    New(MyItemPtr);
    TemNode := IpTree.Items.AddChild(IpTree.Items[0], host);
    TemNode.ImageIndex := 7;
    TemNode.SelectedIndex := 7;
    IpTree.TopItem.Expand(false);
    MyItemPtr^.group := IpTree.Items[0].Text;
    MyItemPtr^.dirName := host;
    TemNode.Data := MyItemPtr;
  end;

  if (not cbNbtDataLoad.Checked) then AddNbtData(lvNbt.Items[0]); ///

end;

procedure TToolsForm.N1Click(Sender: TObject);
begin
  CurListView.Items.Clear;
end;

function FixLenStr(s: string; len: integer): string;
begin
  result := format('%-'+inttostr(len)+'s', [s]);
end;

procedure TToolsForm.SaveNbtData;
var
  NbtDataFile   : file of TNbtRecord;
  i             : integer;
  NR            : TNbtRecord;
  //NumWritten  : integer;
begin

  if lvNbtDb.Items.Count <> 0 then
  begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -