unit uThread;
interface
uses
Classes, SysUtils, MSXML2_TLB,
ActiveX, Dialogs, uMain, uServer,
ComCtrls, uHostAlive, WbemScripting_TLB, Variants;
type
MyThread =
class(TThread)
private
{ Private-Deklarationen }
protected
procedure Execute;
override;
procedure CheckServerStatus;
procedure ServerStatusToListView;
procedure CheckServiceStatus;
procedure ServiceStatusToListView;
procedure ServerInformationToXML;
public
{ Public-Deklarationen }
art :
String;
lvid : Integer;
lastStatus : Integer;
server :
String;
sid :
String;
curStatus :
String;
user :
String;
pwd :
String;
service :
String;
servicerestart :
String;
end;
implementation
uses uHostSocketAlive, DateUtils;
{ Wichtig: Methoden und Eigenschaften von Objekten in visuellen Komponenten dürfen
nur in einer Methode namens Synchronize aufgerufen werden, z.B.
Synchronize(UpdateCaption);
und UpdateCaption könnte folgendermaßen aussehen:
procedure MyThread.UpdateCaption;
begin
Form1.Caption := 'Aktualisiert in einem Thread';
end; }
{ MyThread }
procedure MyThread.Execute;
begin
CoInitialize(
nil);
try
if art = '
CheckServerStatus'
then
CheckServerStatus;
if art = '
CheckServiceStatus'
then
CheckServiceStatus;
if (art = '
ServerInformationToXML')
and (lastStatus = 1)
then
ServerInformationToXML;
except
on e:
exception do begin
// mache hier irgendetwas mit dem Fehler.
end;
end;
CoUnInitialize();
end;
procedure MyThread.CheckServerStatus;
var
i : Integer;
max : Integer;
begin
// Verbindungsversuche
max := 3;
for i := 0
to max - 1
do
begin
if IsHostAlive(Server) = True
then
begin
curStatus := '
1';
//Server Online
break;
end
else
curStatus := '
2';
//Server Offline
end;
Synchronize(ServerStatusToListView);
end;
procedure MyThread.ServerStatusToListView;
begin
with frm_main.lv_server
do
begin
case lastStatus
of
1 :
begin
if curStatus = '
2'
then
begin
Items[lvid].ImageIndex := 2;
if frm_main.FirstStart = False
then
Items[lvid].SubItems[1] := '
off';
end;
end;
2 :
begin
if curStatus = '
1'
then
begin
Items[lvid].ImageIndex := 1;
if frm_main.FirstStart = False
then
Items[lvid].SubItems[1] := '
on';
end;
end;
end;
end;
end;
procedure MyThread.CheckServiceStatus;
var
SWbemLocator1 : ISWbemLocator;
aSrv : ISWbemServices;
vNVS : OleVariant;
aObjSet : ISWbemObjectSet;
aNVSDummy : IDispatch;
pEnum : IEnumVARIANT;
vOut : OleVariant;
dwRetrieved : LongWord;
hRes : HResult;
begin
try
SWbemLocator1 := CoSWbemLocator.Create;
// Für lokale Computer darf kein Benutzer und Passwort verwendet werden
if UpperCase(server) <> UpperCase(GetEnvironmentVariable('
COMPUTERNAME'))
then
aSrv := SWbemLocator1.ConnectServer(server,'
root\cimv2',user, pwd,'
','
',0,vNVS)
else
aSrv := SWbemLocator1.ConnectServer(server,'
root\cimv2','
','
','
','
',0,vNVS);
aObjSet := aSrv.ExecQuery('
Select * from Win32_Service Where Name = "' +service+'
"','
WQL', 0, aNVSDummy);
pEnum := aObjSet.Get__NewEnum
as IEnumVARIANT;
hRes := pEnum.Next(1, vOut, dwRetrieved);
if hRes = S_OK
then
curStatus := VarToStr(vOut.State);
Free;
Except
curStatus := '
';
end;
Synchronize(ServiceStatusToListView);
end;
procedure MyThread.ServiceStatusToListView;
begin
with frm_main.lv_service
do
begin
case lastStatus
of
16 :
begin
if curStatus <> '
Running'
then
begin
Items[lvid].SubItemImages[4] := 17;
if frm_main.FirstStart = False
then
//Items[lvid].SubItems[6] := 'down';
end;
end;
17 :
begin
if curStatus = '
Running'
then
begin
Items[lvid].SubItemImages[4] := 16;
if frm_main.FirstStart = False
then
//Items[lvid].SubItems[6] := 'up';
end;
end;
0,18 :
begin
if curStatus = '
Running'
then
Items[lvid].SubItemImages[4] := 16
else
Items[lvid].SubItemImages[4] := 17;
end;
end;
end;
end;
// Gekürzter Quellcode
procedure MyThread.ServerInformationToXML;
var
...
begin
...
try
SWbemLocator1 := CoSWbemLocator.Create;
// Für lokale Computer darf kein Benutzer und Passwort verwendet werden
if UpperCase(server) <> UpperCase(GetEnvironmentVariable('
COMPUTERNAME'))
then
aSrv := SWbemLocator1.ConnectServer(server,'
root\cimv2',user, pwd,'
','
',0,vNVS)
else
aSrv := SWbemLocator1.ConnectServer(server,'
root\cimv2','
','
','
','
',0,vNVS);
//*** System Summary ***
aObjSet := aSrv.ExecQuery('
Select * from Win32_ComputerSystem','
WQL', 0, aNVSDummy);
...
//*** Operation System ***
aObjSet := aSrv.ExecQuery('
Select * from Win32_OperatingSystem','
WQL', 0, aNVSDummy);
...
//*** Prozessor Information ***
aObjSet := aSrv.ExecQuery('
Select * from Win32_Processor','
WQL', 0, aNVSDummy);
...
//*** Memory Information ***
aObjSet := aSrv.ExecQuery('
Select * from Win32_PhysicalMemory','
WQL', 0, aNVSDummy);
...
//*** Network Information ***
aObjSet := aSrv.ExecQuery('
Select * from Win32_NetworkAdapterConfiguration where IPEnabled = true','
WQL', 0, aNVSDummy);
...
//*** Storage Information ***
aObjSet := aSrv.ExecQuery('
Select * from Win32_LogicalDisk Where DriveType = 3','
WQL', 0, aNVSDummy);
...
Except
//
end;
end;
end.
Antwort
30. Sep 2008, 18:48
Zitat
Linear-Darstellung
