/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. |