Entwickler-Ecke :: Thema anzeigen - Simples Multi und Dauerping tool

Danny W. - Fr 12.01.07 11:33

Der Quellcode is aber häßlich ^^ Ich hab ein verstecktes memo um die abfragen zu prüfen.
Ich hatte dieses erst genommen weil ich den aktuellen ping anzeigen lassen wollte, später aber nichtmehr, deswegen habe ich es versteckt und ich war daraufhin zu faul auf eine Stringliste zurückzugreifen.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Unit1, XPMan;

type
  TForm3 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    Memo2: TMemo;
    Edit1: TEdit;
    Timer2: TTimer;
    Panel1: TPanel;
    Memo3: TMemo;
    Panel2: TPanel;
    Panel3: TPanel;
    XPManifest1: TXPManifest;
    procedure Panel3Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;
  sl,hf : Tstrings;

implementation

{$R *.dfm}

procedure RunConsoleApp(const CommandLine: string; AStrings: TStrings);
type
  TCharBuffer = array[0..MaxInt - 1] of Char;
const
  MaxBufSize = 1024;
var
  I: Longword;
  SI: TStartupInfo;
  PI: TProcessInformation;
  SA: PSecurityAttributes;
  SD: PSECURITY_DESCRIPTOR;
  NewStdIn: THandle;
  NewStdOut: THandle;
  ReadStdOut: THandle;
  WriteStdIn: THandle;
  Buffer: ^TCharBuffer;
  BufferSize: Cardinal;
  Last: WideString;
  Str: WideString;
  ExitCode: DWORD;
  Bread: DWORD;
  Avail: DWORD;
begin
  GetMem(SA, SizeOf(TSecurityAttributes));
  case Win32Platform of
    VER_PLATFORM_WIN32_NT:
      begin
        GetMem(SD, SizeOf(SECURITY_DESCRIPTOR));
        SysUtils.Win32Check(InitializeSecurityDescriptor(SD, SECURITY_DESCRIPTOR_REVISION));
        SysUtils.Win32Check(SetSecurityDescriptorDacl(SD, True, nil, False));
        SA.lpSecurityDescriptor := SD;
      end; {end VER_PLATFORM_WIN32_NT}
  else
    SA.lpSecurityDescriptor := nil;
  end; {end case}
  SA.nLength := SizeOf(SECURITY_ATTRIBUTES);
  SA.bInheritHandle := True;
  SysUtils.Win32Check(CreatePipe(NewStdIn, WriteStdIn, SA, 0));
  if not CreatePipe(ReadStdOut, NewStdOut, SA, 0) then
  begin
    CloseHandle(NewStdIn);
    CloseHandle(WriteStdIn);
    SysUtils.RaiseLastWin32Error;
  end; {end if}
  GetStartupInfo(SI);
  SI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  SI.wShowWindow := {SW_SHOWNORMAL} SW_HIDE;
  SI.hStdOutput := NewStdOut;
  SI.hStdError := NewStdOut;
  SI.hStdInput := NewStdIn;
  if not CreateProcess(nil, PChar(CommandLine), nil, nil, True,
    CREATE_NEW_CONSOLE, nil, nil, SI, PI) then
  begin
    CloseHandle(NewStdIn);
    CloseHandle(NewStdOut);
    CloseHandle(ReadStdOut);
    CloseHandle(WriteStdIn);
    SysUtils.RaiseLastWin32Error;
  end; {end if}
  Last := '';
  BufferSize := MaxBufSize;
  Buffer := AllocMem(BufferSize);
  try
    repeat
      SysUtils.Win32Check(GetExitCodeProcess(PI.hProcess, ExitCode));
      PeekNamedPipe(ReadStdOut, Buffer, BufferSize, @Bread, @Avail, nil);
      if (Bread <> 0) then
      begin
        if (BufferSize < Avail) then
        begin
          BufferSize := Avail;
          ReallocMem(Buffer, BufferSize);
        end; {end if}
        FillChar(Buffer^, BufferSize, #0);
        ReadFile(ReadStdOut, Buffer^, BufferSize, Bread, nil);
        Str := Last;
        I := 0;
        while (I < Bread) do
        begin
          case Buffer^[I] of
            #0: inc(I);
            #10:
              begin
                inc(I);
                AStrings.Add(Str);
                Str := '';
              end; {end #10}
            #13:
              begin
                inc(I);
                if (I < Bread) and (Buffer^[I] = #10) then
                  inc(I);
                AStrings.Add(Str);
                Str := '';
              end; {end #13}
          else
            begin
              Str := Str + Buffer^[I];
              inc(I);
            end; {end else}
          end; {end case}
        end; {end while}
        Last := Str;
      end; {end if}
      Sleep(1);
      Application.ProcessMessages;
    until (ExitCode <> STILL_ACTIVE);
    if Last <> '' then
      AStrings.Add(Last);
  finally
    FreeMem(Buffer);
  end; {end try/finally}
  CloseHandle(PI.hThread);
  CloseHandle(PI.hProcess);
  CloseHandle(NewStdIn);
  CloseHandle(NewStdOut);
  CloseHandle(ReadStdOut);
  CloseHandle(WriteStdIn);
end; {end procedure}

procedure TForm3.Timer1Timer(Sender: TObject);
begin
memo1.clear;
RunConsoleApp('ping '+edit1.text+' -n 1', Memo1.Lines);
timer2.Enabled:=true;
end;

procedure TForm3.Timer2Timer(Sender: TObject);
begin
  if pos('Antwort von ',memo1.text) <> 0 then begin
    memo2.Clear;
    memo2.Lines.add(Edit1.text+' war zuletzt erreichbar am '+datetostr(date)+' um '+timetostr(time));
    end;
  timer2.Enabled:=false;
end;

procedure TForm3.Panel1Click(Sender: TObject);
begin
if timer1.Enabled then
timer1.Enabled:=false else timer1.Enabled:=true;

if panel1.Caption='Start' then panel1.Caption:='Stop' else panel1.Caption:='Start';
end;

procedure TForm3.FormShow(Sender: TObject);
begin
edit1.setfocus;
end;

procedure TForm3.Panel2Click(Sender: TObject);
var i : integer;
begin
warten.visible:=true;
sl := Tstringlist.create;
sl.text := memo3.text;
hf := Tstringlist.create;

memo1.clear;

  for i := 0 to sl.count-1 do begin
  RunConsoleApp('ping '+sl.strings[i]+' -n 1', Memo1.Lines);
    if pos('Antwort von ',memo1.text) <> 0 then begin
    memo2.Lines.add(sl.strings[i]+' war zuletzt erreichbar am '+datetostr(date)+' um '+timetostr(time));
    memo1.clear;
    end;

  end;
 hf.text := memo2.text;
 warten.visible:=false;;
 showmessage('Aktive Clients: '+inttostr(hf.count));
 memo1.clear;
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
sl.free;
hf.free;
end;

procedure TForm3.Panel3Click(Sender: TObject);
begin
Memo2.clear;
end;

end.

Und das Lade-Formular

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Gauges, XPMan;

type
  Twarten = class(TForm)
    Panel2: TPanel;
    Timer1: TTimer;
    Gauge1: TGauge;
    XPManifest1: TXPManifest;
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  warten: Twarten;

implementation

{$R *.dfm}

procedure Twarten.Timer1Timer(Sender: TObject);
begin
Gauge1.Progress:=Gauge1.Progress+2;

  if (gauge1.progress >= 100) and (Gauge1.Forecolor = clSilver) then begin
    Gauge1.Forecolor := clWhite;
    Gauge1.Backcolor := clSilver;
    Gauge1.Progress:=0;
    end;

  if (gauge1.progress >= 100) and (Gauge1.Forecolor = clWhite) then begin
    Gauge1.Forecolor := clSilver;
    Gauge1.Backcolor := clWhite;
    Gauge1.Progress:=0;
    end;



end;

procedure Twarten.FormShow(Sender: TObject);
begin
timer1.enabled := true;
doublebuffered := true;
end;

procedure Twarten.FormHide(Sender: TObject);
begin
timer1.enabled := false;
end;

end.

mfG,
Danny

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!