trayicon.pas

由于该木马有三个服务端可以选择生成

function TTrayIcon.GetAnimateInterval: Integer;
begin
  Result := FTimer.Interval;
end;

procedure TTrayIcon.SetAnimateInterval(Value: Integer);
begin
  FTimer.Interval := Value;
end;

function TTrayIcon.GetAnimate: Boolean;
begin
  Result := FAnimate;
end;

procedure TTrayIcon.SetAnimate(Value: Boolean);
begin
  if (FIconList <> nil) or (csLoading in ComponentState) then
    FAnimate := Value;

  if (FIconList <> nil) and not(csDesigning in ComponentState) then
    FTimer.Enabled := Value;
end;

procedure TTrayIcon.EndSession;
begin
  Shell_NotifyIcon(NIM_DELETE, @FData);
end;

function TTrayIcon.ShiftState: TShiftState;
begin
  if GetKeyState(VK_SHIFT) < 0 then
    Include(Result, ssShift);
  if GetKeyState(VK_CONTROL) < 0 then
    Include(Result, ssCtrl);
  if GetKeyState(VK_MENU) < 0 then
    Include(Result, ssAlt);
end;

procedure TTrayIcon.DoMessage(var Message: TMessage);
var
  APoint: TPoint;
  Shift:  TShiftState;
begin
  case Message.Msg of
    WM_QUERYENDSESSION: Message.Result := 1;
    WM_ENDSESSION:      EndSession;
    WM_SYSTEM_TRAY_NOTIFY:
      begin
        case Message.LParam of
          WM_MOUSEMOVE:
            if Assigned(FOnClick) then
            begin
              Shift := ShiftState();
              GetCursorPos(APoint);
              DoMouseMove(Shift, APoint.X, APoint.Y);
            end;
          WM_LBUTTONDOWN:
            begin
              Shift := ShiftState();
              Include(Shift, ssLeft);
              GetCursorPos(APoint);
              DoMouseDown(mbLeft, Shift, APoint.X, APoint.Y);
              FIsClicked := True;
            end;
          WM_LBUTTONUP:
            begin
              Shift := ShiftState();
              Include(Shift, ssLeft);
              GetCursorPos(APoint);

              if Assigned(FOnClick) then
                DoClick();

              DoMouseUp(mbLeft, Shift, APoint.X, APoint.Y);

              if FAppRestore = imLeftClickUp then
                Restore();
              if FPopupMenuShow = imLeftClickUp then
                ShowMenu();
            end;
          WM_LBUTTONDBLCLK:
            begin
              DoDblClick();

              if FAppRestore = imLeftDoubleClick then
                Restore();
              if FPopupMenuShow = imLeftDoubleClick then
                ShowMenu();
            end;
          WM_RBUTTONDOWN:
            begin
              Shift := ShiftState();
              Include(Shift, ssRight);
              GetCursorPos(APoint);
              DoMouseDown(mbRight, Shift, APoint.X, APoint.Y);
            end;
          WM_RBUTTONUP:
            begin
              Shift := ShiftState();
              Include(Shift, ssRight);
              GetCursorPos(APoint);

              DoMouseUp(mbRight, Shift, APoint.X, APoint.Y);

              if FAppRestore = imRightClickUp then
                Restore();
              if FPopupMenuShow = imRightClickUp then
                ShowMenu();
            end;
          WM_RBUTTONDBLCLK:
            begin
              DoDblClick();

              if FAppRestore = imRightDoubleClick then
                Restore();
              if FPopupMenuShow = imRightDoubleClick then
                ShowMenu();
            end;
          WM_MBUTTONDOWN:
            begin
              Shift := ShiftState();
              Include(Shift, ssMiddle);
              GetCursorPos(APoint);

              DoMouseDown(mbMiddle, Shift, APoint.X, APoint.Y);
            end;
          WM_MBUTTONUP:
            begin
              Shift := ShiftState();
              Include(Shift, ssMiddle);
              GetCursorPos(APoint);

              DoMouseUp(mbMiddle, Shift, APoint.X, APoint.Y);
            end;
          WM_MBUTTONDBLCLK:
            begin
              DoDblClick();
            end;
        end;
      end;
  end;
  inherited Dispatch(Message);
end;

procedure TTrayIcon.ShowMenu;
var
  APoint: TPoint;
begin
  GetCursorPos(APoint);

  if (Screen.ActiveForm <> nil) and (Screen.ActiveForm.Handle <> 0) then
    SetForegroundWindow(Screen.ActiveForm.Handle);

  FPopupMenu.Popup(APoint.X, APoint.Y);
end;

procedure TTrayIcon.DoClick;
begin
  if FAppRestore = imClick then
    Restore();
  if FPopupMenuShow = imClick then
    ShowMenu();

  if Assigned(FOnClick) then
    FOnClick(Self);
end;

procedure TTrayIcon.DoDblClick;
begin
  if FAppRestore = imDoubleClick then
    Restore();
  if FPopupMenuShow = imDoubleClick then
    ShowMenu();

  if Assigned(FOnDblClick) then
    FOnDblClick(Self);
end;

procedure TTrayIcon.DoMouseMove(Shift: TShiftState; X, Y: Integer);
begin
 if Assigned(FOnMouseMove) then
   FOnMouseMove(Self, Shift, X, Y);
end;

procedure TTrayIcon.DoMouseDown(Button: TMouseButton; Shift: TShiftState;
                                X, Y: Integer);
begin
  if FAppRestore = imMouseDown then
    Restore();
  if FPopupMenuShow = imMouseDown then
    ShowMenu();

  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TTrayIcon.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
                                X, Y: Integer);
begin
  if FAppRestore = imMouseUp then
    Restore();
  if FPopupMenuShow = imMouseUp then
    ShowMenu();

  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TTrayIcon.DoOnAnimate(Sender: TObject);
begin
  if IconIndex < FIconList.Count - 1 then
    Inc(FIconIndex)
  else
    FIconIndex := 0;

  SetIconIndex(FIconIndex);
  Update();
end;

//---------------------------------------------------------------------------
// When the application minimizes, hide it, so only the icon in the system
// tray is visible.
//---------------------------------------------------------------------------
procedure TTrayIcon.Minimize;
begin
  Application.Minimize();
  if FHide then
    ShowWindow(Application.Handle, SW_HIDE);

  if Assigned(FOnMinimize) then
    FOnMinimize(Self);
end;

//---------------------------------------------------------------------------
// Restore the application by making its window visible again, which is a
// little weird since its window is invisible, having no height or width, but
// that's what determines whether the button appears on the taskbar.
//---------------------------------------------------------------------------
procedure TTrayIcon.Restore;
begin
  Application.Restore();
  ShowWindow(Application.Handle, SW_RESTORE);
  SetForegroundWindow(Application.Handle);

  if Assigned(FOnRestore) then
    FOnRestore(Self);
end;

procedure TTrayIcon.Update;
begin
  if not (csDesigning in ComponentState) then
  begin
    FData.hIcon := FIcon.Handle;

    if Visible then
      Shell_NotifyIcon(NIM_MODIFY, @FData);
  end;
end;

procedure TTrayIcon.SetIconIndex(Value: Integer);
begin
  FIconIndex := Value;

  if FIconList <> nil then
    FIconList.GetIcon(FIconIndex, FIcon);

  Update();
end;

function TTrayIcon.ApplicationHookProc(var Message: TMessage): Boolean;
begin
  Result := False;

  if Message.Msg = WM_SYSCOMMAND then
  begin
    if Message.WParam = SC_MINIMIZE then
      Minimize()
    else if Message.Msg = SC_RESTORE then
      Restore();
  end;
end;

procedure TTrayIcon.SetDefaultIcon;
begin
  FIcon.Assign(Application.Icon);
  Update();
end;

function TTrayIcon.GetHandle: HWND;
begin
  Result := FData.Wnd;
end;

end.