Subversion Repositories delphiutils

Rev

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

  1. unit Main;
  2.  
  3. (*
  4.  
  5. # download einer primer-tabelle?
  6.  
  7. bug: wenn man einen eintrag ändert oder hinzufügt, werden alle "status" auf unknown zurückgesetzt
  8. td: aktualisierenbutton/f5 erlauben
  9. del-button...
  10. icon: gray(internetdown),red,green
  11. reg-write fehler erkennen
  12.  
  13. statustext einführen (format 2.0)
  14.  
  15. rote listeneinträge bei fehlern
  16.  
  17. f5 möglichkeit geben?
  18.  
  19. nur 1 instanz zulassen
  20.  
  21. spaltenindizes 0,1,2 in constanten packen
  22.  
  23. Future
  24. ------
  25.  
  26. - Rote Einträge bei Fehlern? (VCL Problem)
  27. - XP Bubble verwenden?
  28. - Toolbar / ApplicationEvents
  29.  
  30. *)
  31.  
  32. interface
  33.  
  34. uses
  35.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  36.   Dialogs, ShellAPI, Menus, Registry, Grids, StdCtrls, ExtCtrls, ImgList;
  37.  
  38. const
  39.   WM_TASKABAREVENT = WM_USER+1; //Taskbar message
  40.  
  41. type
  42.   TMainForm = class(TForm)
  43.     TrayPopupMenu: TPopupMenu;
  44.     Anzeigen1: TMenuItem;
  45.     Beenden1: TMenuItem;
  46.     MonitorGrid: TStringGrid;
  47.     MenuPopupMenu: TPopupMenu;
  48.     Edit1: TMenuItem;
  49.     Open1: TMenuItem;
  50.     N1: TMenuItem;
  51.     Delete1: TMenuItem;
  52.     Ping1: TMenuItem;
  53.     InitTimer: TTimer;
  54.     LoopTimer: TTimer;
  55.     Checknow1: TMenuItem;
  56.     MainMenu: TMainMenu;
  57.     MEntry: TMenuItem;
  58.     MHelp: TMenuItem;
  59.     MAbout: TMenuItem;
  60.     MFile: TMenuItem;
  61.     MClose: TMenuItem;
  62.     MCloseAndExit: TMenuItem;
  63.     MNewEntry: TMenuItem;
  64.     N4: TMenuItem;
  65.     MCheckAll: TMenuItem;
  66.     MConfig: TMenuItem;
  67.     MConnWarnOpt: TMenuItem;
  68.     MInitTimeOpt: TMenuItem;
  69.     MitWindowsstarten1: TMenuItem;
  70.     N2: TMenuItem;
  71.     MLoopTimeOpt: TMenuItem;
  72.     MSpecs: TMenuItem;
  73.     Open2: TMenuItem;
  74.     Ping2: TMenuItem;
  75.     Checknow2: TMenuItem;
  76.     N3: TMenuItem;
  77.     Edit2: TMenuItem;
  78.     Delete2: TMenuItem;
  79.     LastCheckPanel: TPanel;
  80.     MUpdate: TMenuItem;
  81.     UpdateTimer: TTimer;
  82.     N5: TMenuItem;
  83.     N6: TMenuItem;
  84.     ImageList1: TImageList;
  85.     procedure FormDestroy(Sender: TObject);
  86.     procedure FormCreate(Sender: TObject);
  87.     procedure Anzeigen1Click(Sender: TObject);
  88.     procedure Beenden1Click(Sender: TObject);
  89.     procedure FormShow(Sender: TObject);
  90.     procedure MonitorGridDblClick(Sender: TObject);
  91.     procedure Open1Click(Sender: TObject);
  92.     procedure MonitorGridMouseDown(Sender: TObject; Button: TMouseButton;
  93.       Shift: TShiftState; X, Y: Integer);
  94.     procedure Edit1Click(Sender: TObject);
  95.     procedure Delete1Click(Sender: TObject);
  96.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  97.     procedure InitTimerTimer(Sender: TObject);
  98.     procedure LoopTimerTimer(Sender: TObject);
  99.     procedure Checknow1Click(Sender: TObject);
  100.     procedure Ping1Click(Sender: TObject);
  101.     procedure MCheckAllClick(Sender: TObject);
  102.     procedure MAboutClick(Sender: TObject);
  103.     procedure MLoopTimeOptClick(Sender: TObject);
  104.     procedure MNewEntryClick(Sender: TObject);
  105.     procedure MConnWarnOptClick(Sender: TObject);
  106.     procedure MInitTimeOptClick(Sender: TObject);
  107.     procedure MCloseClick(Sender: TObject);
  108.     procedure MCloseAndExitClick(Sender: TObject);
  109.     procedure MitWindowsstarten1Click(Sender: TObject);
  110.     procedure MSpecsClick(Sender: TObject);
  111.     procedure Open2Click(Sender: TObject);
  112.     procedure Ping2Click(Sender: TObject);
  113.     procedure Checknow2Click(Sender: TObject);
  114.     procedure Edit2Click(Sender: TObject);
  115.     procedure Delete2Click(Sender: TObject);
  116.     procedure MUpdateClick(Sender: TObject);
  117.     procedure UpdateTimerTimer(Sender: TObject);
  118.   private
  119.     RealClose: boolean;
  120.     WarnAtConnectivityFailure: boolean;
  121.     StatCache: TStringList;
  122.     procedure TaskbarEvent(var Msg: TMessage);
  123.       Message WM_TASKABAREVENT;
  124.     procedure OnQueryEndSession(var Msg: TWMQueryEndSession);
  125.       message WM_QUERYENDSESSION;
  126.     procedure OnWmQuit(var Msg: TWMQuit);
  127.       message WM_QUIT;
  128.     procedure NotifyIconChange(dwMessage: Cardinal);
  129.     procedure LoadConfig;
  130.     procedure ProcessStatMon(i: integer; ShowSuccess: boolean);
  131.     procedure ProcessAll(ShowSuccess: boolean);
  132.     function GetCurrentMonitorName: string;
  133.     function GetCurrentMonitorURL: string;
  134.     procedure Vordergrund;
  135.     procedure LoadList;
  136.     function Status: boolean;
  137.     // procedure RightAlignHelpMenuItem;
  138.   end;
  139.  
  140. var
  141.   MainForm: TMainForm;
  142.  
  143. implementation
  144.  
  145. {$R StatusMonManifest.res}
  146.  
  147. {$R *.dfm}
  148.  
  149. uses
  150.   Functions, ServiceEdit, StatusMonFuncs, About, Common;
  151.  
  152. type
  153.   TExtended = packed record
  154.     Val: Extended;
  155.     Err: boolean;
  156.   end;
  157.  
  158. function StrToExtended(str: String): TExtended;
  159. begin
  160.   result.Err := false;
  161.   result.Val := 0;
  162.   try
  163.     result.Val := StrToFloat(str);
  164.   except
  165.     result.Err := true;
  166.   end;
  167. end;
  168.  
  169. // Ref: http://www.delphi-fundgrube.de/faq01.htm
  170.  
  171. procedure TMainForm.TaskbarEvent(var Msg: TMessage);
  172. var
  173.   Point: TPoint;
  174. begin
  175.   { Die WM_TaskbarEvent-Message "Msg" gibt in Msg.LParam
  176.     das genaue Ereignis an. Msg.LParam kann folgende Werte für
  177.     Mausereignisse annehmen:
  178.  
  179.     WM_MouseMove
  180.     WM_LButtonDown
  181.     WM_LButtonUp
  182.     WM_LButtonDblClk
  183.     WM_RButtonDown
  184.     WM_RButtonUp
  185.     WM_RButtonDblClk }
  186.  
  187.   case Msg.LParam of
  188.     WM_LButtonDblClk:
  189.       begin
  190.         Vordergrund;
  191.       end;
  192.     WM_RButtonUp:
  193.       begin
  194.         // Rechtsklick
  195.         // Diese Zeile ist wichtig, damit das PopupMenu korrekt
  196.         // wieder geschlossen wird:
  197.         SetForegroundWindow(Handle);
  198.         GetCursorPos(Point);
  199.         TrayPopupMenu.Popup(Point.x, Point.y);
  200.       end;
  201.   end;
  202. end;
  203.  
  204. procedure TMainForm.UpdateTimerTimer(Sender: TObject);
  205. begin
  206.   UpdateTimer.Interval := 6*60*60*1000; // Alle 6 Stunden gucken wir mal
  207.   VTSUpdateCheck('statusmon', '3.0', false, false);
  208. end;
  209.  
  210. procedure TMainForm.MUpdateClick(Sender: TObject);
  211. begin
  212.   VTSUpdateCheck('statusmon', '3.0', true, true);
  213. end;
  214.  
  215. procedure TMainForm.MNewEntryClick(Sender: TObject);
  216. begin
  217.   if EditForm.ShowDialog('') then LoadList;
  218. end;
  219.  
  220. procedure TMainForm.MSpecsClick(Sender: TObject);
  221. begin
  222.   // ToDo
  223. end;
  224.  
  225. procedure TMainForm.NotifyIconChange(dwMessage: Cardinal);
  226. var
  227.   NotifyIconData: TNotifyIconData;
  228.   ico: TIcon;
  229. begin
  230.   Fillchar(NotifyIconData,Sizeof(NotifyIconData), 0);
  231.   NotifyIconData.cbSize := Sizeof(NotifyIconData);
  232.   NotifyIconData.Wnd    := Handle;
  233.   NotifyIconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  234.   NotifyIconData.uCallbackMessage := WM_TASKABAREVENT;
  235.  
  236.   ico := TIcon.Create;
  237.   if Status then
  238.     ImageList1.GetIcon(0, ico)
  239.   else
  240.     ImageList1.GetIcon(1, ico);
  241.   NotifyIconData.hIcon := ico.Handle;
  242.  
  243.   NotifyIconData.szTip := 'ViaThinkSoft Status Monitor 3.0';
  244.   Shell_NotifyIcon(dwMessage, @NotifyIconData);
  245. end;
  246.  
  247. procedure TMainForm.FormDestroy(Sender: TObject);
  248. begin
  249.   StatCache.Free;
  250.   NotifyIconChange(NIM_DELETE);
  251. end;
  252.  
  253. procedure TMainForm.FormCreate(Sender: TObject);
  254. begin
  255.   LastCheckPanel.Caption := Format(LNG_LAST_CHECK, [LNG_LAST_CHECK_UNKNOWN]);
  256.  
  257.   // RightAlignHelpMenuItem;
  258.  
  259.   StatCache := TStringList.Create;
  260.  
  261.   // Kommt sicherlich nicht in irgendeiner URL vor!
  262.   // #0 funktioniert nicht
  263.   StatCache.NameValueSeparator := #1;
  264.  
  265.   NotifyIconChange(NIM_ADD);
  266.  
  267.   MonitorGrid.Rows[0].Add(LNG_COLUMN_NAME);
  268.   MonitorGrid.Rows[0].Add(LNG_COLUMN_URL);
  269.   MonitorGrid.Rows[0].Add(LNG_COLUMN_STATUS);
  270.  
  271.   // Default-Werte
  272.   WarnAtConnectivityFailure := false;
  273.   LoopTimer.Interval   := 1*60*60*1000;
  274.   InitTimer.Interval   :=    5*60*1000;
  275.   UpdateTimer.Interval :=    5*60*1000;
  276.  
  277.   LoadConfig;
  278. end;
  279.  
  280. procedure TMainForm.Vordergrund;
  281. begin
  282.   Show;
  283.   ShowWindow(Handle, SW_RESTORE);
  284.   ForceForegroundWindow(Handle);
  285. end;
  286.  
  287. procedure TMainForm.MLoopTimeOptClick(Sender: TObject);
  288. var
  289.   reg: TRegistry;
  290.   x: string;
  291.   e: TExtended;
  292. begin
  293.   reg := TRegistry.Create;
  294.   try
  295.     reg.RootKey := HKEY_CURRENT_USER;
  296.     if reg.OpenKey(REG_KEY_SETTINGS, true) then
  297.     begin
  298.       x := InputBox(LNG_LOOP_TIME, LNG_INPUT_MINUTE_INTERVAL, IntToStr(round(LoopTimer.Interval/60/1000)));
  299.       e := StrToExtended(x);
  300.       if not e.Err and (e.Val > 0) then
  301.       begin
  302.         LoopTimer.Interval := Round(e.Val*60*1000);
  303.         reg.WriteInteger(REG_VAL_LOOP_TIMER_INTERVAL, LoopTimer.Interval);
  304.         MLoopTimeOpt.Caption := Format(LNG_LOOP_TIME_OPTION, [round(e.Val)]);
  305.       end
  306.       else
  307.       begin
  308.         MessageBox(Handle, PChar(LNG_ERROR), PChar(LNG_NO_POSITIVE_NUMBER_WITHOUT_ZERO), MB_ICONERROR or MB_OK);
  309.       end;
  310.     end;
  311.   finally
  312.     reg.Free;
  313.   end;
  314. end;
  315.  
  316. procedure TMainForm.MCheckAllClick(Sender: TObject);
  317. begin
  318.   ProcessAll(false);
  319.   MessageBox(Handle, PChar(LNG_CHECKALL_FINISHED_TEXT), PChar(LNG_CHECKALL_FINISHED_CAPTION), MB_ICONINFORMATION or MB_OK);
  320. end;
  321.  
  322. procedure TMainForm.Anzeigen1Click(Sender: TObject);
  323. begin
  324.   Vordergrund;
  325. end;
  326.  
  327. procedure TMainForm.Beenden1Click(Sender: TObject);
  328. begin
  329.   MCloseAndExit.Click;
  330. end;
  331.  
  332. procedure TMainForm.MAboutClick(Sender: TObject);
  333. begin
  334.   AboutForm.PopupParent := Screen.ActiveForm; // Workaround
  335.   AboutForm.ShowModal;
  336. end;
  337.  
  338. procedure TMainForm.LoadConfig;
  339. var
  340.   reg: TRegistry;
  341. begin
  342.   reg := TRegistry.Create;
  343.   try
  344.     reg.RootKey := HKEY_CURRENT_USER;
  345.     if reg.OpenKeyReadOnly(REG_KEY_SETTINGS) then
  346.     begin
  347.       if reg.ValueExists(REG_VAL_INIT_TIMER_INTERVAL) then
  348.         InitTimer.Interval := reg.ReadInteger(REG_VAL_INIT_TIMER_INTERVAL);
  349.  
  350.       if reg.ValueExists(REG_VAL_LOOP_TIMER_INTERVAL) then
  351.         LoopTimer.Interval := reg.ReadInteger(REG_VAL_LOOP_TIMER_INTERVAL);
  352.  
  353.       if reg.ValueExists(REG_VAL_WARN_AT_CONNFAILURE) then
  354.         WarnAtConnectivityFailure := reg.ReadBool(REG_VAL_WARN_AT_CONNFAILURE);
  355.  
  356.       reg.CloseKey;
  357.     end;
  358.   finally
  359.     reg.Free;
  360.   end;
  361.  
  362.   MInitTimeOpt.Caption := Format(LNG_INIT_TIME_OPTION, [round(InitTimer.Interval/1000/60)]);
  363.   MLoopTimeOpt.Caption := Format(LNG_LOOP_TIME_OPTION, [round(LoopTimer.Interval/1000/60)]);
  364.   MConnWarnOpt.Checked := WarnAtConnectivityFailure;
  365. end;
  366.  
  367. procedure TMainForm.LoadList;
  368. var
  369.   reg: TRegistry;
  370.   st: TStringList;
  371.   i: Integer;
  372.   MonitorUrl, CachedStat: String;
  373. begin
  374.   reg := TRegistry.Create;
  375.   st := TStringList.Create;
  376.   try
  377.     reg.RootKey := HKEY_CURRENT_USER;
  378.     if reg.OpenKeyReadOnly(REG_KEY_SERVICES) then
  379.     begin
  380.       reg.GetKeyNames(st);
  381.       MonitorGrid.RowCount := st.Count + 1;
  382.       for i := 0 to st.Count - 1 do
  383.       begin
  384.         if reg.OpenKeyReadOnly(Format(REG_KEY_SERVICE, [st.Strings[i]])) then
  385.         begin
  386.           MonitorGrid.Rows[i+1].Clear;
  387.           MonitorGrid.Rows[i+1].Add(st.Strings[i]);
  388.           MonitorUrl := reg.ReadString(REG_VAL_URL);
  389.           MonitorGrid.Rows[i+1].Add(MonitorUrl);
  390.           CachedStat := StatCache.Values[MonitorUrl];
  391.           If CachedStat = '' then CachedStat := LNG_STAT_UNKNOWN;
  392.           MonitorGrid.Rows[i+1].Add(CachedStat);
  393.         end;
  394.       end;
  395.       reg.CloseKey;
  396.     end;
  397.   finally
  398.     st.Free;
  399.     reg.Free;
  400.   end;
  401. end;
  402.  
  403. procedure TMainForm.LoopTimerTimer(Sender: TObject);
  404. begin
  405.   ProcessAll(false);
  406. end;
  407.  
  408. procedure TMainForm.MitWindowsstarten1Click(Sender: TObject);
  409. begin
  410.   ShowMessage('ToDo'); // ToDo
  411. end;
  412.  
  413. procedure TMainForm.FormShow(Sender: TObject);
  414. begin
  415.   LoadList;
  416. end;
  417.  
  418. procedure TMainForm.MInitTimeOptClick(Sender: TObject);
  419. var
  420.   reg: TRegistry;
  421.   x: string;
  422.   e: TExtended;
  423. begin
  424.   reg := TRegistry.Create;
  425.   try
  426.     reg.RootKey := HKEY_CURRENT_USER;
  427.     if reg.OpenKey(REG_KEY_SETTINGS, true) then
  428.     begin
  429.       x := InputBox(LNG_INIT_TIME, LNG_INPUT_MINUTE_INTERVAL, IntToStr(round(InitTimer.Interval/60/1000)));
  430.       e := StrToExtended(x);
  431.       if not e.Err and (e.Val > 0) then
  432.       begin
  433.         InitTimer.Interval := Round(e.Val*60*1000);
  434.         reg.WriteInteger(REG_VAL_INIT_TIMER_INTERVAL, InitTimer.Interval);
  435.         MInitTimeOpt.Caption := Format(LNG_INIT_TIME_OPTION, [round(e.Val)]);
  436.       end
  437.       else
  438.       begin
  439.         MessageBox(Handle, PChar(LNG_ERROR), PChar(LNG_NO_POSITIVE_NUMBER_WITHOUT_ZERO), MB_ICONERROR or MB_OK);
  440.       end;
  441.     end;
  442.   finally
  443.     reg.Free;
  444.   end;
  445. end;
  446.  
  447. procedure TMainForm.InitTimerTimer(Sender: TObject);
  448. begin
  449.   InitTimer.Enabled := false;
  450.   LoopTimer.Enabled := true;
  451. end;
  452.  
  453. procedure TMainForm.MCloseClick(Sender: TObject);
  454. begin
  455.   Close;
  456. end;
  457.  
  458. procedure TMainForm.MCloseAndExitClick(Sender: TObject);
  459. begin
  460.   if MessageBox(Handle, PChar(LNG_EXIT_TEXT), PChar(LNG_EXIT_CAPTION), MB_ICONQUESTION or MB_YESNOCANCEL) = IDYES then
  461.   begin
  462.     RealClose := true;
  463.     Close;
  464.   end;
  465. end;
  466.  
  467. procedure TMainForm.MonitorGridDblClick(Sender: TObject);
  468. begin
  469.   Open1.Click;
  470. end;
  471.  
  472. function TMainForm.GetCurrentMonitorName: string;
  473. begin
  474.   // result := MonitorGrid.Rows[MonitorGrid.Row].Strings[0];
  475.   result := MonitorGrid.Cells[0, MonitorGrid.Row];
  476. end;
  477.  
  478. function TMainForm.GetCurrentMonitorURL: string;
  479. begin
  480.   // result := MonitorGrid.Rows[MonitorGrid.Row].Strings[1];
  481.   result := MonitorGrid.Cells[1, MonitorGrid.Row];
  482. end;
  483.  
  484. procedure TMainForm.Open1Click(Sender: TObject);
  485. begin
  486.   Open2.Click;
  487. end;
  488.  
  489. procedure TMainForm.Open2Click(Sender: TObject);
  490. begin
  491.   ShellExecute(Handle, 'open', PChar(GetCurrentMonitorURL), '', '', SW_SHOW)
  492. end;
  493.  
  494. procedure TMainForm.Ping1Click(Sender: TObject);
  495. begin
  496.   Ping2.Click;
  497. end;
  498.  
  499. procedure TMainForm.Ping2Click(Sender: TObject);
  500. begin
  501.   ShellExecute(Handle, 'open', 'ping', PChar(GetDomainNameByURL(GetCurrentMonitorURL)+' -t'), '', SW_NORMAL);
  502. end;
  503.  
  504. procedure TMainForm.ProcessAll(ShowSuccess: boolean);
  505. var
  506.   i: integer;
  507. begin
  508.   for i := 1 to MonitorGrid.RowCount - 1 do
  509.   begin
  510.     MonitorGrid.Cells[2, i] := LNG_STAT_QUEUE;
  511.   end;
  512.   for i := 1 to MonitorGrid.RowCount - 1 do
  513.   begin
  514.     ProcessStatMon(i, ShowSuccess);
  515.   end;
  516.   LastCheckPanel.Caption := Format(LNG_LAST_CHECK, [DateTimeToStr(Now)]);
  517. end;
  518.  
  519. procedure TMainForm.ProcessStatMon(i: integer; ShowSuccess: boolean);
  520. var
  521.   x: TMonitorState;
  522.   MonitorUrl, ServerName: string;
  523. begin
  524.   ServerName := MonitorGrid.Rows[i].Strings[0];
  525.   MonitorUrl := MonitorGrid.Rows[i].Strings[1];
  526.  
  527.   if MonitorUrl = '' then Exit; // Passiert, wenn Create() aufgehalten wird (z.B. mit ShowMessage)  
  528.  
  529.   MonitorGrid.Rows[i].Strings[2] := LNG_STAT_CHECKING;
  530.   Application.ProcessMessages;
  531.  
  532.   x := DeterminateMonitorState(MonitorUrl);
  533.  
  534.   if x = msOK then
  535.   begin
  536.     MonitorGrid.Rows[i].Strings[2] := LNG_STAT_OK;
  537.     StatCache.Values[MonitorUrl] := LNG_STAT_OK;
  538.     NotifyIconChange(NIM_MODIFY);
  539.     if ShowSuccess then
  540.     begin
  541.       MessageBox(Handle, PChar(Format(LNG_ALERT_STATUS_OK, [ServerName, MonitorUrl])), PChar(LNG_CHECKALL_FINISHED_CAPTION), MB_ICONINFORMATION or MB_OK);
  542.     end;
  543.   end
  544.   else if x = msStatusWarning then
  545.   begin
  546.     MonitorGrid.Rows[i].Strings[2] := LNG_STAT_WARNING;
  547.     StatCache.Values[MonitorUrl] := LNG_STAT_WARNING;
  548.     NotifyIconChange(NIM_MODIFY);
  549.     if MessageBox(Handle, PChar(Format(LNG_ALERT_STATUS_WARNING, [ServerName, MonitorUrl])), PChar(LNG_ALERT_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  550.     begin
  551.       ShellExecute(Handle, 'open', PChar(MonitorUrl), '', '', SW_NORMAL);
  552.     end;
  553.   end
  554.   else if x = msMonitorParseError then
  555.   begin
  556.     MonitorGrid.Rows[i].Strings[2] := LNG_STAT_PARSEERROR;
  557.     StatCache.Values[MonitorUrl] := LNG_STAT_PARSEERROR;
  558.     NotifyIconChange(NIM_MODIFY);
  559.     if MessageBox(Handle, PChar(Format(LNG_ALERT_MONITOR_FAILURE, [ServerName, MonitorUrl])), PChar(LNG_ALERT_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  560.     begin
  561.       ShellExecute(Handle, 'open', PChar(MonitorUrl), '', '', SW_NORMAL);
  562.     end;
  563.   end
  564.   else if x = msMonitorGeneralError then
  565.   begin
  566.     MonitorGrid.Rows[i].Strings[2] := LNG_STAT_GENERALERROR;
  567.     StatCache.Values[MonitorUrl] := LNG_STAT_GENERALERROR;
  568.     NotifyIconChange(NIM_MODIFY);
  569.     if MessageBox(Handle, PChar(Format(LNG_ALERT_MONITOR_FAILURE, [ServerName, MonitorUrl])), PChar(LNG_ALERT_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  570.     begin
  571.       ShellExecute(Handle, 'open', PChar(MonitorUrl), '', '', SW_NORMAL);
  572.     end;
  573.   end
  574.   else if x = msServerDown then
  575.   begin
  576.     MonitorGrid.Rows[i].Strings[2] := LNG_STAT_SERVERDOWN;
  577.     StatCache.Values[MonitorUrl] := LNG_STAT_SERVERDOWN;
  578.     NotifyIconChange(NIM_MODIFY);
  579.     // Es besteht eine Internetverbindung, daher ist wohl was mit dem
  580.     // Server nicht in Ordnung
  581.  
  582.     if MessageBox(Handle, PChar(Format(LNG_ALERT_SERVER_DOWN, [ServerName, MonitorUrl])), PChar(LNG_ALERT_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  583.     begin
  584.       Ping1.Click;
  585.     end;
  586.   end
  587.   else if x = msInternetBroken then
  588.   begin
  589.     MonitorGrid.Rows[i].Strings[2] := LNG_STAT_INTERNETBROKEN;
  590.     StatCache.Values[MonitorUrl] := LNG_STAT_INTERNETBROKEN;
  591.     NotifyIconChange(NIM_MODIFY);
  592.     if not WarnAtConnectivityFailure then
  593.     begin
  594.       if MessageBox(Handle, PChar(Format(LNG_ALERT_CONNECTIVITY_FAILURE, [ServerName, MonitorUrl])), PChar(LNG_ALERT_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
  595.       begin
  596.         Ping1.Click;
  597.       end;
  598.     end;
  599.   end;
  600. end;
  601.  
  602. function TMainForm.Status: boolean;
  603. var
  604.   i: integer;
  605.   s: string;
  606. begin
  607.   for i := 1 to MonitorGrid.RowCount - 1 do
  608.   begin
  609.     s := MonitorGrid.Cells[2, i];
  610.     if (s <> LNG_STAT_OK) and (s <> LNG_STAT_UNKNOWN) and
  611.        (s <> LNG_STAT_QUEUE) and (s <> LNG_STAT_CHECKING) and
  612.        (s <> '') then
  613.     begin
  614.       result := false;
  615.       exit;
  616.     end;
  617.   end;
  618.   result := true;
  619. end;
  620.  
  621. // Ref: http://delphi.about.com/od/adptips2006/qt/rightalignmenu.htm
  622. (* procedure TMainForm.RightAlignHelpMenuItem;
  623. var
  624.   mii: TMenuItemInfo;
  625.   hMainMenu: hMenu;
  626.   Buffer: array[0..79] of Char;
  627. begin
  628.   hMainMenu := Self.Menu.Handle;
  629.  
  630.   //GET Help Menu Item Info
  631.   mii.cbSize := SizeOf(mii) ;
  632.   mii.fMask := MIIM_TYPE;
  633.   mii.dwTypeData := Buffer;
  634.   mii.cch := SizeOf(Buffer) ;
  635.   GetMenuItemInfo(hMainMenu, MHelp.Command, false, mii) ;
  636.  
  637.   //SET Help Menu Item Info
  638.   mii.fType := mii.fType or MFT_RIGHTJUSTIFY;
  639.   SetMenuItemInfo(hMainMenu, MHelp.Command, false, mii) ;
  640. end; *)
  641.  
  642. procedure TMainForm.MonitorGridMouseDown(Sender: TObject;
  643.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  644. var
  645.   col, row: integer;
  646. begin
  647.   if Button = mbRight then
  648.   begin
  649.     MonitorGrid.MouseToCell(X, Y, col, row);
  650.     if row >= MonitorGrid.FixedRows then
  651.       MonitorGrid.Row := row;
  652.  
  653.     if col >= MonitorGrid.FixedCols then
  654.       MonitorGrid.Col := col;
  655.  
  656.     if (row >= MonitorGrid.FixedRows) and
  657.        (col >= MonitorGrid.FixedCols) then
  658.     begin
  659.       MonitorGrid.PopupMenu := MenuPopupMenu;
  660.     end
  661.     else
  662.     begin
  663.       MonitorGrid.PopupMenu := nil;
  664.     end;
  665.   end;
  666. end;
  667.  
  668. procedure TMainForm.Edit1Click(Sender: TObject);
  669. begin
  670.   Edit2.Click;
  671. end;
  672.  
  673. procedure TMainForm.Edit2Click(Sender: TObject);
  674. begin
  675.   if EditForm.ShowDialog(GetCurrentMonitorName) then LoadList;
  676. end;
  677.  
  678. procedure TMainForm.Delete2Click(Sender: TObject);
  679. var
  680.   reg: TRegistry;
  681. begin
  682.   if MessageBox(Handle, PChar(Format(LNG_DELETE_TEXT, [GetCurrentMonitorName])), PChar(LNG_DELETE_CAPTION), MB_ICONQUESTION or MB_YESNOCANCEL) = IDYES then
  683.   begin
  684.     reg := TRegistry.Create;
  685.     try
  686.       reg.RootKey := HKEY_CURRENT_USER;
  687.       if reg.DeleteKey(Format(REG_KEY_SERVICE, [GetCurrentMonitorName])) then LoadList;
  688.     finally
  689.       reg.Free;
  690.     end;
  691.   end;
  692. end;
  693.  
  694. procedure TMainForm.Delete1Click(Sender: TObject);
  695. begin
  696.   Delete2.Click;
  697. end;
  698.  
  699. procedure TMainForm.Checknow1Click(Sender: TObject);
  700. begin
  701.   Checknow2.Click;
  702. end;
  703.  
  704. procedure TMainForm.Checknow2Click(Sender: TObject);
  705. begin
  706.   ProcessStatMon(MonitorGrid.Row, true);
  707. end;
  708.  
  709. procedure TMainForm.MConnWarnOptClick(Sender: TObject);
  710. var
  711.   reg: TRegistry;
  712. begin
  713.   reg := TRegistry.Create;
  714.   try
  715.     reg.RootKey := HKEY_CURRENT_USER;
  716.     if reg.OpenKey(REG_KEY_SETTINGS, true) then
  717.     begin
  718.       WarnAtConnectivityFailure := MConnWarnOpt.Checked;
  719.       reg.WriteBool(REG_VAL_WARN_AT_CONNFAILURE, WarnAtConnectivityFailure);
  720.     end;
  721.   finally
  722.     reg.Free;
  723.   end;
  724. end;
  725.  
  726. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  727. begin
  728.   Hide;
  729.   CanClose := RealClose;
  730. end;
  731.  
  732. procedure TMainForm.OnQueryEndSession(var Msg: TWMQueryEndSession);
  733. begin
  734.   RealClose := true;
  735.   Close;
  736.   Msg.Result := 1;
  737. end;
  738.  
  739. procedure TMainForm.OnWmQuit(var Msg: TWMQuit);
  740. begin
  741.   RealClose := true;
  742.   Close;
  743.   Msg.Result := 1;
  744. end;
  745.  
  746. end.
  747.