Subversion Repositories delphiutils

Rev

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

  1. unit StatusMonFuncs;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, IdHTTP;
  7.  
  8. type
  9.   TMonitorState = (msOK, msStatusWarning, msMonitorFailure,
  10.     msServerDown, msInternetBroken);
  11.  
  12. function DeterminateMonitorState(MonitorUrl: String): TMonitorState;
  13.  
  14. implementation
  15.  
  16. function InternetConnectivity(): boolean;
  17. resourcestring
  18.   INTERNET_CHECK_URL = 'http://www.google.de/';
  19. var
  20.   http: TIdHTTP;
  21. begin
  22.   result := true;
  23.   try
  24.     http := TIdHTTP.Create;
  25.     try
  26.       http.Get(INTERNET_CHECK_URL);
  27.     finally
  28.       http.Free;
  29.     end;
  30.   except
  31.     result := false;
  32.   end;
  33. end;
  34.  
  35. function DeterminateMonitorState(MonitorUrl: String): TMonitorState;
  36. var
  37.   http: TIdHTTP;
  38.   s: string;
  39. resourcestring
  40.   OK_COMMENT = '<!-- STATUS: OK -->';
  41.   WARNING_COMMENT = '<!-- STATUS: WARNING -->';
  42. begin
  43.   try
  44.     http := TIdHTTP.Create;
  45.     try
  46.       s := http.Get(MonitorUrl);
  47.       if AnsiPos(OK_COMMENT, s) > 0 then
  48.       begin
  49.         result := msOk;
  50.       end
  51.       else if AnsiPos(WARNING_COMMENT, s) > 0 then
  52.       begin
  53.         result := msStatusWarning;
  54.       end
  55.       else
  56.       begin
  57.         result := msMonitorFailure;
  58.       end;
  59.     finally
  60.       http.Free;
  61.     end;
  62.   except
  63.     if InternetConnectivity() then
  64.     begin
  65.       result := msServerDown;
  66.     end
  67.     else
  68.     begin
  69.       result := msInternetBroken;
  70.     end;
  71.  
  72.     // raise;
  73.   end;
  74. end;
  75.  
  76. end.
  77.