search.pas

一个远程监控程序

unit Search;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp, OleCtrls, ExtCtrls, Winsock,ComCtrls, Mask, Gauges,
  XPMenu;

type
  Tsearchform = class(TForm)
    Label1: TLabel;
    edt_port: TEdit;
    Label2: TLabel;
    edt_delay: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    searchip: TEdit;
    Label5: TLabel;
    beginadd: TEdit;
    Label6: TLabel;
    endadd: TEdit;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    CSocket: TClientSocket;
    noserbtn: TButton;
    Animate1: TAnimate;
    gprog_scan: TGauge;
    gbox_result: TGroupBox;
    okiplist: TListBox;
    XPMenu1: TXPMenu;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure noserbtnClick(Sender: TObject);
    procedure CSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
    Pro_Count:Longint;
    function LocalIP: string;
  public
    { Public declarations }
  end;

var
  searchform: Tsearchform;
  ipnum:integer;

implementation

uses Umain;

{$R *.DFM}

function Tsearchform.LocalIP: string; //得到本机IP;
type
    TaPInAddr = array [0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
var
    phe  : PHostEnt;
    pptr : PaPInAddr;
    Buffer : array [0..63] of char;
    I    : Integer;
    GInitData      : TWSADATA;

begin
    WSAStartup($101, GInitData);
    Result := '';
    GetHostName(Buffer, SizeOf(Buffer));
    phe :=GetHostByName(buffer);
    if phe = nil then Exit;
    pptr := PaPInAddr(Phe^.h_addr_list);
    I := 0;
    while pptr^[I] <> nil do begin
      result:=StrPas(inet_ntoa(pptr^[I]^));
      Inc(I);
    end;
    WSACleanup;
end;


procedure Tsearchform.Button2Click(Sender: TObject);
begin
    timer1.Enabled:=false;
    searchform.Close;
end;

procedure Tsearchform.FormCreate(Sender: TObject);
var i:integer;
    thename1,thename2,thename3:string;
begin
  frmClient.ClntSocket.Close;
  okiplist.Clear;
  searchip.Text:=LocalIP;
  if searchip.Text='' then searchip.Text:='127.0.0.0';
   i:=length(searchip.text);
   thename1:=copy(searchip.text,i-1,1);
   thename2:=copy(searchip.text,i-2,1);
   thename3:=copy(searchip.text,i-3,1);
   if thename1='.' then  searchip.text:=copy(searchip.Text,1,i-2)
   else  if thename2='.' then searchip.Text:=copy(searchip.text,1,i-3)
   else searchip.Text:=copy(searchip.text,1,i-4);
end;

procedure Tsearchform.Button1Click(Sender: TObject);
var i:integer;
begin
    Animate1.Active:=true;
    //Animate1.Play(1,8,10000);
    okiplist.Clear;
    frmClient.cob_ip.Items.Clear;
    ipnum:=strtoint(beginadd.Text);
    timer1.Enabled:=true;
    i:=strtoint(edt_delay.text);
    if i<500 then i:=500;
    timer1.Interval:=i;
    noserbtn.Enabled:=true;
    gprog_scan.Progress:=0;
    Pro_Count:=StrToInt(endadd.Text) - StrToInt(beginadd.Text);
    If pro_Count <> 0 Then
       gprog_scan.MaxValue:=pro_Count * 1000
    Else
       gprog_scan.MaxValue:=100;
    noserbtn.Caption:='终止搜索';
end;

procedure Tsearchform.Timer1Timer(Sender: TObject);
begin
 try
  CSocket.Host:=searchip.Text+'.'+inttostr(ipnum);
  csocket.Active:=true;
  searchform.Caption:='自动搜捕主机:'+searchip.text+'.'+inttostr(ipnum);
Finally
  ipnum:=ipnum+1;
  if pro_Count=0 then pro_Count:=100;
  gprog_scan.Progress:=gprog_scan.Progress+(gprog_scan.MaxValue DIV pro_Count);
  if ipnum > Strtoint(endadd.Text) then
  begin
    timer1.Enabled:=False;
    Animate1.Stop;
    noserbtn.Enabled:=false;
    noserbtn.Caption:='终止搜索';
//    CSocket.Active:=false;
    csocket.Close;
    searchform.Caption:='自动搜捕主机: 完毕!';
  end;
End;
end;

procedure Tsearchform.CSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
if Timer1.Enabled then begin
  okiplist.Items.Add('IP:'+searchip.Text+'.'+inttostr(ipnum)+'  ERROR');
end;
  ErrorCode:=0;
end;

procedure Tsearchform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Timer1.Enabled:=false;
  CSocket.Active:=False;
  CSocket.Close;
end;

procedure Tsearchform.noserbtnClick(Sender: TObject);
begin
 if noserbtn.Caption='终止搜索' then
 begin
  noserbtn.Caption:='继续搜索';
  Animate1.Stop;
  timer1.Enabled:=false;
  CSocket.Active:=False;
  CSocket.Close;
 end
 else
 begin
   noserbtn.Caption:='终止搜索';
   timer1.Enabled:=true;
   Animate1.Active:=true;
 end;
end;

procedure Tsearchform.CSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
Var
  TreeNode1,TreeNode2: TTreeNode;
begin
  if Timer1.Enabled then begin
    okiplist.Items.Add('IP:'+socket.RemoteAddress+'     OK');
    frmClient.cob_ip.Items.Add(socket.remoteaddress);
    With frmClient.tv_PClist.Items do begin
      TreeNode1 := Add(nil, socket.RemoteAddress);
 {     AddChild(TreeNode1,'ChildNode1');
      TreeNode2 := Add(TreeNode1, 'RootTreeNode2');
      AddChild(TreeNode2,'ChildNode2');
      TreeNode2 := frmClient.tv_PClist.Items[3];
      AddChild(TreeNode2,'ChildNode2a');
      Add(TreeNode2,'ChildNode2b');
      Add(TreeNode1, 'RootTreeNode3');}
    end;

    csocket.Close;
  end;
end;
end.