code3.~pas

这个也不错

unit code3;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus,shellapi, Buttons, StdCtrls, Gauges, ImgList, ScktComp, ExtCtrls,
  ComCtrls;

type
  TForm3 = class(TForm)
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    Gauge1: TGauge;
    ListBox1: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ImageList1: TImageList;
    ClientSocket1: TClientSocket;
    Timer1: TTimer;
    TreeView1: TTreeView;
    BitBtn3: TBitBtn;
    Label5: TLabel;
    Edit5: TEdit;
    Label6: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N1Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure BitBtn3Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    ftrayicon :hicon;
    ftip :string;
    fid :integer;
    fready :boolean;
    procedure settrayicon(value :hicon);
    procedure settip(const value:string);
    function shellnotify(msg ,flags :integer):boolean;

  protected
     procedure Defaulthandler(var message);override;
  public
    { Public declarations }
    property trayicon :hicon write settrayicon;
    property tip :string write settip;
    procedure setuptrayicon(vid :integer;vtrayicon:hicon; const vtip :string);
    
  end;

var
  Form3: TForm3;
  i :integer;

implementation

uses code, code2;

{$R *.DFM}
function TForm3.shellnotify(msg ,flags:integer):boolean;
var
 tnd :tNOtifyicondata;
begin
  result:=false;
  if fid=0 then exit ;
   fillchar(tnd,sizeof(tnd),0);
    tnd.wnd:=self.Handle ;
    tnd.uFlags  :=flags;
    if msg=NIM_ADD then
      tnd.uFlags :=tnd.uFlags  or NIF_message or nif_icon or nif_tip;
      tnd.cbSize :=sizeof(tnd);
     tnd.uID:=fid;
      tnd.uCallbackMessage :=wm_user+fid;
      if ftrayicon<> 0 then tnd.hIcon :=ftrayicon
      else tnd.hIcon :=loadicon(hinstance,IDI_WINLOGO);
      strlcopy(tnd.szTip ,pchar(ftip),64);
      result:=shell_NOtifyIcon(msg,@tnd);
      if result then Destroyicon(fTrayicon);
end;
 procedure TForm3.setuptrayicon(vid :integer;vtrayicon:hicon;const vtip:string);
   begin
     fid:=vid;
     ftrayicon:=vtrayicon;
     ftip:=vtip;
     fready:=true;
     shellnotify(NIm_add,nif_tip or nif_message or nif_icon);
   end;
 procedure TForm3.Defaulthandler(var  message);
   var
    cp :Tpoint;
      begin
       inherited Defaulthandler(message);
         with Tmessage(message) do
            if (fid<>0) and  (msg=WM_USER+fid) and (wparam=fid) then
              case lparam of
                WM_RBUTTONDOWN : if assigned(popupmenu) then
                 begin
                   setforegroundwindow(Handle);
                   getcursorpos(cp);
                   popupmenu1.Popup(cp.x,cp.y);
                   postmessage(handle,WM_USER,0,0);
                 end
            else
               begin
                 getcursorpos(cp);
                 popupmenu1.Popup(cp.x,cp.y); ;
               end;  
         end;
      end;
   procedure TForm3.settrayicon(value : hicon);
    begin
     if not fready then exit;
      if value=ftrayicon then exit;
      ftrayicon:=value;
       shellnotify(nim_modify,nif_icon)
    end;
  procedure TForm3.settip(const value :string);
    begin
     if not fready then exit;
     if value=ftip then exit;
      ftip:=value;
      shellnotify(nim_modify ,nif_tip)
    end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 shellnotify(nim_delete,0);
end;

procedure TForm3.N1Click(Sender: TObject);
begin
 form1.show;
end;

procedure TForm3.N9Click(Sender: TObject);
begin
  application.Terminate ;
end;

procedure TForm3.BitBtn1Click(Sender: TObject);
begin
 Gauge1.MaxValue:=strtoint(edit4.text); 
 i:=strtoint(edit3.text);
 timer1.Enabled:=true;
end;

procedure TForm3.Timer1Timer(Sender: TObject);
begin
  i:=i+1;
  gauge1.Progress:=i;
  form3.Caption:='正在扫描子网---------'+edit2.text+'.'+inttostr(i);
  clientsocket1.Address:=edit2.Text+'.'+inttostr(i);
  clientsocket1.Active:=true;
  clientsocket1.Port:=10150;
  if i=strtoint(edit4.text) then
   begin
    timer1.Enabled:=false;
    form3.Caption:='扫描完成......';
   end;
end;

procedure TForm3.BitBtn2Click(Sender: TObject);
begin
 clientsocket1.Active:=false;
 timer1.Enabled:=false;
end;

procedure TForm3.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
var
 node : TTreenode;
begin
 listbox1.Items.Add('ok'+socket.RemoteAddress);
 form1.TreeView1.Items.Add(nil,socket.RemoteAddress);
 clientsocket1.Active:=false;
end;

procedure TForm3.BitBtn3Click(Sender: TObject);
begin
 form3.Hide ;
end;

procedure TForm3.N6Click(Sender: TObject);
begin
  form4.show; 
end;

procedure TForm3.N7Click(Sender: TObject);
begin
 ShellExecute(GetDesktopWindow, 'open', 'mailto:[e-mail]', nil, nil, 0);
end;

procedure TForm3.N8Click(Sender: TObject);
begin
 ShellExecute(GetDesktopWindow, 'open', 'http://xingsys.126.com', nil, nil, 0);
end;

procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 timer1.Enabled:=false;
end;

end.