Thema: Delphi [HELP] Zeitschleife

Einzelnen Beitrag anzeigen

JackTheRipper

Registriert seit: 18. Sep 2006
10 Beiträge
 
#1

[HELP] Zeitschleife

  Alt 6. Nov 2006, 15:31
Hey,

Ich bin es mal wieder. Sorry das ich euhc mit meinen NewBee Fragen stresse

Also ich bin gerade am Proggen eines Programms das alle 30 Min ein Ping raussendet und
das in einem Memo rausgibt. Doch wie bau ich eine Zeitschleife hab schon die suche benutzt
und nix gefunden. Google hatte auch seine Probleme.

Delphi-Quellcode:
unit Superping;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Registry, ShellApi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Panel1: TPanel;
    Panel2: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetConsoleOutput(const Command: String; var Output, Errors: TStringList): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeOutputWrite: THandle;
  PipeErrorsRead: THandle;
  PipeErrorsWrite: THandle;
  Succeed: Boolean;
  Buffer: array [0..255] of Char;
  NumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  //Initialisierung ProcessInfo
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);

  //Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;

  //Pipes erzeugen
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);

  //Initialisierung StartupInfo
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb:=SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := sw_Hide;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  if CreateProcess(nil, PChar(command), nil, nil, true,
  CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
  StartupInfo, ProcessInfo) then begin
    result:=true;
    //Write-Pipes schließen
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsWrite);

    //Ausgabe Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      Output.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    CloseHandle(PipeOutputRead);

    //Fehler Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      Errors.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    CloseHandle(PipeErrorsRead);

    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hProcess);
  end
  else begin
    result:=false;
    CloseHandle(PipeOutputRead);
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsRead);
    CloseHandle(PipeErrorsWrite);
  end;
end;



procedure TForm1.Button1Click(Sender: TObject);
var output, errors: TStringList;
var ip : string;
begin
showmessage('Ein Moment');
ip:=Edit1.Text;
  output:=TStringList.Create;
 try
    errors:=TStringList.Create;
    if GetConsoleOutput('cmd /c ping '+ip, output, errors) then
      Memo1.Lines.AddStrings(output);
  finally
    output.free;
    errors.free;
  end;



end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Showmessage('ByeBye');
Close;
end;


procedure TForm1.Button4Click(Sender: TObject);
 var regist: TRegistry;
     time : string;
begin

 // if CopyFile(PChar('Superping.exe'), PChar('C:\Programme\SuperPing\Superping.exe'), True) then
   Showmessage('Datei wurde kopiert in C:\Programme\Superping\Superping.exe');
// else
// RaiselastOSError;
CopyFile(@Application.exename[1],@'C:\Programme\Superping.exe'[1],false);//Datei in Win
  regist:=TRegistry.Create;
  try
    regist.RootKey:=HKEY_LOCAL_MACHINE;
    regist.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',true);
      //bei true wird Schlüssel erzeugt, wenn er noch nicht existiert
    regist.WriteString('Superping', 'C:\Programme\Superping.exe');//name und inhalt
  finally
  regist.Free;
  end;


end;




end.
  Mit Zitat antworten Zitat