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.