AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi Fehler in Tool zur Nezwerk- und Programm- Prüfung
Thema durchsuchen
Ansicht
Themen-Optionen

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

Ein Thema von theend · begonnen am 9. Mär 2005 · letzter Beitrag vom 10. Mär 2005
Antwort Antwort
theend

Registriert seit: 7. Sep 2004
26 Beiträge
 
#1

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

  Alt 9. Mär 2005, 09:38
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
  Mit Zitat antworten Zitat
shmia

Registriert seit: 2. Mär 2004
5.508 Beiträge
 
Delphi 5 Professional
 
#2

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

  Alt 9. Mär 2005, 10:12
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.
Andreas
  Mit Zitat antworten Zitat
theend

Registriert seit: 7. Sep 2004
26 Beiträge
 
#3

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

  Alt 9. Mär 2005, 10:50
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!?
  Mit Zitat antworten Zitat
shmia

Registriert seit: 2. Mär 2004
5.508 Beiträge
 
Delphi 5 Professional
 
#4

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

  Alt 9. Mär 2005, 11:51
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;
Andreas
  Mit Zitat antworten Zitat
theend

Registriert seit: 7. Sep 2004
26 Beiträge
 
#5

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

  Alt 9. Mär 2005, 12:05
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...
  Mit Zitat antworten Zitat
theend

Registriert seit: 7. Sep 2004
26 Beiträge
 
#6

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

  Alt 9. Mär 2005, 13:00
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
  Mit Zitat antworten Zitat
theend

Registriert seit: 7. Sep 2004
26 Beiträge
 
#7

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

  Alt 10. Mär 2005, 10:04
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;
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 00:03 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz