Subversion Repositories delphiutils

Rev

Go to most recent revision | Blame | Last modification | View Log | RSS feed

  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ShellAPI, Menus, Registry, Grids, StdCtrls, ExtCtrls;
  8.  
  9. const
  10.   WM_TASKABAREVENT = WM_USER+1; //Taskbar message
  11.  
  12. type
  13.   TMainForm = class(TForm)
  14.     PopupMenu1: TPopupMenu;
  15.     Anzeigen1: TMenuItem;
  16.     Beenden1: TMenuItem;
  17.     StringGrid1: TStringGrid;
  18.     Panel1: TPanel;
  19.     Panel2: TPanel;
  20.     PopupMenu2: TPopupMenu;
  21.     Edit1: TMenuItem;
  22.     Open1: TMenuItem;
  23.     Button3: TButton;
  24.     N1: TMenuItem;
  25.     Delete1: TMenuItem;
  26.     Button5: TButton;
  27.     New1: TMenuItem;
  28.     N2: TMenuItem;
  29.     Ping1: TMenuItem;
  30.     InitTimer: TTimer;
  31.     LoopTimer: TTimer;
  32.     Checknow1: TMenuItem;
  33.     Button1: TButton;
  34.     procedure FormDestroy(Sender: TObject);
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure Anzeigen1Click(Sender: TObject);
  37.     procedure Beenden1Click(Sender: TObject);
  38.     procedure FormShow(Sender: TObject);
  39.     procedure StringGrid1DblClick(Sender: TObject);
  40.     procedure Open1Click(Sender: TObject);
  41.     procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  42.       Shift: TShiftState; X, Y: Integer);
  43.     procedure Edit1Click(Sender: TObject);
  44.     procedure Delete1Click(Sender: TObject);
  45.     procedure Button5Click(Sender: TObject);
  46.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  47.     procedure New1Click(Sender: TObject);
  48.     procedure InitTimerTimer(Sender: TObject);
  49.     procedure LoopTimerTimer(Sender: TObject);
  50.     procedure Button1Click(Sender: TObject);
  51.   private
  52.     RealClose: boolean;
  53.     WarnAtConnectivityFailure: boolean;
  54.     procedure TaskbarEvent(var Msg: TMessage);
  55.       Message WM_TASKABAREVENT;
  56.     procedure OnQueryEndSession(var Msg: TWMQueryEndSession);
  57.       message WM_QUERYENDSESSION;
  58.     procedure NotifyIconChange(dwMessage: Cardinal);
  59.     procedure LoadConfig;
  60.     procedure ProcessStatMon(MonitorUrl, ServerName: string; Silent: boolean);
  61.     procedure ProcessAll(Silent: boolean);
  62.   public
  63.     procedure Vordergrund;
  64.     procedure LoadList;
  65.   end;
  66.  
  67. var
  68.   MainForm: TMainForm;
  69.  
  70. implementation
  71.  
  72. {$R *.dfm}
  73.  
  74. uses
  75.   Functions,
  76.   ServiceEdit,
  77.   StatusMonFuncs;
  78.  
  79. // Ref: http://www.delphi-fundgrube.de/faq01.htm
  80.  
  81. procedure TMainForm.TaskbarEvent(var Msg: TMessage);
  82. var
  83.   Point: TPoint;
  84. begin
  85.  
  86.   { Die WM_TaskbarEvent-Message "Msg" gibt in Msg.LParam
  87.     das genaue Ereignis an. Msg.LParam kann folgende Werte für
  88.     Mausereignisse annehmen:
  89.  
  90.     WM_MouseMove
  91.     WM_LButtonDown
  92.     WM_LButtonUp
  93.     WM_LButtonDblClk
  94.     WM_RButtonDown
  95.     WM_RButtonUp
  96.     WM_RButtonDblClk }
  97.  
  98.   case Msg.LParam of
  99.     WM_LButtonDblClk:
  100.       begin
  101.         Vordergrund;
  102.       end;
  103.     WM_RButtonUp:
  104.       begin
  105.         // Rechtsklick
  106.         // Diese Zeile ist wichtig, damit das PopupMenu korrekt
  107.         // wieder geschlossen wird:
  108.         SetForegroundWindow(Handle);
  109.         // PopupMenu anzeigen:
  110.         GetCursorPos(Point);
  111.         PopupMenu1.Popup(Point.x, Point.y);
  112.         //oder ohne Variable Point:
  113.         //PopupMenu1.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);
  114.       end;
  115.   end;
  116. end;
  117.  
  118. procedure TMainForm.New1Click(Sender: TObject);
  119. begin
  120.   if EditForm.ShowDialog('') then LoadList;
  121. end;
  122.  
  123. procedure TMainForm.NotifyIconChange(dwMessage: Cardinal);
  124. var
  125.   NotifyIconData: TNotifyIconData;
  126. begin
  127.   Fillchar(NotifyIconData,Sizeof(NotifyIconData), 0);
  128.   NotifyIconData.cbSize := Sizeof(NotifyIconData);
  129.   NotifyIconData.Wnd    := Handle;
  130.   NotifyIconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  131.   NotifyIconData.uCallbackMessage := WM_TASKABAREVENT;
  132.   NotifyIconData.hIcon := Application.Icon.Handle;
  133.   NotifyIconData.szTip := 'ViaThinkSoft Status Monitor 3.0';
  134.   Shell_NotifyIcon(dwMessage, @NotifyIconData);
  135. end;
  136.  
  137. procedure TMainForm.FormDestroy(Sender: TObject);
  138. begin
  139.   NotifyIconChange(NIM_DELETE);
  140. end;
  141.  
  142. procedure TMainForm.FormCreate(Sender: TObject);
  143. begin
  144.   NotifyIconChange(NIM_ADD);
  145.  
  146.   StringGrid1.Rows[0].Add('Name');
  147.   StringGrid1.Rows[0].Add('URL');
  148.   StringGrid1.Rows[0].Add('Status');
  149.  
  150.   LoadConfig;
  151. end;
  152.  
  153. procedure TMainForm.Vordergrund;
  154. begin
  155.   Show;
  156.   ShowWindow(Handle, SW_RESTORE);
  157.   ForceForegroundWindow(Handle);
  158. end;
  159.  
  160. procedure TMainForm.Anzeigen1Click(Sender: TObject);
  161. begin
  162.   Vordergrund;
  163. end;
  164.  
  165. procedure TMainForm.Beenden1Click(Sender: TObject);
  166. begin
  167.   RealClose := true;
  168.   Close;
  169. end;
  170.  
  171. procedure TMainForm.LoadConfig;
  172. var
  173.   reg: TRegistry;
  174. begin
  175.   reg := TRegistry.Create;
  176.   try
  177.     reg.RootKey := HKEY_CURRENT_USER;
  178.     if reg.OpenKeyReadOnly('\Software\ViaThinkSoft\StatusMon\3.0\Settings\') then
  179.     begin
  180.       InitTimer.Interval := reg.ReadInteger('InitTimerInterval');
  181.       LoopTimer.Interval := reg.ReadInteger('LoopTimerInterval');
  182.       WarnAtConnectivityFailure := reg.ReadBool('WarnAtConnectivityFailure');
  183.       reg.CloseKey;
  184.     end;
  185.   finally
  186.     reg.Free;
  187.   end;
  188. end;
  189.  
  190. procedure TMainForm.LoadList;
  191. var
  192.   reg: TRegistry;
  193.   st: TStringList;
  194.   i: Integer;
  195. begin
  196.   reg := TRegistry.Create;
  197.   st := TStringList.Create;
  198.   try
  199.     reg.RootKey := HKEY_CURRENT_USER;
  200.     if reg.OpenKeyReadOnly('\Software\ViaThinkSoft\StatusMon\3.0\Services\') then
  201.     begin
  202.       reg.GetKeyNames(st);
  203.       StringGrid1.RowCount := st.Count + 1;
  204.       for i := 0 to st.Count - 1 do
  205.       begin
  206.         if reg.OpenKeyReadOnly('\Software\ViaThinkSoft\StatusMon\3.0\Services\'+st.Strings[i]+'\') then
  207.         begin
  208.           StringGrid1.Rows[i+1].Clear;
  209.           StringGrid1.Rows[i+1].Add(st.Strings[i]);
  210.           StringGrid1.Rows[i+1].Add(reg.ReadString('URL'));
  211.           StringGrid1.Rows[i+1].Add('Unknown');
  212.         end;
  213.       end;
  214.       reg.CloseKey;
  215.     end;
  216.   finally
  217.     st.Free;
  218.     reg.Free;
  219.   end;
  220. end;
  221.  
  222. procedure TMainForm.LoopTimerTimer(Sender: TObject);
  223. begin
  224.   ProcessAll(true);
  225. end;
  226.  
  227. procedure TMainForm.FormShow(Sender: TObject);
  228. begin
  229.   LoadList;
  230. end;
  231.  
  232. procedure TMainForm.InitTimerTimer(Sender: TObject);
  233. begin
  234.   InitTimer.Enabled := false;
  235.   LoopTimer.Enabled := true;
  236. end;
  237.  
  238. procedure TMainForm.StringGrid1DblClick(Sender: TObject);
  239. begin
  240.   Open1.Click;
  241. end;
  242.  
  243. procedure TMainForm.Open1Click(Sender: TObject);
  244. begin
  245.   ShellExecute(Handle, 'open', PChar(StringGrid1.Rows[StringGrid1.Row].Strings[1]), '', '', SW_SHOW)
  246. end;
  247.  
  248. procedure TMainForm.ProcessAll(Silent: boolean);
  249. var
  250.   i: integer;
  251. begin
  252.   for i := 1 to StringGrid1.RowCount - 1 do
  253.   begin
  254.     ProcessStatMon(StringGrid1.Rows[i].Strings[1], StringGrid1.Rows[i].Strings[0], Silent);
  255.   end;
  256. end;
  257.  
  258. procedure TMainForm.ProcessStatMon(MonitorUrl, ServerName: string;
  259.   Silent: boolean);
  260. resourcestring
  261.   LNG_CAPTION = 'Status Monitor Alert';
  262.   LNG_CAPTION_OK = 'Status Monitor Check';
  263.   LNG_STATUS_WARNING = 'Der Status-Monitor "%s" meldet ein Problem! Status-Monitor jetzt öffnen?' + #13#10#13#10 + 'Monitor-URL: %s';
  264.   LNG_STATUS_OK = 'Es existieren keine Probleme mit Status-Monitor "%s"' + #13#10#13#10 + 'Monitor-URL: %s';
  265.   LNG_MONITOR_FAILURE = 'Die Ausgabe des Status-Monitors "%s" kann nicht interpretiert werden! Status-Monitor jetzt öffnen?' + #13#10#13#10 + 'Monitor-URL: %s';
  266.   LNG_CONNECTIVITY_FAILURE = 'Der Status von "%s" konnte nicht überprüft werden, da keine Internetverbindung besteht! Ping-Fenster öffnen?' + #13#10#13#10 + 'Monitor-URL: %s';
  267.   LNG_SERVER_DOWN = 'Es konnte keine Verbindung zum Status-Monitor "%s" hergestellt werden, OBWOHL eine Internetverbindung besteht! Ping-Fenster öffnen?' + #13#10#13#10 + 'Monitor-URL: %s';
  268. var
  269.   x: TMonitorState;
  270. begin
  271.   x := DeterminateMonitorState(MonitorUrl);
  272.  
  273.   if x = msOK then
  274.   begin
  275.     MessageBox(Handle, PChar(Format(LNG_STATUS_OK, [ServerName, MonitorUrl])), PChar(LNG_CAPTION_OK), MB_ICONINFORMATION or MB_OK);
  276.   end
  277.   else if x = msStatusWarning then
  278.   begin
  279.     if MessageBox(Handle, PChar(Format(LNG_STATUS_WARNING, [ServerName, MonitorUrl])), PChar(LNG_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  280.     begin
  281.       ShellExecute(Handle, 'open', PChar(MonitorUrl), '', '', SW_NORMAL);
  282.     end;
  283.   end
  284.   else if x = msMonitorFailure then
  285.   begin
  286.     if MessageBox(Handle, PChar(Format(LNG_MONITOR_FAILURE, [ServerName, MonitorUrl])), PChar(LNG_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  287.     begin
  288.       ShellExecute(Handle, 'open', PChar(MonitorUrl), '', '', SW_NORMAL);
  289.     end;
  290.   end
  291.   else if x = msServerDown then
  292.   begin
  293.     // Es besteht eine Internetverbindung, daher ist wohl was mit dem
  294.     // Server nicht in Ordnung
  295.  
  296.     if MessageBox(Handle, PChar(Format(LNG_SERVER_DOWN, [ServerName, MonitorUrl])), PChar(LNG_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  297.     begin
  298.       ShellExecute(Handle, 'open', 'ping', PChar(GetDomainNameByURL(MonitorURL)+' -t'), '', SW_NORMAL);
  299.     end;
  300.   end
  301.   else if x = msInternetBroken then
  302.   begin
  303.     if not WarnAtConnectivityFailure then
  304.     begin
  305.       if MessageBox(Handle, PChar(Format(LNG_CONNECTIVITY_FAILURE, [ServerName, MonitorUrl])), PChar(LNG_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  306.       begin
  307.         ShellExecute(Handle, 'open', 'ping', PChar(GetDomainNameByURL(MonitorURL)+' -t'), '', SW_NORMAL);
  308.       end;
  309.     end;
  310.   end;
  311. end;
  312.  
  313. procedure TMainForm.StringGrid1MouseDown(Sender: TObject;
  314.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  315. var
  316.   col, row: integer;
  317. begin
  318.   if Button = mbRight then
  319.   begin
  320.     stringgrid1.MouseToCell(X, Y, col, row);
  321.     if row >= stringgrid1.FixedRows then
  322.       stringgrid1.Row := row;
  323.  
  324.     if col >= stringgrid1.FixedCols then
  325.       stringgrid1.Col := col;
  326.  
  327.     if (row >= stringgrid1.FixedRows) and
  328.        (col >= stringgrid1.FixedCols) then
  329.     begin
  330.       StringGrid1.PopupMenu := PopupMenu2;
  331.     end
  332.     else
  333.     begin
  334.       StringGrid1.PopupMenu := nil;
  335.     end;
  336.   end;
  337. end;
  338.  
  339. procedure TMainForm.Edit1Click(Sender: TObject);
  340. begin
  341.   if EditForm.ShowDialog(StringGrid1.Rows[StringGrid1.Row].Strings[0]) then LoadList;
  342. end;
  343.  
  344. procedure TMainForm.Delete1Click(Sender: TObject);
  345. resourcestring
  346.   LNG_DELETE = 'Statusmonitor "%s" wirklich löschen?';
  347.   LNG_CAPTION = 'Lösch-Bestätigung';
  348. var
  349.   reg: TRegistry;
  350.   Val: String;
  351. begin
  352.   Val := StringGrid1.Cells[0, StringGrid1.Row];
  353.  
  354.   if MessageBox(Handle, PChar(Format(LNG_DELETE, [Val])), PChar(LNG_CAPTION), MB_ICONQUESTION or MB_YESNOCANCEL) = IDYES then
  355.   begin
  356.     reg := TRegistry.Create;
  357.     try
  358.       reg.RootKey := HKEY_CURRENT_USER;
  359.       if reg.DeleteKey('\Software\ViaThinkSoft\StatusMon\3.0\Services\'+Val+'\') then LoadList;
  360.     finally
  361.       reg.Free;
  362.     end;
  363.   end;
  364. end;
  365.  
  366. procedure TMainForm.Button1Click(Sender: TObject);
  367. begin
  368.   ProcessAll(false);
  369. end;
  370.  
  371. procedure TMainForm.Button5Click(Sender: TObject);
  372. begin
  373.   Close;
  374. end;
  375.  
  376. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  377. begin
  378.   Hide;
  379.   CanClose := RealClose;
  380. end;
  381.  
  382. procedure TMainForm.OnQueryEndSession;
  383. begin
  384.   RealClose := true;
  385.   Close;
  386.   Msg.Result := 1;
  387. end;
  388.  
  389. end.
  390.