unitmain.pas

作为服务

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,shellapi, CoolTrayIcon, ImgList, Menus, StdCtrls, Spin,IniFiles  ;



const


  LLKHF_ALTDOWN = KF_ALTDOWN shr 8;
  WH_KEYBOARD_LL= 13;

type
  // Declaration from VC++ WINUSER.H
  //
  PKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
  KBDLLHOOKSTRUCT = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: DWORD;
  end;
type
  TFrmRun = class(TForm)
    TrayIcon1: TCoolTrayIcon;
    ImageList4: TImageList;
    PopupMenu1: TPopupMenu;
    ShowWindow1: TMenuItem;
    HideWindow1: TMenuItem;
    N1: TMenuItem;
    BalloonHint1: TMenuItem;
    N2: TMenuItem;
    Exit1: TMenuItem;
    Label1: TLabel;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    EdtClassName: TEdit;
    Label3: TLabel;
    EdtCaption: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label4: TLabel;
    EdtAppName: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure ShowWindow1Click(Sender: TObject);
    procedure HideWindow1Click(Sender: TObject);
    procedure BalloonHint1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure  WndProc(var Message: TMessage);
    procedure DoOnException(Sender: TObject; E: Exception);                       // 系统异常处理
     { Private declarations }
  public
    { Public declarations }
  end;
 
////////////////////////////////////////////////////////////////////////////////
//定时监测设备系统中数据采集程序是否定时运行。
  TMyTimerCheck = class(TThread)
  private
    FOwnHandle : HWND;
  public
    constructor Create(OwnHandle:HWND=0); //只是给该窗体发消息，该窗体处理消息
    destructor  Destroy; override;

    property    OwnHandle: HWND    read FOwnHandle write FOwnHandle;
  protected
    procedure  Execute; override;
  end;
  procedure  StartApp;
var
  FrmRun: TFrmRun;
  gSecond:integer;
  
  FTimeRun  :TMyTimerCheck;
  FrmClass  :string  ; // TFrmMain
  FrmCaption:string ;
  FrmAppName:string ;
const
  AppTitle='系统软件监视程序';
  WM_DOVDDATA   = WM_USER + 800;
  WM_DOWSDATA   = WM_USER + 801;
  WM_MYEXIT     = WM_USER + 1002;
  WM_TIME_EVENT    = WM_USER + 1005;
implementation

uses Common;

{$R *.dfm}
{ TMyTimerCheck }

procedure ReadIniFile;
var  myini: TIniFile;
begin
  gpath :=  ExtractFilePath(application.ExeName);
  myini:= TiniFIle.create(gpath+ 'DMONITOR.ini');
  try
    gSecond      := myini.ReadInteger('SYSTEM', 'Interval', 5);
    FrmCaption   := myini.ReadString('SYSTEM', 'Caption', 'DATAGATHER');
    FrmAppName   := myini.ReadString('SYSTEM', 'FileName', 'DATAGATHER.exe');
    FrmClass     := myini.ReadString('SYSTEM', 'Class', 'TFrmMain');
   //ysInfo.restart     := myini.ReadString('SYSTEM','Restart','false');
   //sInfo.RestartHour  := myini.ReadInteger('SYSTEM','RestartHour',2);
  finally
    myini.Free;
  end;

end;
constructor TMyTimerCheck.Create;
begin
//  FOwnHandle  :=OwnHandle;
  inherited Create(True);
end;

destructor TMyTimerCheck.Destroy;
begin
  inherited;
end;

procedure TMyTimerCheck.Execute;
var
  lpStartupInfo:Tstartupinfo;
  lpProcessInformation:TProcessInformation;
  fh : HWND;
begin
  while not Terminated do
  begin
    sleep(1000*gSecond);
    sendmessage(OwnHandle,WM_TIME_EVENT,0,0);
    StartApp;
  end;
  inherited;
end;

procedure TFrmRun.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_TIME_EVENT then
  begin
  //  Memo1.Lines.Add(DateTimeToStr(now));
    StartApp;
  end;
  inherited;

end;


procedure TFrmRun.FormCreate(Sender: TObject);
begin
  Application.OnException := DoOnException;
  Caption     := AppTitle;

  ReadIniFile;
  TrayIcon1.IconList      := ImageList4;
  TrayIcon1.CycleInterval :=400;
  TrayIcon1.CycleIcons    := True;

  EdtClassName.Text:= FrmClass  ;
  EdtCaption.Text  := FrmCaption ;
  EdtAppName.Text  := FrmAppName ;
  SpinEdit1.Value  :=gSecond;

  FTimeRun  := TMyTimerCheck.Create(self.Handle);
  FTimeRun.OwnHandle :=FrmRun.Handle;
  FTimeRun.Resume;
  FTimeRun.FreeOnTerminate :=true;
end;


procedure  StartApp;
var
  lpStartupInfo:Tstartupinfo;
  lpProcessInformation:TProcessInformation;
  fh : HWND;
begin
  fh := FindWindow(PChar(frmclass),PChar(FrmCaption));
 // fh := FindWindow(PChar(SysInfo.FClass),PChar(SysInfo.FCaption));
  if fh<32 then
  begin
    FillChar(lpStartupInfo,sizeof(lpStartupInfo),#0);
    lpStartupInfo.cb := SizeOf(lpStartupInfo);
    lpStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    lpStartupInfo.wShowWindow := SW_SHOW;
    gPath := ExtractFilePath(application.ExeName);
    if FileExists(gpath+FrmAppName)  then
    begin
      MsgToFile( ': 未监测到程序运行，程序现在将重新运行！');
       CreateProcess(nil, PChar(gpath+FrmAppName), nil, nil, False, NORMAL_PRIORITY_CLASS, nil,
              PChar(gpath), lpStartupInfo, lpProcessInformation);

    end else begin
       MsgToFile( '指定应用程序:【'+gpath+FrmAppName+'】不存在!');
    end;

  end;

end;
///////////////////////////////////////////////////////////////////////////////
procedure TFrmRun.DoOnException(Sender: TObject; E: Exception);
begin
  MsgToFile(DateTimeToStr(now)+' :'+E.Message);
end;


procedure TFrmRun.ShowWindow1Click(Sender: TObject);
begin
  TrayIcon1.ShowMainForm;    // ALWAYS use this method!!!
end;

procedure TFrmRun.HideWindow1Click(Sender: TObject);
begin
  Application.Minimize;      // Will hide dialogs and popup windows as well (this demo has none)
  TrayIcon1.HideMainForm;
end;

procedure TFrmRun.BalloonHint1Click(Sender: TObject);
begin
  TrayIcon1.ShowBalloonHint('数据采集程序状态监视',
        '注意1:定时监测重启程序与应用程序在同一个目录.' + #13 +
        '注意2:应用程序名称举例如,project1.exe',
        bitInfo, 10);
end;

procedure TFrmRun.Exit1Click(Sender: TObject);
var x:string;
begin
  if InputQuery('登陆','请输入管理员密码'+#13,x) then
  begin
    if (x='center') or (x='xgssoft')    then
    begin
      Application.Terminate;
    end else begin
      Application.Minimize;      // Will hide dialogs and popup windows as well (this demo has none)
      TrayIcon1.HideMainForm;
    end;
  end;
 
end;

procedure TFrmRun.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action :=caNone;
   TrayIcon1.HideMainForm;
end;


procedure TFrmRun.Button2Click(Sender: TObject);
begin
  Application.Minimize;      // Will hide dialogs and popup windows as well (this demo has none)
  TrayIcon1.HideMainForm;
end;

procedure TFrmRun.Button1Click(Sender: TObject);
begin
   FrmClass    := trim(EdtClassName.Text);
   FrmCaption  := trim(EdtCaption.Text);
   FrmAppName  := trim(EdtAppName.Text);
   gSecond     :=SpinEdit1.Value;
   myini:= TiniFIle.create(gpath+ 'DMONITOR.ini');
   try
       myini.WriteInteger('SYSTEM', 'Interval',  gSecond);
       myini.WriteString('SYSTEM', 'Caption', FrmCaption);
       myini.WriteString('SYSTEM', 'FileName', FrmAppName);
       myini.WriteString('SYSTEM', 'Class', 'TFrmMain');
//       SysInfo.restart     := myini.ReadString('SYSTEM','Restart','false');
//       SysInfo.RestartHour  := myini.ReadInteger('SYSTEM','RestartHour',2);

  finally
    myini.Free;
  end;

end;

end.