delphi7 托盘程序

unit UMain;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellAPI, Menus, ImgList, winsock, Sockets, IdBaseComponent, IdComponent,
  IdUDPBase, IdUDPClient, StdCtrls;


const
  NIF_INFO = $00000010; //气泡显示标志
  NIIF_NONE = $00000000; //无图标
  NIIF_INFO = $00000001; //信息图标
  NIIF_WARNING = $00000002; //警告图标
  NIIF_ERROR = $00000003; //错误图标
  NIIF_USER = $00000004; //XP使用hIcon图标
type
  TNotifyIconDataEx = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array[0..127] of AnsiChar;
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array[0..255] of AnsiChar;
    case Integer of
      0: (
        uTimeout: UINT);
      1: (uVersion: UINT;
        szInfoTitle: array[0..63] of AnsiChar;
        dwInfoFlags: DWORD);
  end;
const
  WM_TRAYMSG = WM_USER + 101; //自定义托盘消息
  WM_SOCK = WM_USER + 1; //自定义windows消息
  UDPPORT = 2445; //设定UDP端口号


type
  TTrayForm = class(TForm)
    pm1: TPopupMenu;
    One1: TMenuItem;
    wo1: TMenuItem;
    N1: TMenuItem;
    il1: TImageList;
    UdpSocket: TUdpSocket;
    Memo1: TMemo;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure One1Click(Sender: TObject);
    procedure wo1Click(Sender: TObject);
    //    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TrayDblClick(Sender: TObject);
    procedure UdpSocketReceive(Sender: TObject; Buf: PAnsiChar;
      var DataLen: Integer);
  private
    FSocket: TSocket;
    FSockAddr: TSockAddr;
    FSockAddrIn: TSockAddrIn;


    procedure WMTrayMsg(var Msg: TMessage); message WM_TRAYMSG; //声明托盘消息
    procedure WMSysCommand(var Msg: TMessage); message WM_SYSCOMMAND;
    procedure myminimize(sender: Tobject); //自定义最小化操作


    //利用消息实时获知UDP消息
    procedure ReadData(var Message: TMessage);
      message WM_SOCK;


  public
    procedure SendData(Content: string);
  end;


var
  TrayForm: TTrayForm;
  //  NotifyIcon: TNotifyIconData; //定义托盘图标结构体
  NotifyIcon: TNotifyIconDataEx; //定义托盘图标结构体
implementation


{$R *.dfm}


{ TTrayForm }


procedure TTrayForm.WMSysCommand(var Msg: TMessage);
begin
  if Msg.WParam = SC_ICON then
    Self.Visible := False
  else
    DefWindowProc(Self.Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;


procedure TTrayForm.WMTrayMsg(var Msg: TMessage);
var
  p: TPoint;
begin
  case Msg.LParam of
    WM_LBUTTONDOWN: //Self.Visible := True; //显示窗体
      begin
        if Self.Showing then
          Self.Close
        else
        begin
          Self.Show;
          SetForegroundWindow(Application.Handle);
        end;
      end;
    WM_RBUTTONDOWN:
      begin
        SetForegroundWindow(Self.Handle); //把窗口提前
        GetCursorPos(p);
        pm1.Popup(p.X, p.Y);
      end;
  end;
end;


procedure TTrayForm.FormCreate(Sender: TObject);
var
  TempWSAData: TWSAData;
begin
  //  Application.OnMinimize := myminimize;
  //  Application.ShowMainForm := False;
    //窗体创建时，即创建托盘
  with NotifyIcon do
  begin
    cbSize := SizeOf(TNotifyIconDataEx);
    Wnd := Self.Handle;
    uID := 1;
    uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP + NIF_INFO; //图标、消息、提示信息
    uCallbackMessage := WM_TRAYMSG;
    hIcon := Application.Icon.Handle;
    szTip := '托盘程序';
    szInfo := '通信托盘程序';
    szInfoTitle := '托盘气泡';
    dwInfoFlags := NIIF_USER;
    OnDblClick := TrayDblClick;
  end;
  Shell_NotifyIcon(NIM_ADD, @NotifyIcon);


  memo1.Clear;
  //  memo2.Clear;
  //  edit1.Text := '127.0.0.1';


  if WSAStartup($101, TempWSAData) = 1 then
    ShowMessage('启动错误!');


  FSocket := Socket(AF_INET, SOCK_DGRAM, 0);
  if (FSocket = INVALID_SOCKET) then //Socket创建失败
  begin
    ShowMessage(IntToStr(WSAGetLastError()) + '  Socket创建失败');
    CloseSocket(FSocket);
    //          exit;
  end;
  //发送方SockAddr绑定
  FSockAddr.sin_family := AF_INET;
  FSockAddr.sin_addr.S_addr := INADDR_ANY;
  FSockAddr.sin_port := htons(UDPPORT);
  if Bind(FSocket, FSockAddr, sizeof(FSockAddr)) <> 0 then
  begin
    showmessage('端口绑定失败!');
  end;


  WSAAsyncSelect(FSocket, Self.Handle, WM_SOCK, FD_READ);
  //接收端SockAddrIn设定
  FSockAddrIn.SIn_Family := AF_INET;
  FSockAddrIn.SIn_Port := htons(UDPPORT);


  //  Self.WindowState := wsMinimized;
    //  with NotifyIcon do
    //  begin
    //    cbSize := SizeOf(TNotifyIconData);
    //    Wnd := Self.Handle;
    //    uID := 1;
    //    uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP; //图标、消息、提示信息
    //    uCallbackMessage := WM_TRAYMSG;
    //    hIcon := Application.Icon.Handle;
    //    szTip := '托盘测试';
    //  end;
    //  Shell_NotifyIcon(NIM_ADD, @NotifyIcon);
end;


procedure TTrayForm.One1Click(Sender: TObject);
begin
  //  ShowWindow(Self.Handle, SW_RESTORE);
  if Self.Showing then
  begin
    Self.Close();
    Shell_NotifyIcon(NIM_ADD, @NotifyIcon);
    One1.Caption := '显示';
  end
  else
  begin
    Self.Show;
    One1.Caption := '隐藏';
    SetForegroundWindow(Application.Handle);
  end;
end;


procedure TTrayForm.wo1Click(Sender: TObject);
begin
  //  Self.WindowState := wsMinimized;
  ShowWindow(Self.Handle, SW_HIDE);
end;


//在托盘处删除图标


//procedure TTrayForm.FormClose(Sender: TObject; var Action: TCloseAction);
//begin
//  shell_notifyicon(NIM_DELETE, @NotifyIcon);
//  Application.ProcessMessages;
//  Application.Terminate;
//end;


procedure TTrayForm.myminimize(sender: Tobject);
begin
  //隐藏窗口
//  TrayForm.Hide;
  //在任务栏中隐藏应用程序
  ShowWindow(Self.Handle, SW_Hide);
end;


procedure TTrayForm.FormShow(Sender: TObject);
begin


  SetWindowPos(Application.Handle, hwnd_top, 0, 0, 0, 0, swp_hidewindow); //不显示在系统栏


  //  ShowWindow(TrayForm.Handle, SW_HIDE);
  //  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW or
  //    GetWindowLong(Handle, GWL_EXSTYLE));


end;


procedure TTrayForm.N1Click(Sender: TObject);
begin
  CloseSocket(FSocket);
  Shell_NotifyIcon(NIM_DELETE, @NotifyIcon);
  Application.ProcessMessages;
  Application.Terminate;
end;


//点击关闭按钮至托盘


procedure TTrayForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := False;
  Self.Hide;
end;


procedure TTrayForm.TrayDblClick(Sender: TObject);
begin
  if (Self.Showing) then
  begin
    ShowWindow(Self.Handle, SW_HIDE);
  end
  else
    ShowWindow(Self.Handle, SW_RESTORE);


end;


procedure TTrayForm.UdpSocketReceive(Sender: TObject; Buf: PAnsiChar;
  var DataLen: Integer);
begin
  //
end;


procedure TTrayForm.ReadData(var Message: TMessage);
var
  buf: array[0..1024] of char;
  len: integer;
  flen: integer;
  Event: word;
  fromip, value: string;


begin


  flen := sizeof(FSockAddrIn);
  FSockAddrIn.SIn_Port := htons(UDPPORT);
  Event := WSAGetSelectEvent(Message.LParam);
  if Event = FD_READ then
  begin
    len := recvfrom(FSocket, buf, sizeof(buf), 0, FSockAddrIn, flen);
    value := copy(buf, 1, len);


    fromip := inet_ntoa(FSockAddrIn.sin_addr); //对方ip
    memo1.Lines.Add(value); //显示接收到的信息
    WinExec(PChar('A.bat ' + value), SW_NORMAL); //SW_HIDE) ;//


  end;
end;


procedure TTrayForm.SendData(Content: string);
var
  value {,hostname}: string;
  len: integer;
begin


  FSockAddrIn.sin_addr.S_addr := inet_addr(pchar('127.0.0.1')); //INADDR_BROADCAST;   //INADDR_BROADCAST = -1 ?
  value := Content;
  len := sendto(FSocket, value[1], Length(value), 0, FSockAddrIn, sizeof(FSockAddrIn));
  if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then ;


  if len = SOCKET_ERROR then
  begin
    ShowMessage('发送失败！');
  end;
  if len <> Length(value) then
  begin
    ShowMessage('没有全部发送！');
  end;
end;


end.