Einzelnen Beitrag anzeigen

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, 12: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