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

📄 tools.pas

📁 vpn网上邻居搜索器 工作组 未打开的工作组 正在搜索的工作组 已打开的工作组 无法打开的工作组 主机 未打开的主机 正在搜索的主机 打开的主机(无须登录) 打开的主机(以gues
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Tools;

interface

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

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;
    Label10: TLabel;
    cbScanPort1: TComboBox;
    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;
    btnSort: TSpeedButton;
    Label21: TLabel;
    cbScanPort2: TComboBox;
    Label22: TLabel;
    Bevel1: TBevel;
    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);
  private
    { Private declarations }
    CurListView: TListView;
    //SaveFileName: string;

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

    //----------------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;
  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;
{$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');

  LoadNbtData;
  Label20.Caption := '共 ' + inttostr(lvNbtDb.Items.Count) + ' 台主机';

  for i := 0 to lvNbtDb.Columns.Count - 1 do cbField.Items.Add(lvNbtDb.Columns[i].Caption);
  cbField.ItemIndex := 0;
  
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 (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

  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;

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;
  edtNbtIP1.Enabled := true;
  edtNbtIP2.Enabled := true;
  spInterval.Enabled := true;
  pnlStatus.Caption := '双击以搜索该主机';
  //BorderIcons := [biSystemMenu,biMaximize];
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
  //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;

  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
    AssignFile(NbtDataFile, 'NbtData.db');
    ReWrite(NbtDataFile);

    for i:=0 to lvNbtDb.Items.Count-1 do
    begin
      NR.IpAddr := trim(lvNbtDb.Items[i].Caption);
      NR.GroupName := trim(lvNbtDb.Items[i].SubItems[0]);
      NR.HostName := trim(lvNbtDb.Items[i].SubItems[1]);
      NR.UserName := trim(lvNbtDb.Items[i].SubItems[2]);
      NR.MacAddr := trim(lvNbtDb.Items[i].SubItems[3]);
      //NR.Separator := #13;
      {Block}Write(NbtDataFile, NR{, SizeOf(NR), NumWritten});
    end;

    CloseFile(NbtDataFile);
  end;

end;

procedure TToolsForm.LoadNbtData;

⌨️ 快捷键说明

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