untagent.pas

实现了：自动锁屏

unit untAgent;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, UntHook,
  Dialogs, Menus, ShellAPI, OleCtrls, SHDocVw, untXml, untHttp, untGlobal, ExtCtrls,
  WinSkinData, StdCtrls, untHttpTread;

const
  WM_NID = WM_USER + 100;

type
  TfrmAgent = class(TForm)
    popSys: TPopupMenu;
    menShowMain: TMenuItem;
    memSetup: TMenuItem;
    N1: TMenuItem;
    memHelp: TMenuItem;
    memAbort: TMenuItem;
    N3: TMenuItem;
    menClose: TMenuItem;
    wbMain: TWebBrowser;
    Timer1: TTimer;
    SkinData1: TSkinData;
    memLock: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure menCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure wbMainBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure menShowMainClick(Sender: TObject);
    procedure memLockClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    procedure HotKeyDown(var Msg: Tmessage); message WM_HOTKEY;
    procedure WMSysCommand(var msg: TMessage); Message wm_syscommand;
    procedure NotifyEdit(Sender: TObject);
  public
    { Public declarations }
    NotifyList: TList;
    NotifyIcon: TNotifyIconData;
    procedure WMNID(var msg:TMessage); Message WM_NID;
    procedure ShowX(AUrl: string; w, h: integer);
  end;

var
  frmAgent: TfrmAgent;
  HotKeyId: Integer;
implementation

uses untShow;

{$R *.dfm}

procedure TfrmAgent.FormCreate(Sender: TObject);
begin
  //注册热键
  HotKeyId := GlobalAddAtom('MyHotKey') - $C000;
  RegisterHotKey(Handle, HotKeyId, 0, VK_F2);

  //加入到系统托盘
  with NotifyIcon do
  begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := Handle;
    uID := 1;
    uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
    uCallBackMessage := WM_NID;
    hIcon := Application.Icon.Handle;
    szTip := 'e家小帮手';
  end;
  Shell_NotifyIcon(NIM_ADD,@NotifyIcon);

  Self.Top := Screen.Height - Self.Height - 30;
  Self.Left := Screen.Width - Self.Width;

  NotifyList := TList.Create;
  NotifyEdit(nil);
end;

procedure TfrmAgent.WMNID(var msg:TMessage);
var
  pt: TPoint;
begin
  GetCursorPos(pt);

  case MSG.LParam of
    WM_LBUTTONDBLCLK:
    begin
      Self.Top := Screen.Height - Self.Height - 30;
      Self.Left := Screen.Width - Self.Width;
      Self.Show;
    end;
    WM_RBUTTONUP:
      popSys.Popup(pt.x, pt.y);
  end;
end;

procedure TfrmAgent.WMSysCommand(var msg: TMessage);
begin
  case msg.WParam of
  SC_MINIMIZE:
  begin
    showwindow(application.handle, sw_hide);
    Self.Visible := False;
  end;
  SC_CLOSE:
  begin
    showwindow(application.handle, sw_hide);
    Self.Visible := False;
    //inherited;
  end
  else
    inherited;
  end;
end;

procedure TfrmAgent.menCloseClick(Sender: TObject);
begin
  UnRegisterHotKey(handle, HotKeyId);
  Shell_NotifyIcon(NIM_DELETE,@NotifyIcon);
  Close;
end;

procedure TfrmAgent.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmAgent.wbMainBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  s, t: string;
  h, w: integer;
begin
  if Pos('action2', URL) > 0 then   //URL中有action2关键字的，表示需要应用程序处理
  begin
    Cancel := True;
    s := GetStr(URL, 'action2=');
    if s = 'e_hospital' then
    begin
      s := StringReplace(Application.ExeName, 'Agent', 'e_school', [rfReplaceAll]);
      ShellExecute(Handle, 'OPEN', PChar(s), nil, nil, SW_SHOW);
      exit;
    end;

    h := StrToInt(GetStr(URL, 'h='));
    w := StrToInt(GetStr(URL, 'w='));
    if s = 's_tips' then
      t := mUser.TipsType
    else
      t := GetStr(URL, 'type=');
  end
  else
    exit;

  ShowX(Format('%s&action=%s&op=show&type=%s', [mUrl.Url, s, t]), w, h);

end;

procedure TfrmAgent.ShowX(AUrl: string; w, h: integer);
begin
  with TfrmShow.Create(Application) do
  begin
    Url := AUrl;
    Width := w;
    Height := h;
    OnClick := NotifyEdit;
    Show;
  end;
end;

procedure TfrmAgent.NotifyEdit(Sender: TObject);
var
  strXml: string;
begin
  strXml := GetXml('getnotify', IntToStr(mUser.Uid), mUser.Password);
  NotifyList.Clear;
  GetNotify(strXml, NotifyList);
end;

procedure TfrmAgent.Timer1Timer(Sender: TObject);
var
  i: integer;
  Notify: PNotify;
  AddDay: integer;
begin
  if NotifyList = nil then exit;
  
  for i := 0 to NotifyList.Count - 1 do
  begin
    Notify := NotifyList.Items[i];
    if (Notify.Notify_Time <= now()) and (Notify.Flag = 0) then
    begin
      //showmessage(Notify.Title);
      if Notify.Action = 'Lock Desktop' then
        ShellExecute(Handle, 'OPEN', PChar('Lock Desktop'), nil, nil, SW_SHOWNORMAL)
      else
        ShowX(Format('%s&action=s_note&op=detail&id=%d', [mUrl.Url, Notify.ID]), 700, 530);

      Notify.Flag := 1;

      //1：日循环；2：周循环；3：月循环；4：一次性的
      Case Notify.Notify_Type of
        1: AddDay := 1;
        2: AddDay := 2;
        3: AddDay := 3;
        4: AddDay := 0;
      end;
      Submit('s_time',  IntToStr(mUser.Uid), mUser.Password, Format('&uid=%d&add=%d&id=%d',
             [mUser.Uid, AddDay, Notify.ID]));
    end;
  end;
end;

procedure TfrmAgent.FormShow(Sender: TObject);
begin
  wbMain.Navigate(Format('%s&action=%s', [mUrl.Url, 's_index']));
end;

procedure TfrmAgent.menShowMainClick(Sender: TObject);
begin
  Self.Top := Screen.Height - Self.Height - 30;
  Self.Left := Screen.Width - Self.Width;
  Self.Show
end;

procedure TfrmAgent.HotKeyDown(var Msg: Tmessage);
begin
  if Msg.LParamHi = VK_F2 then
    memLockClick(nil);
end;

procedure TfrmAgent.memLockClick(Sender: TObject);
var
  wnd: HWnd;
begin
  if mUser.Password <> InputBox('提示', '请输入密码：', '') then exit;

  memLock.Checked := not memLock.Checked;

  if memLock.Checked then
  begin
    HookStar;
    wnd := FindWindow('Shell_TrayWnd',nil); //任务栏Handle
    EnableWindow(wnd, FALSE);
    //ShowWindow(wnd, SW_HIDE);

    wnd := FindWindow('Progman',nil); //桌面Handle
    EnableWindow(wnd, FALSE);
    //ShowWindow(wnd, SW_HIDE);
  end else
  begin
    HookEnd;
    wnd := FindWindow('Shell_TrayWnd',nil);
    EnableWindow(wnd, TRUE);
    //ShowWindow(wnd, SW_Show);

    wnd:=FindWindow('Progman',nil);
    EnableWindow(wnd, TRUE);
    //ShowWindow(wnd, SW_Show);
  end;
end;

procedure TfrmAgent.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if memLock.Checked then
  begin
    CanClose := False;
    MessageBox(0, '请先取消[独占运行]，再取出！', '提示', MB_OK);
  end;
end;

end.