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

📄 tools.pas

📁 该程序用D5编译
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    begin
      CurListView := lvNbt;
    end;
    2:
    begin
      CurListView := lvPortScan;
    end;
    3:
    begin
      CurListView := lvPing;
    end;
    5:
    begin
      CurListView := lvNbtDb;
    end;
    6:
    begin
      CurListView := lvIpAddr;
    end
  end; // end of case

end;

procedure TToolsForm.PingReply(Sender: TObject);
var
  r             : TPingReply;
  item          : TListItem;
  
  host          : string;
  TemNode       : TTreeNode;
  MyItemPtr     : PMyTreeItem;
begin

  PingHasItem := true;
  r := TPingReply(Sender);
  item := lvPing.Items.Add;
  item.Caption := r.IP;
  //Memo1.Lines.Add(r.IP + ' ' + R.bytes + ' ' + R.RTT);

  if cbAddToTree3.Checked then
  with MainForm do
  begin
    LeftPageCtrl.ActivePageIndex := 0;
    SearchPageCtrl.ActivePageIndex := 1;
    host := '\\' + r.IP;
    New(MyItemPtr);
    TemNode := IpTree.Items.AddChild(IpTree.Items[0], host);
    TemNode.ImageIndex := 7;
    TemNode.SelectedIndex := 7;
    IpTree.Items[0].Expand(false);
    MyItemPtr^.group := IpTree.Items[0].Text;
    MyItemPtr^.dirName := host;
    TemNode.Data := MyItemPtr;
  end;

end;

procedure TToolsForm.PingBegin(Sender: TObject);
begin
  //btnPing.Enabled := false;
  edtPing1.Enabled := false;
  edtPing2.Enabled := false;
  spPingTime.Enabled := false;
end;

procedure TToolsForm.PingEnd(Sender: TObject);
begin
  //btnPing.Enabled := true;
  btnPing.Tag := 0;
  btnPing.Caption := '开始';
  edtPing1.Enabled := true;
  edtPing2.Enabled := true;
  spPingTime.Enabled := true;
  if WindowState = wsMinimized then ShowWindow(Handle, SW_RESTORE);
  if PingHasItem then AddIpAddrRange(edtPing1.Text, edtPing2.Text);
end;

procedure TToolsForm.PingSend(Sender: TObject);
begin
  Label16.Caption := string(Sender);
end;

procedure TToolsForm.btnPingClick(Sender: TObject);
var
  PingThread: TPingThread;
begin

  if btnPing.Tag = 0 then
  begin
    PingHasItem := false;
    btnPing.Tag := 1;
    btnPing.Caption := '停止';
    exit_ping_thread := false;

    if (not IsLegalIP(edtPing1.Text))or(not IsLegalIP(edtPing2.Text))  then
    begin
      ShowMessage('IP地址非法,请重新输入');
      //Application.MessageBox('IP地址非法,请重新输入。', '网络工具', 0);
      exit;
    end;

    PingThread := TPingThread.Create(edtPing1.Text, edtPing2.Text, spPingTime.Value);
    PingThread.OnRecvEvent := PingReply;
    PingThread.OnSendEvent := PingSend;
    PingThread.OnBeginEvent := PingBegin;
    PingThread.OnEndEvent := PingEnd;
    PingThread.Resume;
  end
  else
  begin
    btnPing.Tag := 0;
    btnPing.Caption := '开始';
    exit_ping_thread := true;
  end

end;

procedure TToolsForm.lvPingDblClick(Sender: TObject);
begin
  if lvPing.Selected <> nil then
  with MainForm do
  begin
    LeftPageCtrl.ActivePageIndex := 2;
    Edit1.Text := trim(lvPing.Selected.Caption);
    BtnFindClick(Self);
  end;
end;

procedure TToolsForm.SendMsgResultEvent(Sender: TObject);
begin
  //lbResult.Items.Insert(0, string(Sender));
  beep;
  if WindowState = wsMinimized then ShowWindow(Handle, SW_RESTORE);
end;

procedure TToolsForm.btnSendMsgClick(Sender: TObject);
var
  SendMsgThread: TSendMsgThread;
  item: TListItem;
begin
  SendMsgThread := TSendMsgThread.Create(true);
  SendMsgThread.From := '';
  SendMsgThread.ToHost := cbToHost.Text;
  SendMsgThread.Msg := memMsg.Text;
  SendMsgThread.OnResultEvent := SendMsgResultEvent;
  SendMsgThread.FreeOnTerminate := true;

  item := lvSendMsg.Items.Insert(0);
  item.Caption := cbToHost.Text;
  item.SubItems.Add(memMsg.Text);
  item.SubItems.Add('正在发送');
  SendMsgThread.MyListItem := item;

  SendMsgThread.Resume;

  if cbToHost.Items.IndexOf(cbToHost.Text) = -1 then cbToHost.Items.Add(cbToHost.Text);
  if cbClearMsg.Checked then memMsg.Clear;
end;

procedure TToolsForm.FormDestroy(Sender: TObject);
begin
  cbToHost.Items.SaveToFile(AppDir+'SendToHost.txt');
  if (not MainForm.bNotAutoSaveNbt) then SaveNbtData;

  SaveAddrRange;
end;

procedure TToolsForm.lvSendMsgDblClick(Sender: TObject);
begin
  if lvSendMsg.Selected <> nil then memMsg.Text := lvSendMsg.Selected.SubItems[0];
  //windows.beep(2000, 2000);
end;

procedure TToolsForm.btnSearchFieldClick(Sender: TObject);
var
  i: integer;
  Item: TListItem;
begin

  if cbField.ItemIndex = 0 then
  for i := 0 to lvNbtDb.Items.Count - 1 do
  begin
    if (LowerCase(trim(lvNbtDb.Items[i].Caption)) = LowerCase(trim(EdtSearch.Text))) then
    begin
      Item := lvSearchResult.Items.Add;
      Item.Caption := lvNbtDb.Items[i].Caption;
      Item.SubItems.Add(lvNbtDb.Items[i].SubItems[0]);
      Item.SubItems.Add(lvNbtDb.Items[i].SubItems[1]);
      Item.SubItems.Add(lvNbtDb.Items[i].SubItems[2]);
      Item.SubItems.Add(lvNbtDb.Items[i].SubItems[3]);
    end;
    Application.ProcessMessages;
  end
  else
  for i := 0 to lvNbtDb.Items.Count - 1 do
  begin
    if (LowerCase(trim(lvNbtDb.Items[i].SubItems[cbField.ItemIndex-1]))
      = LowerCase(trim(EdtSearch.Text))) then
    begin
      Item := lvSearchResult.Items.Add;
      Item.Caption := lvNbtDb.Items[i].Caption;
      Item.SubItems.Add(lvNbtDb.Items[i].SubItems[0]);
      Item.SubItems.Add(lvNbtDb.Items[i].SubItems[1]);
      Item.SubItems.Add(lvNbtDb.Items[i].SubItems[2]);
      Item.SubItems.Add(lvNbtDb.Items[i].SubItems[3]);
    end;
    Application.ProcessMessages;
  end;
  
end;

procedure TToolsForm.btnSortClick(Sender: TObject);
begin
  lvNbtDb.SortType := stText;
end;

procedure TToolsForm.cbScanPort1Change(Sender: TObject);
begin
  cbScanPort2.Text := cbScanPort1.Text;
end;

procedure TToolsForm.lvIpAddrDblClick(Sender: TObject);
begin

  if lvIpAddr.Selected = nil then exit;
  with MainForm do
  begin
    edtIP1.Text := lvIpAddr.Selected.Caption;
    edtIP2.Text := lvIpAddr.Selected.SubItems[0];
    LeftPageCtrl.ActivePageIndex := 0;
    SearchPageCtrl.ActivePageIndex := 1;
  end;

end;

procedure TToolsForm.btnRefreshIpCfgClick(Sender: TObject);
begin
  memIpCfg.Lines.Clear;
  lvIpAddr.Items.Clear;
  EnumInterfaces;
end;

procedure TToolsForm.cbNbtDataLoadClick(Sender: TObject);
begin

  lvSearchResult.Enabled := not cbNbtDataLoad.Checked;
  lvNbtDb.Enabled := not cbNbtDataLoad.Checked;
  label18.Enabled := not cbNbtDataLoad.Checked;
  label19.Enabled := not cbNbtDataLoad.Checked;
  label20.Enabled := not cbNbtDataLoad.Checked;
  cbField.Enabled := not cbNbtDataLoad.Checked;
  edtSearch.Enabled := not cbNbtDataLoad.Checked;
  btnSearchField.Enabled := not cbNbtDataLoad.Checked;
  btnSort.Enabled := not cbNbtDataLoad.Checked;

  if (not cbNbtDataLoad.Checked)and(lvNbtDb.Items.Count = 0)
  then LoadNbtData;

end;

procedure TToolsForm.SaveAddrRange;
var
  AddrFile      : TextFile;
  i             : integer;
begin

  if lvIpAddrRange.Items.Count <> 0 then
  begin
    AssignFile(AddrFile, AppDir + '\AddrRange.txt');
    ReWrite(AddrFile);

    for i:=0 to lvIpAddrRange.Items.Count-1 do
    begin
      writeln(AddrFile, lvIpAddrRange.Items[i].Caption);
      writeln(AddrFile, lvIpAddrRange.Items[i].SubItems[0]);
    end;

    CloseFile(AddrFile);
  end;

end;

procedure TToolsForm.LoadAddrRange;
var
  AddrFile      : TextFile;
  //i             : integer;
  s1, s2        : string;
  Item          : TListItem;
begin

  if FileExists('AddrRange.txt') then
  begin
    AssignFile(AddrFile, 'AddrRange.txt');
    Reset(AddrFile);

    while not eof(AddrFile) do
    begin
      readln(AddrFile, s1);
      readln(AddrFile, s2);
      Item := lvIpAddrRange.Items.Add;
      Item.Caption := s1;
      Item.SubItems.Add(s2);
      //if eoln(AddrFile) then readln(AddrFile);
    end;

    CloseFile(AddrFile);
  end;

end;

procedure TToolsForm.AddIpAddrRange(ip1, ip2: string);
var
  i: integer;
  nIP1, nIP2, nAddr1, nAddr2: dword;
  b: boolean;
  Item: TListItem;
begin

  nIP1 := ntohl(inet_addr(pchar(IP1)));
  nIP2 := ntohl(inet_addr(pchar(IP2)));

  b := false;

  for i := 0 to (lvIpAddrRange.Items.Count-1) do
  begin
    nAddr1 := ntohl(inet_addr(pchar(lvIpAddrRange.Items[i].Caption)));
    nAddr2 := ntohl(inet_addr(pchar(lvIpAddrRange.Items[i].SubItems[0])));

    {
                 nAddr1           nAddr2
            nIP1           nIP2
    }
    if (nIP2 >= nAddr1)and(nIP1 <= nAddr1)and(nIP1 <= nAddr2) then
    begin
      lvIpAddrRange.Items[i].Caption := IP1;
      b := true;
    end;

    {
                 nAddr1          nAddr2
            nIP1                          nIP2
    }
    if (nIP1 <= nAddr1)and(nIP2 >= nAddr2) then
    begin
      lvIpAddrRange.Items[i].Caption := IP1;
      lvIpAddrRange.Items[i].SubItems[0] := IP2;
      b := true;
    end;

    {
                 nAddr1                  nAddr2
                        nIP1      nIP2
    }
    if (nIP1 >= nAddr1)and(nIP2 <= nAddr2) then
    begin
      b := true;
    end;

    {
                 nAddr1          nAddr2
                        nIP1              nIP2
    }
    if (nIP1 >= nAddr1)and((nIP1 <= nAddr2))and(nIP2 >= nAddr2) then
    begin
      lvIpAddrRange.Items[i].SubItems[0] := IP2;
      b := true;
    end;

  end;

  if (not b) then
  begin
    Item := lvIpAddrRange.Items.Add;
    Item.Caption := IP1;
    Item.SubItems.Add(IP2);
  end;

end;

procedure TToolsForm.lvIpAddrRangeDblClick(Sender: TObject);
begin
  if lvIpAddrRange.Selected = nil then exit;
  with MainForm do
  begin
    edtIP1.Text := lvIpAddrRange.Selected.Caption;
    edtIP2.Text := lvIpAddrRange.Selected.SubItems[0];
    LeftPageCtrl.ActivePageIndex := 0;
    SearchPageCtrl.ActivePageIndex := 1;
  end;
end;

procedure TToolsForm.btnDelIpRangeClick(Sender: TObject);
var
  i: integer;
begin
  for i:=(lvIpAddrRange.Items.Count - 1) downto 0 do
  begin
    if lvIpAddrRange.Items[i].Selected then lvIpAddrRange.Items[i].Delete;
  end
end;

end.

⌨️ 快捷键说明

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