tools.pas

vpn网上邻居搜索器 工作组 未打开的工作组 正在搜索的工作组 已打开的工作组 无法打开的工作组 主机 未打开的主机 正在搜索的主机 打开的主机（无须登录） 打开的主机（以gues

var
  NbtDataFile   : file of TNbtRecord;
  item          : TListItem;
  i             : integer;
  NR            : TNbtRecord;
  //NumWritten  : integer;
begin

  if not FileExists('NbtData.db') then exit;
  
  AssignFile(NbtDataFile, 'NbtData.db');
  Reset(NbtDataFile);

  while not eof(NbtDataFile) do
  begin
    read(NbtDataFile, NR);
    item := lvNbtDb.Items.Add;
    item.Caption := trim(NR.IpAddr);
    for i := 0 to 3 do item.SubItems.Add('');
    item.SubItems[0] := trim(NR.GroupName);
    item.SubItems[1] := trim(NR.HostName);
    item.SubItems[2] := trim(NR.UserName);
    item.SubItems[3] := trim(NR.MacAddr);
    Application.ProcessMessages;
  end;

  CloseFile(NbtDataFile);

end;

procedure TToolsForm.AddNbtData(Item: TListItem);
var
  TemItem       : TListItem;
  i             : integer;
begin

  for i := 0 to lvNbtDb.Items.Count - 1 do
  begin
    if (trim(lvNbtDb.Items[i].Caption) = trim(Item.Caption))
    and(trim(lvNbtDb.Items[i].SubItems[0]) = trim(Item.SubItems[0]))
    and(trim(lvNbtDb.Items[i].SubItems[1]) = trim(Item.SubItems[1]))
    and(trim(lvNbtDb.Items[i].SubItems[2]) = trim(Item.SubItems[2]))
    and(trim(lvNbtDb.Items[i].SubItems[3]) = trim(Item.SubItems[3]))
    then exit;
    //Application.ProcessMessages;
  end;

  TemItem := lvNbtDb.Items.Add;
  TemItem.Caption := Item.Caption;
  TemItem.SubItems.Add(Item.SubItems[0]);
  TemItem.SubItems.Add(Item.SubItems[1]);
  TemItem.SubItems.Add(Item.SubItems[2]);
  TemItem.SubItems.Add(Item.SubItems[3]);
  Label20.Caption := '共 ' + inttostr(lvNbtDb.Items.Count) + ' 台主机';
  Application.ProcessMessages;

end;

procedure TToolsForm.N2Click(Sender: TObject);
var
  f             : textfile;
  i, j          : integer;
  s, str, s_h   : string;
begin

  if CurListView.Items.Count = 0 then
  begin
    Application.MessageBox('没有可保存的内容！  ','Save File',MB_OK );
    exit;
  end;

  s := TimeToStr(time);
  for i:=1 to length(s) do if s[i]=':' then s[i]:='-';
  // 注意 PageCtrl.ActivePage.Caption 中不应含有文件名中不允许使用的字符。
  SaveDlg.FileName := PageCtrl.ActivePage.Caption +'('+datetostr(now)+'-'+s+')';
  
  if SaveDlg.Execute then
  begin
    NewStyleControls := False;
    assignfile(f,SaveDlg.filename);
    rewrite(f);

    for j:=0 to (CurListView.Columns.Count - 1)
      do s_h := s_h + FixLenStr(CurListView.Columns[j].Caption, 15) + #9;
    writeln(f, s_h);
    for j:=0 to (CurListView.Columns.Count - 1) do write(f, '----------------');
    writeln(f);

    for i:=0 to CurListView.Items.Count-1 do
    begin
      str := FixLenStr(CurListView.Items[i].Caption, 15) + #9;  //#9 is tab
      for j:=0 to (CurListView.Items[i].SubItems.Count-1) do
        str := str + FixLenStr(CurListView.Items[i].SubItems[j], 15) + #9;
        
      writeln(f, str);
      writeln(f);
    end;
    
    closefile(f);
    NewStyleControls := true; 
  end;

end;

procedure TToolsForm.PopupMenu1Popup(Sender: TObject);
begin

  PageCtrlChange(Self);

  N1.Enabled := false;
  N2.Enabled := false;
  if CurListView.Items.Count <> 0 then
  begin
    N1.Enabled := true;
    N2.Enabled := true;
  end;
  
end;

procedure TToolsForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if (not btnNbt.Enabled)or(not btnScanPort.Enabled)or(not btnPing.Enabled) then
  begin
    CanClose := false;
    ShowMessage('扫描尚未完成，请稍候。');
  end
  else CanClose := true;
end;

//------------------------------------------------------------------------------
procedure TToolsForm.PortShowProgress(Sender: TObject);
begin
  with Sender as TScanStatus do
  Label11.Caption := '正在扫描 ' + IP + ' 端口：' + Port;
end;

procedure TToolsForm.PortOnConnect(Sender: TObject);
var
  item          : TListItem;
  TemNode       : TTreeNode;
  host          : string;
  MyItemPtr     : PMyTreeItem;
  status        : TScanStatus;
begin
  //ListBox1.Items.Add(string(Sender));
  item := lvPortScan.Items.Add;
  status := TScanStatus(Sender);
  item.Caption := status.IP;//string(Sender);
  item.SubItems.Add(status.Port{cbScanPort.Text});

  if cbAddToTree2.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.Items[0].Expand(false);
    MyItemPtr^.group := IpTree.Items[0].Text;
    MyItemPtr^.dirName := host;
    TemNode.Data := MyItemPtr;
  end;

end;

procedure TToolsForm.PortOnExitScan(Sender: TObject);
begin
  btnScanPort.Enabled := true;
  edtScanIP1.Enabled := true;
  edtScanIP2.Enabled := true;
  cbScanPort1.Enabled := true;
  cbScanPort2.Enabled := true;
  spTimeOut.Enabled := true;
  Label11.Caption := '完成';
end;

procedure TToolsForm.btnScanPortClick(Sender: TObject);
var
  ScanThread: TScanTcpPortThread;
begin

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

  ScanThread := TScanTcpPortThread.Create(edtScanIP1.Text, edtScanIP2.Text,
        strtoint(cbScanPort1.Text), strtoint(cbScanPort2.Text), spTimeOut.Value);
  ScanThread.OnSendEvent := PortShowProgress;
  ScanThread.OnConnectEvent := PortOnConnect;
  ScanThread.OnExitEvent := PortOnExitScan;
  ScanThread.Resume;

  btnScanPort.Enabled := false;
  edtScanIP1.Enabled := false;
  edtScanIP2.Enabled := false;
  cbScanPort1.Enabled := false;
  cbScanPort2.Enabled := false;
  spTimeOut.Enabled := false;

end;

procedure TToolsForm.lvPortScanDblClick(Sender: TObject);
begin

  if lvPortScan.Selected <> nil then
  begin
    if lvPortScan.Selected.SubItems[0] = '80' then
    begin
      ExecuteFile('http://'+lvPortScan.Selected.Caption,'','',1);
    end
    else
    if lvPortScan.Selected.SubItems[0] = '21' then
    begin
      ExecuteFile('ftp://'+lvPortScan.Selected.Caption,'','',1);
    end
    else
    if lvPortScan.Selected.SubItems[0] = '139' then
    begin
      with MainForm do
      begin
        LeftPageCtrl.ActivePageIndex := 2;
        Edit1.Text := trim(lvPortScan.Selected.Caption);
        BtnFindClick(Self);
      end;
    end
  end;
  
end;

procedure TToolsForm.PageCtrlChange(Sender: TObject);
begin

  case PageCtrl.ActivePageIndex of
    0:
    begin
      CurListView := IPListView;
    end;
    1:
    begin
      CurListView := lvNbt;
    end;
    2:
    begin
      CurListView := lvPortScan;
    end;
    3:
    begin
      CurListView := lvPing;
    end;
    5:
    begin
      CurListView := lvNbtDb;
    end;
  end; // end of case

end;

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

  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;
  edtPing1.Enabled := true;
  edtPing2.Enabled := true;
  spPingTime.Enabled := true;
end;

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

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

  if (not IsLegalIP(edtPing1.Text))or(not IsLegalIP(edtPing2.Text))  then
  begin
    ShowMessage('IP地址非法，请重新输入');
    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;

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;
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');
  SaveNbtData;
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;

end.