Subversion Repositories delphiutils

Compare Revisions

No changes between revisions

Regard whitespace Rev 49 → Rev 50

/trunk/BackupMon 3.0/StatusMon.dpr
0,0 → 1,18
program StatusMon;
 
uses
Forms,
NoDoubleStart in 'NoDoubleStart.pas',
Main in 'Main.pas' {MainForm},
Functions in 'Functions.pas',
ServiceEdit in 'ServiceEdit.pas' {EditForm},
StatusMonFuncs in 'StatusMonFuncs.pas';
 
{$R *.res}
 
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TEditForm, EditForm);
Application.Run;
end.
/trunk/BackupMon 3.0/StatusMon.identcache
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/BackupMon 3.0/StatusMon.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/BackupMon 3.0/StatusMonitor Anforderungen.txt
0,0 → 1,28
Anforderungen für einen "Statusmonitor"
 
Ein Statusmonitor hat die Aufgabe, den "Status" eines Dienstes
zu indizieren. Es kann nur der Zustand "OK" oder "Warning"
angenommen werden.
 
Die Anforderungen hierfür sind:
 
1. Der Service MUSS stets erreichbar sein.
Ist der Host "down", entsteht eine Warnung.
2. Als Protokoll SOLLTE "http" verwendet werden.
"https" Verbindungen werden aufgrund der Kompatibilität
nicht empfohlen.
3. Der Statusmonitor MUSS erreichbar sein ohne jegliche
erforderliche POST oder Authentifikationsdaten (Passwort).
4. Es MUSS einer der folgenden Kommentare sich in der Ausgabe
befinden:
<!-- STATUS: OK -->
<!-- STATUS: WARNING -->
5. Es MUSS die Groß- und Kleinschreibung und alle Leerzeichen
beachtet werden.
6. "OK" und "WARNING" DÜRFEN NICHT gemeinsam auftreten.
7. Es SOLLTE folgende Kopfzeile in der HTTP-Response gesendet
werden:
X-Status: OK
X-Status: Warning
 
Stand: 12.11.2010 Daniel Marschall ViaThinkSoft
/trunk/BackupMon 3.0/StatusMon.bdsproj.local
0,0 → 1,6
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<Transactions>
<Transaction>2010.11.13 00:41:46.734.pas,C:\Dokumente und Einstellungen\Solar del Sol\Desktop\Redundant\SVN\Delphi Utils\trunk\BackupMon 3.0\Unit1.pas=C:\Dokumente und Einstellungen\Solar del Sol\Desktop\Redundant\SVN\Delphi Utils\trunk\BackupMon 3.0\StatusMonFuncs.pas</Transaction>
</Transactions>
</BorlandProject>
/trunk/BackupMon 3.0/ServiceEdit.pas
0,0 → 1,97
unit ServiceEdit;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Registry;
 
type
TEditForm = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
OriginalValue: String;
public
function ShowDialog(AServiceName: string): boolean;
end;
 
var
EditForm: TEditForm;
 
implementation
 
{$R *.dfm}
 
procedure TEditForm.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
if reg.OpenKey('\Software\ViaThinkSoft\StatusMon\3.0\Services\', true) then
begin
if OriginalValue <> '' then
begin
reg.DeleteKey(OriginalValue);
end;
if reg.OpenKey(Edit1.Text, true) then
begin
reg.WriteString('URL', Edit2.Text);
end;
reg.CloseKey;
end;
finally
reg.Free;
end;
 
ModalResult := mrOk;
end;
 
procedure TEditForm.Button2Click(Sender: TObject);
begin
ModalResult := mrCancel;
end;
 
function TEditForm.ShowDialog(AServiceName: string): boolean;
var
reg: TRegistry;
begin
Edit1.Text := AServiceName;
OriginalValue := AServiceName;
 
if AServiceName = '' then
Caption := 'New status monitor'
else
Caption := 'Edit status monitor';
 
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
if reg.OpenKeyReadOnly('\Software\ViaThinkSoft\StatusMon\3.0\Services\') then
begin
if reg.OpenKeyReadOnly(AServiceName) then
begin
Edit2.Text := reg.ReadString('URL');
end;
reg.CloseKey;
end;
finally
reg.Free;
end;
 
Show;
Edit1.SetFocus;
Hide;
 
Result := ShowModal() = mrOk;
end;
 
end.
/trunk/BackupMon 3.0/Main.dfm
0,0 → 1,145
object MainForm: TMainForm
Left = 219
Top = 164
Caption = 'ViaThinkSoft Status Monitor 3.0'
ClientHeight = 479
ClientWidth = 730
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object StringGrid1: TStringGrid
Left = 0
Top = 0
Width = 730
Height = 414
Align = alClient
ColCount = 3
DefaultRowHeight = 18
FixedCols = 0
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goRowSelect]
PopupMenu = PopupMenu2
TabOrder = 0
OnDblClick = StringGrid1DblClick
OnMouseDown = StringGrid1MouseDown
ColWidths = (
214
359
111)
end
object Panel1: TPanel
Left = 0
Top = 414
Width = 730
Height = 65
Align = alBottom
BevelOuter = bvNone
TabOrder = 1
object Panel2: TPanel
Left = 0
Top = 40
Width = 730
Height = 25
Align = alBottom
BevelOuter = bvNone
Caption = 'Next check in 3, 2, 1...'
TabOrder = 0
end
object Button3: TButton
Left = 520
Top = 8
Width = 75
Height = 25
Caption = 'Config'
TabOrder = 1
end
object Button5: TButton
Left = 632
Top = 8
Width = 75
Height = 25
Caption = 'Close'
TabOrder = 2
OnClick = Button5Click
end
object Button1: TButton
Left = 272
Top = 16
Width = 75
Height = 25
Caption = 'Check all'
TabOrder = 3
OnClick = Button1Click
end
end
object PopupMenu1: TPopupMenu
Left = 8
Top = 48
object Anzeigen1: TMenuItem
Caption = '&Anzeigen'
Default = True
OnClick = Anzeigen1Click
end
object Beenden1: TMenuItem
Caption = '&Beenden'
OnClick = Beenden1Click
end
end
object PopupMenu2: TPopupMenu
Left = 40
Top = 48
object New1: TMenuItem
Caption = 'New...'
OnClick = New1Click
end
object N2: TMenuItem
Caption = '-'
end
object Open1: TMenuItem
Caption = 'Open'
Default = True
OnClick = Open1Click
end
object Ping1: TMenuItem
Caption = 'Ping'
end
object Checknow1: TMenuItem
Caption = 'Check now'
end
object N1: TMenuItem
Caption = '-'
end
object Edit1: TMenuItem
Caption = 'Edit...'
OnClick = Edit1Click
end
object Delete1: TMenuItem
Caption = '&Delete...'
OnClick = Delete1Click
end
end
object InitTimer: TTimer
Interval = 10000
OnTimer = InitTimerTimer
Left = 8
Top = 80
end
object LoopTimer: TTimer
Enabled = False
Interval = 60000
OnTimer = LoopTimerTimer
Left = 40
Top = 80
end
end
/trunk/BackupMon 3.0/Main.ddp
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/BackupMon 3.0/Functions.pas
0,0 → 1,99
unit Functions;
 
interface
 
uses
SysUtils, Windows, Messages;
 
function GetDomainNameByURL(URL: string): string;
function ForceForegroundWindow(hwnd: THandle): Boolean;
 
implementation
 
function GetDomainNameByURL(URL: string): string;
var
i: integer;
j: integer;
c: String;
const
Delim = '/';
begin
j := 0;
for i := 1 to Length(URL) do
begin
c := Copy(URL, i, 1);
 
if (j = 2) and (c <> Delim) then
begin
result := result + c;
end
else if j > 2 then break;
 
if c = Delim then
begin
inc(j);
end;
end;
end;
 
// Ref: http://www.swissdelphicenter.ch/de/showcode.php?id=261
 
function ForceForegroundWindow(hwnd: THandle): Boolean;
const
SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
ForegroundThreadID: DWORD;
ThisThreadID: DWORD;
timeout: DWORD;
begin
if IsIconic(hwnd) then ShowWindow(hwnd, SW_RESTORE);
 
if GetForegroundWindow = hwnd then Result := True
else
begin
// Windows 98/2000 doesn't want to foreground a window when some other
// window has keyboard focus
 
if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and
(Win32MinorVersion > 0)))) then
begin
// Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
// Converted to Delphi by Ray Lischner
// Published in The Delphi Magazine 55, page 16
 
Result := False;
ForegroundThreadID := GetWindowThreadProcessID(GetForegroundWindow, nil);
ThisThreadID := GetWindowThreadPRocessId(hwnd, nil);
if AttachThreadInput(ThisThreadID, ForegroundThreadID, True) then
begin
BringWindowToTop(hwnd); // IE 5.5 related hack
SetForegroundWindow(hwnd);
AttachThreadInput(ThisThreadID, ForegroundThreadID, False);
Result := (GetForegroundWindow = hwnd);
end;
if not Result then
begin
// Code by Daniel P. Stasinski
SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),
SPIF_SENDCHANGE);
BringWindowToTop(hwnd); // IE 5.5 related hack
SetForegroundWindow(hWnd);
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE);
end;
end
else
begin
BringWindowToTop(hwnd); // IE 5.5 related hack
SetForegroundWindow(hwnd);
end;
 
Result := (GetForegroundWindow = hwnd);
end;
end;
 
end.
/trunk/BackupMon 3.0/StatusMon.cfg
0,0 → 1,38
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"C:\Dokumente und Einstellungen\Solar del Sol\Eigene Dateien\Borland Studio-Projekte\Bpl"
-LN"C:\Dokumente und Einstellungen\Solar del Sol\Eigene Dateien\Borland Studio-Projekte\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST
/trunk/BackupMon 3.0/StatusMon.bdsproj
0,0 → 1,175
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<PersonalityInfo>
<Option>
<Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType">VCLApplication</Option>
<Option Name="Version">1.0</Option>
<Option Name="GUID">{D2B09E0C-F720-43E0-B7DD-5131387DE041}</Option>
</Option>
</PersonalityInfo>
<Delphi.Personality>
<Source>
<Source Name="MainSource">StatusMon.dpr</Source>
</Source>
<FileVersion>
<FileVersion Name="Version">7.0</FileVersion>
</FileVersion>
<Compiler>
<Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler>
<Compiler Name="C">1</Compiler>
<Compiler Name="D">1</Compiler>
<Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler>
<Compiler Name="G">1</Compiler>
<Compiler Name="H">1</Compiler>
<Compiler Name="I">1</Compiler>
<Compiler Name="J">0</Compiler>
<Compiler Name="K">0</Compiler>
<Compiler Name="L">1</Compiler>
<Compiler Name="M">0</Compiler>
<Compiler Name="N">1</Compiler>
<Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler>
<Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler>
<Compiler Name="V">1</Compiler>
<Compiler Name="W">0</Compiler>
<Compiler Name="X">1</Compiler>
<Compiler Name="Y">1</Compiler>
<Compiler Name="Z">1</Compiler>
<Compiler Name="ShowHints">True</Compiler>
<Compiler Name="ShowWarnings">True</Compiler>
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
<Compiler Name="NamespacePrefix"></Compiler>
<Compiler Name="GenerateDocumentation">False</Compiler>
<Compiler Name="DefaultNamespace"></Compiler>
<Compiler Name="SymbolDeprecated">True</Compiler>
<Compiler Name="SymbolLibrary">True</Compiler>
<Compiler Name="SymbolPlatform">True</Compiler>
<Compiler Name="SymbolExperimental">True</Compiler>
<Compiler Name="UnitLibrary">True</Compiler>
<Compiler Name="UnitPlatform">True</Compiler>
<Compiler Name="UnitDeprecated">True</Compiler>
<Compiler Name="UnitExperimental">True</Compiler>
<Compiler Name="HResultCompat">True</Compiler>
<Compiler Name="HidingMember">True</Compiler>
<Compiler Name="HiddenVirtual">True</Compiler>
<Compiler Name="Garbage">True</Compiler>
<Compiler Name="BoundsError">True</Compiler>
<Compiler Name="ZeroNilCompat">True</Compiler>
<Compiler Name="StringConstTruncated">True</Compiler>
<Compiler Name="ForLoopVarVarPar">True</Compiler>
<Compiler Name="TypedConstVarPar">True</Compiler>
<Compiler Name="AsgToTypedConst">True</Compiler>
<Compiler Name="CaseLabelRange">True</Compiler>
<Compiler Name="ForVariable">True</Compiler>
<Compiler Name="ConstructingAbstract">True</Compiler>
<Compiler Name="ComparisonFalse">True</Compiler>
<Compiler Name="ComparisonTrue">True</Compiler>
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
<Compiler Name="UnsupportedConstruct">True</Compiler>
<Compiler Name="FileOpen">True</Compiler>
<Compiler Name="FileOpenUnitSrc">True</Compiler>
<Compiler Name="BadGlobalSymbol">True</Compiler>
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
<Compiler Name="InvalidDirective">True</Compiler>
<Compiler Name="PackageNoLink">True</Compiler>
<Compiler Name="PackageThreadVar">True</Compiler>
<Compiler Name="ImplicitImport">True</Compiler>
<Compiler Name="HPPEMITIgnored">True</Compiler>
<Compiler Name="NoRetVal">True</Compiler>
<Compiler Name="UseBeforeDef">True</Compiler>
<Compiler Name="ForLoopVarUndef">True</Compiler>
<Compiler Name="UnitNameMismatch">True</Compiler>
<Compiler Name="NoCFGFileFound">True</Compiler>
<Compiler Name="ImplicitVariants">True</Compiler>
<Compiler Name="UnicodeToLocale">True</Compiler>
<Compiler Name="LocaleToUnicode">True</Compiler>
<Compiler Name="ImagebaseMultiple">True</Compiler>
<Compiler Name="SuspiciousTypecast">True</Compiler>
<Compiler Name="PrivatePropAccessor">True</Compiler>
<Compiler Name="UnsafeType">False</Compiler>
<Compiler Name="UnsafeCode">False</Compiler>
<Compiler Name="UnsafeCast">False</Compiler>
<Compiler Name="OptionTruncated">True</Compiler>
<Compiler Name="WideCharReduced">True</Compiler>
<Compiler Name="DuplicatesIgnored">True</Compiler>
<Compiler Name="UnitInitSeq">True</Compiler>
<Compiler Name="LocalPInvoke">True</Compiler>
<Compiler Name="MessageDirective">True</Compiler>
<Compiler Name="CodePage"></Compiler>
</Compiler>
<Linker>
<Linker Name="MapFile">0</Linker>
<Linker Name="OutputObjs">0</Linker>
<Linker Name="GenerateHpps">False</Linker>
<Linker Name="ConsoleApp">1</Linker>
<Linker Name="DebugInfo">False</Linker>
<Linker Name="RemoteSymbols">False</Linker>
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
<Linker Name="ImageBase">4194304</Linker>
<Linker Name="ExeDescription"></Linker>
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir"></Directories>
<Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir"></Directories>
<Directories Name="SearchPath"></Directories>
<Directories Name="Packages"></Directories>
<Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams"></Parameters>
<Parameters Name="HostApplication"></Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="DebugCWD"></Parameters>
<Parameters Name="Debug Symbols Search Path"></Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<Language>
<Language Name="ActiveLang"></Language>
<Language Name="ProjectLang">$00000000</Language>
<Language Name="RootDir"></Language>
</Language>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1031</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
<VersionInfoKeys Name="ProductName"></VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
</BorlandProject>
/trunk/BackupMon 3.0/StatusMon.dof
0,0 → 1,87
[FileVersion]
Version=6.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
/trunk/BackupMon 3.0/Main.pas
0,0 → 1,389
unit Main;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellAPI, Menus, Registry, Grids, StdCtrls, ExtCtrls;
 
const
WM_TASKABAREVENT = WM_USER+1; //Taskbar message
 
type
TMainForm = class(TForm)
PopupMenu1: TPopupMenu;
Anzeigen1: TMenuItem;
Beenden1: TMenuItem;
StringGrid1: TStringGrid;
Panel1: TPanel;
Panel2: TPanel;
PopupMenu2: TPopupMenu;
Edit1: TMenuItem;
Open1: TMenuItem;
Button3: TButton;
N1: TMenuItem;
Delete1: TMenuItem;
Button5: TButton;
New1: TMenuItem;
N2: TMenuItem;
Ping1: TMenuItem;
InitTimer: TTimer;
LoopTimer: TTimer;
Checknow1: TMenuItem;
Button1: TButton;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Anzeigen1Click(Sender: TObject);
procedure Beenden1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure StringGrid1DblClick(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Edit1Click(Sender: TObject);
procedure Delete1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure New1Click(Sender: TObject);
procedure InitTimerTimer(Sender: TObject);
procedure LoopTimerTimer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
RealClose: boolean;
WarnAtConnectivityFailure: boolean;
procedure TaskbarEvent(var Msg: TMessage);
Message WM_TASKABAREVENT;
procedure OnQueryEndSession(var Msg: TWMQueryEndSession);
message WM_QUERYENDSESSION;
procedure NotifyIconChange(dwMessage: Cardinal);
procedure LoadConfig;
procedure ProcessStatMon(MonitorUrl, ServerName: string; Silent: boolean);
procedure ProcessAll(Silent: boolean);
public
procedure Vordergrund;
procedure LoadList;
end;
 
var
MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
uses
Functions,
ServiceEdit,
StatusMonFuncs;
 
// Ref: http://www.delphi-fundgrube.de/faq01.htm
 
procedure TMainForm.TaskbarEvent(var Msg: TMessage);
var
Point: TPoint;
begin
 
{ Die WM_TaskbarEvent-Message "Msg" gibt in Msg.LParam
das genaue Ereignis an. Msg.LParam kann folgende Werte für
Mausereignisse annehmen:
 
WM_MouseMove
WM_LButtonDown
WM_LButtonUp
WM_LButtonDblClk
WM_RButtonDown
WM_RButtonUp
WM_RButtonDblClk }
 
case Msg.LParam of
WM_LButtonDblClk:
begin
Vordergrund;
end;
WM_RButtonUp:
begin
// Rechtsklick
// Diese Zeile ist wichtig, damit das PopupMenu korrekt
// wieder geschlossen wird:
SetForegroundWindow(Handle);
// PopupMenu anzeigen:
GetCursorPos(Point);
PopupMenu1.Popup(Point.x, Point.y);
//oder ohne Variable Point:
//PopupMenu1.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);
end;
end;
end;
 
procedure TMainForm.New1Click(Sender: TObject);
begin
if EditForm.ShowDialog('') then LoadList;
end;
 
procedure TMainForm.NotifyIconChange(dwMessage: Cardinal);
var
NotifyIconData: TNotifyIconData;
begin
Fillchar(NotifyIconData,Sizeof(NotifyIconData), 0);
NotifyIconData.cbSize := Sizeof(NotifyIconData);
NotifyIconData.Wnd := Handle;
NotifyIconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
NotifyIconData.uCallbackMessage := WM_TASKABAREVENT;
NotifyIconData.hIcon := Application.Icon.Handle;
NotifyIconData.szTip := 'ViaThinkSoft Status Monitor 3.0';
Shell_NotifyIcon(dwMessage, @NotifyIconData);
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
NotifyIconChange(NIM_DELETE);
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
NotifyIconChange(NIM_ADD);
 
StringGrid1.Rows[0].Add('Name');
StringGrid1.Rows[0].Add('URL');
StringGrid1.Rows[0].Add('Status');
 
LoadConfig;
end;
 
procedure TMainForm.Vordergrund;
begin
Show;
ShowWindow(Handle, SW_RESTORE);
ForceForegroundWindow(Handle);
end;
 
procedure TMainForm.Anzeigen1Click(Sender: TObject);
begin
Vordergrund;
end;
 
procedure TMainForm.Beenden1Click(Sender: TObject);
begin
RealClose := true;
Close;
end;
 
procedure TMainForm.LoadConfig;
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
if reg.OpenKeyReadOnly('\Software\ViaThinkSoft\StatusMon\3.0\Settings\') then
begin
InitTimer.Interval := reg.ReadInteger('InitTimerInterval');
LoopTimer.Interval := reg.ReadInteger('LoopTimerInterval');
WarnAtConnectivityFailure := reg.ReadBool('WarnAtConnectivityFailure');
reg.CloseKey;
end;
finally
reg.Free;
end;
end;
 
procedure TMainForm.LoadList;
var
reg: TRegistry;
st: TStringList;
i: Integer;
begin
reg := TRegistry.Create;
st := TStringList.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
if reg.OpenKeyReadOnly('\Software\ViaThinkSoft\StatusMon\3.0\Services\') then
begin
reg.GetKeyNames(st);
StringGrid1.RowCount := st.Count + 1;
for i := 0 to st.Count - 1 do
begin
if reg.OpenKeyReadOnly('\Software\ViaThinkSoft\StatusMon\3.0\Services\'+st.Strings[i]+'\') then
begin
StringGrid1.Rows[i+1].Clear;
StringGrid1.Rows[i+1].Add(st.Strings[i]);
StringGrid1.Rows[i+1].Add(reg.ReadString('URL'));
StringGrid1.Rows[i+1].Add('Unknown');
end;
end;
reg.CloseKey;
end;
finally
st.Free;
reg.Free;
end;
end;
 
procedure TMainForm.LoopTimerTimer(Sender: TObject);
begin
ProcessAll(true);
end;
 
procedure TMainForm.FormShow(Sender: TObject);
begin
LoadList;
end;
 
procedure TMainForm.InitTimerTimer(Sender: TObject);
begin
InitTimer.Enabled := false;
LoopTimer.Enabled := true;
end;
 
procedure TMainForm.StringGrid1DblClick(Sender: TObject);
begin
Open1.Click;
end;
 
procedure TMainForm.Open1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar(StringGrid1.Rows[StringGrid1.Row].Strings[1]), '', '', SW_SHOW)
end;
 
procedure TMainForm.ProcessAll(Silent: boolean);
var
i: integer;
begin
for i := 1 to StringGrid1.RowCount - 1 do
begin
ProcessStatMon(StringGrid1.Rows[i].Strings[1], StringGrid1.Rows[i].Strings[0], Silent);
end;
end;
 
procedure TMainForm.ProcessStatMon(MonitorUrl, ServerName: string;
Silent: boolean);
resourcestring
LNG_CAPTION = 'Status Monitor Alert';
LNG_CAPTION_OK = 'Status Monitor Check';
LNG_STATUS_WARNING = 'Der Status-Monitor "%s" meldet ein Problem! Status-Monitor jetzt öffnen?' + #13#10#13#10 + 'Monitor-URL: %s';
LNG_STATUS_OK = 'Es existieren keine Probleme mit Status-Monitor "%s"' + #13#10#13#10 + 'Monitor-URL: %s';
LNG_MONITOR_FAILURE = 'Die Ausgabe des Status-Monitors "%s" kann nicht interpretiert werden! Status-Monitor jetzt öffnen?' + #13#10#13#10 + 'Monitor-URL: %s';
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';
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';
var
x: TMonitorState;
begin
x := DeterminateMonitorState(MonitorUrl);
 
if x = msOK then
begin
MessageBox(Handle, PChar(Format(LNG_STATUS_OK, [ServerName, MonitorUrl])), PChar(LNG_CAPTION_OK), MB_ICONINFORMATION or MB_OK);
end
else if x = msStatusWarning then
begin
if MessageBox(Handle, PChar(Format(LNG_STATUS_WARNING, [ServerName, MonitorUrl])), PChar(LNG_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
begin
ShellExecute(Handle, 'open', PChar(MonitorUrl), '', '', SW_NORMAL);
end;
end
else if x = msMonitorFailure then
begin
if MessageBox(Handle, PChar(Format(LNG_MONITOR_FAILURE, [ServerName, MonitorUrl])), PChar(LNG_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
begin
ShellExecute(Handle, 'open', PChar(MonitorUrl), '', '', SW_NORMAL);
end;
end
else if x = msServerDown then
begin
// Es besteht eine Internetverbindung, daher ist wohl was mit dem
// Server nicht in Ordnung
 
if MessageBox(Handle, PChar(Format(LNG_SERVER_DOWN, [ServerName, MonitorUrl])), PChar(LNG_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
begin
ShellExecute(Handle, 'open', 'ping', PChar(GetDomainNameByURL(MonitorURL)+' -t'), '', SW_NORMAL);
end;
end
else if x = msInternetBroken then
begin
if not WarnAtConnectivityFailure then
begin
if MessageBox(Handle, PChar(Format(LNG_CONNECTIVITY_FAILURE, [ServerName, MonitorUrl])), PChar(LNG_CAPTION), MB_ICONWARNING or MB_YESNOCANCEL) = IDYES then
begin
ShellExecute(Handle, 'open', 'ping', PChar(GetDomainNameByURL(MonitorURL)+' -t'), '', SW_NORMAL);
end;
end;
end;
end;
 
procedure TMainForm.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
col, row: integer;
begin
if Button = mbRight then
begin
stringgrid1.MouseToCell(X, Y, col, row);
if row >= stringgrid1.FixedRows then
stringgrid1.Row := row;
 
if col >= stringgrid1.FixedCols then
stringgrid1.Col := col;
 
if (row >= stringgrid1.FixedRows) and
(col >= stringgrid1.FixedCols) then
begin
StringGrid1.PopupMenu := PopupMenu2;
end
else
begin
StringGrid1.PopupMenu := nil;
end;
end;
end;
 
procedure TMainForm.Edit1Click(Sender: TObject);
begin
if EditForm.ShowDialog(StringGrid1.Rows[StringGrid1.Row].Strings[0]) then LoadList;
end;
 
procedure TMainForm.Delete1Click(Sender: TObject);
resourcestring
LNG_DELETE = 'Statusmonitor "%s" wirklich löschen?';
LNG_CAPTION = 'Lösch-Bestätigung';
var
reg: TRegistry;
Val: String;
begin
Val := StringGrid1.Cells[0, StringGrid1.Row];
 
if MessageBox(Handle, PChar(Format(LNG_DELETE, [Val])), PChar(LNG_CAPTION), MB_ICONQUESTION or MB_YESNOCANCEL) = IDYES then
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
if reg.DeleteKey('\Software\ViaThinkSoft\StatusMon\3.0\Services\'+Val+'\') then LoadList;
finally
reg.Free;
end;
end;
end;
 
procedure TMainForm.Button1Click(Sender: TObject);
begin
ProcessAll(false);
end;
 
procedure TMainForm.Button5Click(Sender: TObject);
begin
Close;
end;
 
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Hide;
CanClose := RealClose;
end;
 
procedure TMainForm.OnQueryEndSession;
begin
RealClose := true;
Close;
Msg.Result := 1;
end;
 
end.
/trunk/BackupMon 3.0/NoDoubleStart.pas
0,0 → 1,25
unit NoDoubleStart;
 
interface
 
implementation
 
uses
Windows, SysUtils, Forms;
 
var
mHandle: THandle;
 
Initialization
mHandle := CreateMutex(nil, True, 'ViaThinkSoft-StatusMon');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
Halt;
end;
 
finalization
if mHandle <> 0 then
begin
CloseHandle(mHandle)
end;
end.
/trunk/BackupMon 3.0/ServiceEdit.dfm
0,0 → 1,65
object EditForm: TEditForm
Left = 347
Top = 240
BorderStyle = bsDialog
ClientHeight = 161
ClientWidth = 342
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 16
Top = 16
Width = 98
Height = 13
Caption = 'Statusmonitor-Name:'
end
object Label2: TLabel
Left = 16
Top = 64
Width = 92
Height = 13
Caption = 'Statusmonitor-URL:'
end
object Edit1: TEdit
Left = 16
Top = 32
Width = 305
Height = 21
TabOrder = 0
end
object Edit2: TEdit
Left = 16
Top = 80
Width = 305
Height = 21
TabOrder = 1
end
object Button1: TButton
Left = 216
Top = 120
Width = 105
Height = 25
Caption = 'OK'
Default = True
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 16
Top = 120
Width = 105
Height = 25
Cancel = True
Caption = 'Cancel'
TabOrder = 3
OnClick = Button2Click
end
end
/trunk/BackupMon 3.0/StatusMon.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/BackupMon 3.0/StatusMonFuncs.pas
0,0 → 1,76
unit StatusMonFuncs;
 
interface
 
uses
SysUtils, IdHTTP;
 
type
TMonitorState = (msOK, msStatusWarning, msMonitorFailure,
msServerDown, msInternetBroken);
 
function DeterminateMonitorState(MonitorUrl: String): TMonitorState;
 
implementation
 
function InternetConnectivity(): boolean;
resourcestring
INTERNET_CHECK_URL = 'http://www.google.de/';
var
http: TIdHTTP;
begin
result := true;
try
http := TIdHTTP.Create;
try
http.Get(INTERNET_CHECK_URL);
finally
http.Free;
end;
except
result := false;
end;
end;
 
function DeterminateMonitorState(MonitorUrl: String): TMonitorState;
var
http: TIdHTTP;
s: string;
resourcestring
OK_COMMENT = '<!-- STATUS: OK -->';
WARNING_COMMENT = '<!-- STATUS: WARNING -->';
begin
try
http := TIdHTTP.Create;
try
s := http.Get(MonitorUrl);
if AnsiPos(OK_COMMENT, s) > 0 then
begin
result := msOk;
end
else if AnsiPos(WARNING_COMMENT, s) > 0 then
begin
result := msStatusWarning;
end
else
begin
result := msMonitorFailure;
end;
finally
http.Free;
end;
except
if InternetConnectivity() then
begin
result := msServerDown;
end
else
begin
result := msInternetBroken;
end;
 
// raise;
end;
end;
 
end.