Fehler in Tool zur Nezwerk- und Programm- Prüfung

[theend]

hi,
ich habe ein Programm (teilweise selber, teilweise aus dem Net oder Foren Programmiert) mit dem ich prüfe ob ein Programm XXX.exe und mehrere Netzwerkserver (die in der Datei XXX.txt mit IP-Adresse eingetragen sind) Online sind, allerdings tretten immer wieder Fehler auf, die da währen:

Das Programm sendet eine Offline meldung obwohl das Programm bzw. der Netzwerk Rechner Online ist.

Kann mir da wer helfen?

Delphi-Quellcode:

unit tasks1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tlhelp32, StdCtrls, ExtCtrls, ShellAPI, IdBaseComponent,
  IdComponent, IdRawBase, IdRawClient, IdIcmpClient;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Timer2: TTimer;
    ICMP: TIdIcmpClient;
    Timer3: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure ICMPReply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
  private
    { Private-Deklarationen }
  public
    { Private-Deklarationen }
  end;

var
  Form1: TForm1;
  xx: Boolean;

implementation

{$R *.dfm}

{******************************************************************************}
{**                                                                          **}
{** Prozesse in Stringliste schreiben                                        **}
{**                                                                          **}
{******************************************************************************}
procedure GetProcessList(sl: TStrings);
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  { Snapshot machen *PENG* }
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then exit;

  pe32.dwSize := SizeOf(ProcessEntry32);

  { wenn es geklappt hat }
  if Process32First(hProcSnap, pe32) = true then
    { und los geht's }
    { Process32First liefert auch schon einen Prozess, den System-Prozess }
    sl.Add(pe32.szExeFile);
    while Process32Next(hProcSnap, pe32) = true do
    begin
      sl.Add(pe32.szExeFile);
      if AnsiCompareStr(LowerCase(pe32.SZExeFile),LowerCase('XXX.exe')) = 0 then
      begin
        xx := true;
      end
      else
      begin
         xx := false;
      end
    end;
  CloseHandle(hProcSnap);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Clear;
GetProcessList(ListBox1.Items);
if xx = true then
begin
Timer1.Enabled := true;
end
else
begin
Timer2.Enabled := true;
end
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
ListBox1.Clear;
GetProcessList(ListBox1.Items);
if not xx = true then
begin
Timer1.Enabled := false;
ShellExecute(Application.Handle, 'open', 'mail.bat', nil, nil, SW_SHOW);
Timer2.Enabled := true;
end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
ListBox1.Clear;
GetProcessList(ListBox1.Items);
if xx = true then
begin
Timer2.Enabled := false;
Timer1.Enabled := true;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer2.Enabled := false;
Timer1.Enabled := false;
ListBox1.Clear;
GetProcessList(ListBox1.Items);
if xx = true then
begin
Timer1.Enabled := true;
end
else
begin
Timer2.Enabled := true;
end
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer2.Enabled := false;
Timer1.Enabled := false;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ShellExecute(Application.Handle, 'open', 'C:\XXX.exe', nil, nil, SW_SHOW);
end;

procedure TForm1.Timer3Timer(Sender: TObject);
  i: integer;
  Dateiname: TStringList;
begin
if FileExists('XXX.txt') then
  begin

  ICMP.OnReply := ICMPReply;
  i := 0;
  Dateiname := TStringList.Create;
  Dateiname.LoadFromFile('XXX.txt');
  
    while i <= Dateiname.Count - 1 do
    begin
     ICMP.Host := Dateiname.Strings[i];
     ICMP.Ping;
     Application.ProcessMessages;
     i:= i + 1;
    end
  end
end;

procedure TForm1.ICMPReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
if AReplyStatus.TimeToLive = 0 then ShellExecute(Application.Handle, 'open', 'mailto.exe', nil, nil, SW_SHOW);
end;

end.

Timer zeiten:
timer1: 15 sec
timer2: 5 sec
timer3: 30 sec

[shmia]

ich sehe da schon einen Bug in procedure GetProcessList(sl: TStrings):
du bist in einer While-Schleife und machst folgendes:

Delphi-Quellcode:

   if AnsiCompareStr(LowerCase(pe32.SZExeFile),LowerCase('XXX.exe')) = 0 then 
      begin 
        xx := true; 
      end 
      else 
      begin 
         xx := false; 
      end

Ob die globale Variable xx am Ende True oder False ist hängt davon ab, ob das letzte Programm den Namen XXX.exe trägt.
Vorschlag: in GetProcessList soll nicht auf XXX.exe geprüft werden, sondern dies wird in einer extra Funktion erledigt.

[theend]

hm.. danke auf das hab ich jetzt garnimmer so genau geachtet... werd mir das mal anschaun und versuchen!

hm.. shmia

Delphi-Quellcode:

    while Process32Next(hProcSnap, pe32) = true do
    begin
      sl.Add(pe32.szExeFile);
      if AnsiCompareStr(LowerCase(pe32.SZExeFile),LowerCase('aports.exe')) = 0 then
      begin
        xx := true;
      end
      else
      begin
         xx := false;
      end
    end;

nur mal so ne blöde frage... aber ich würde das so verstehen das er die weil schleife so lange ausführt bis kein prozess mehr weiter unten steht.. aber jedesmal wenn er einen prozess added prüft ob das der prozess ist?!
Aber ich muss dir recht geben das würde auch erklären wieso er manchmal meint mein Programm sei offline obwohl es das nicht ist!

frage:
währe es möglich da ich alle Prozesse in eine listbox schreibe in dieser listbox nach einem eintrag zu suchen!?

[shmia]

Zitat von theend:

währe es möglich da ich alle Prozesse in eine listbox schreibe in dieser listbox nach einem eintrag zu suchen!?

Ja klar.
baust du dir eine Funktion und schmeist die globale Variable xx auf den Müll

Delphi-Quellcode:

function TForm1.ProgrammExists(const progname:string):boolean;
var
   i : integer;
begin
   for i:=0 to ListBox1.Items.Count-1 do
   begin
      if AnsiCompareStr(LowerCase(ListBox1.Items[i]),LowerCase(progname)) = 0 then 
      begin
         result := True;
         Exit;
      end;
   end;
   Result := False;
end;

[theend]

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
test: TStringList;
begin
Listbox1.Clear;
GetProcessList(Listbox1.items);
i := 0;
test := TStringList.Create;
test.AddStrings(Listbox1.items);
while i <= test.Count - 1  do
begin
if test.Strings[i] = PChar('XXX.exe') then ShellExecute(Application.Handle, 'open', 'mail.bat', nil, nil, SW_SHOW); 

i := i+1;
end

so hab i das jetzt gemacht

da ich ja sowieso alle prozesse in eine listbox ausgebe... lese ich die items in eine TSTringList ein und prüfe ob die gewünschte datei dabei ist!

jetzt muss ich nur noch das if so setzen das der fehler nur dan kommt wen test.Strings[i] = PChar('XXX.exe') nicht zutrifft bis i <= test.Count - 1 ist...

[theend]

shmia hm.. das is natürlich ne elegantere art das zu lösen.. danke.. wen ich darf bau ich das bei mir ein
so dank shmia kleine update vom Programm:

Delphi-Quellcode:

unit tasks1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tlhelp32, StdCtrls, ExtCtrls, ShellAPI, IdBaseComponent,
  IdComponent, IdRawBase, IdRawClient, IdIcmpClient;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Timer2: TTimer;
    ICMP: TIdIcmpClient;
    Timer3: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure ICMPReply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    function ProgrammExists:boolean;
  private
    { Private-Deklarationen }
  public
    { Private-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{******************************************************************************}
{**                                                                          **}
{** Prozesse in Stringliste schreiben                                        **}
{**                                                                          **}
{******************************************************************************}
procedure GetProcessList(sl: TStrings);
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  { Snapshot machen *PENG* }
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then exit;

  pe32.dwSize := SizeOf(ProcessEntry32);

  { wenn es geklappt hat }
  if Process32First(hProcSnap, pe32) = true then
    { und los geht's }
    { Process32First liefert auch schon einen Prozess, den System-Prozess }
    sl.Add(pe32.szExeFile);
    while Process32Next(hProcSnap, pe32) = true do
    begin
      sl.Add(pe32.szExeFile);
    end;
  CloseHandle(hProcSnap);
end;

function TForm1.ProgrammExists:boolean;
var
   i : integer;
begin
ListBox1.Clear;
GetProcessList(ListBox1.Items);
   for i:=0 to ListBox1.Items.Count-1 do
   begin
      if AnsiCompareStr(LowerCase(ListBox1.Items[i]),LowerCase('XXX.exe')) = 0 then
      begin
         result := True;
         Exit;
      end;
   end;
   Result := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Clear;
GetProcessList(ListBox1.Items);
if ProgrammExists = true then
begin
Timer1.Enabled := true;
end
else
begin
Timer2.Enabled := true;
end
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var datum: string;
zeit: string;
begin
datum := DateToStr(Date);
zeit := TimeToStr(now);
ListBox1.Clear;
GetProcessList(ListBox1.Items);
if ProgrammExists = false then
begin
Timer1.Enabled := false;
ShellExecute(Handle, PChar('open'), PChar('mailto.exe'), nil, nil, SW_SHOW);
Timer2.Enabled := true;
end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
ListBox1.Clear;
GetProcessList(ListBox1.Items);
if ProgrammExists = true then
begin
Timer2.Enabled := false;
Timer1.Enabled := true;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer2.Enabled := false;
Timer1.Enabled := false;
ListBox1.Clear;
GetProcessList(ListBox1.Items);
if ProgrammExists = true then
begin
Timer1.Enabled := true;
end
else
begin
Timer2.Enabled := true;
end
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer2.Enabled := false;
Timer1.Enabled := false;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ShellExecute(Application.Handle, 'open', 'XXX.exe', nil, nil, SW_SHOW);
end;

procedure TForm1.Timer3Timer(Sender: TObject);
var  i: integer;
  Dateiname: TStringList;
begin
if FileExists('XXX.txt') then
  begin

  ICMP.OnReply := ICMPReply;
  i := 0;
  Dateiname := TStringList.Create;
  Dateiname.LoadFromFile('XXX.txt');
  
    while i <= Dateiname.Count - 1 do
    begin
     ICMP.Host := Dateiname.Strings[i];
     ICMP.Ping;
     Application.ProcessMessages;
     i:= i + 1;
    end
  end
end;

procedure TForm1.ICMPReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var cam: string;
datum: string;
zeit: string;
begin
cam := Dateiname.Strings[i];
datum := DateToStr(Date);
zeit := TimeToStr(now);
if AReplyStatus.TimeToLive = 0 then ShellExecute(Handle, PChar('open'), PChar('mailto.exe'), nil, nil, SW_SHOW);
end;

end.

so dan bliebe nur noch der fehler mit den Netzwerkservern

[theend]

hm... kann mir da keiner helfen?

im bezug auf die Netzwerkserver hab ich das Problem das ich einen Ping sende und immer nur eine antwort bekomme, und wen diese aus welchen Gründen auch immer ein Request Time Out ist - weil das netzwerk grade ausgelatet ist oder so - löst er gleicht meine Fehlerbenachrichtigung aus.
Wie kann ich sagen wir 4 Ping Antworten haben und schaun eine davon durchkommt und erst wenn alle 4 Time Out haben in meine Fehlerbenachrichtigung wechseln

Delphi-Quellcode:

procedure TForm1.Timer3Timer(Sender: TObject);
var  i: integer;
  Dateiname: TStringList;
begin
if FileExists('XXX.txt') then
  begin

  ICMP.OnReply := ICMPReply;
  i := 0;
  Dateiname := TStringList.Create;
  Dateiname.LoadFromFile('XXX.txt');
 
    while i <= Dateiname.Count - 1 do
    begin
     ICMP.Host := Dateiname.Strings[i];
     ICMP.Ping;
     Application.ProcessMessages;
     i:= i + 1;
    end
  end
end;

procedure TForm1.ICMPReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var cam: string;
datum: string;
zeit: string;
begin
datum := DateToStr(Date);
zeit := TimeToStr(now);
if AReplyStatus.TimeToLive = 0 then ShellExecute(Handle, PChar('open'), PChar('mailto.exe'), nil, nil, SW_SHOW);
end;