cmd fenster

[technik05]

scheiße

wenn meine batchdatei ausgeführt wird geht immer noch das cmd fenster auf

hier schaut mal rein:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ShellAPI;

type
TForm1 = class(TForm)
MemoOutput: TMemo;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
fInputPipeRead,
fInputPipeWrite,
fOutputPipeRead,
fOutputPipeWrite: Cardinal;
fProcess: Cardinal;
procedure FClbProc(Sender: TObject; const ABuffer: String; ABufSize: Cardinal);
procedure FOpenProcess;
procedure FCloseProcess;
procedure FWriteToStdIn(const AText: String);
{ Private declarations }
public
{ Public declarations }
end;

TPipeClbProc = procedure(Sender: TObject; const ABuffer: String; ABufSize: Cardinal) of Object;
TPipeReadThread = class(TThread)
private
fBuffer: String;
fBytesRead: Cardinal;
fClbProc: TPipeClbProc;
fPipeOutput: Cardinal;
procedure FSyncProc;
protected
procedure Execute; override;
constructor Create(AClbProc: TPipeClbProc; APipeOutput: Cardinal);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{================================================= =============================}

constructor TPipeReadThread.Create(AClbProc: TPipeClbProc; APipeOutput: Cardinal);
begin
inherited Create(True);
fClbProc := AClbProc;
fPipeOutput := APipeOutput;
SetLength(fBuffer, 5000);
FreeOnTerminate := True;
Resume;
end;

{================================================= =============================}

procedure TPipeReadThread.Execute;
var LBufSize: Cardinal;
LRes : Boolean;
begin
LBufSize := Length(fBuffer);
repeat
LRes := ReadFile(fPipeOutput, fBuffer[1], LBufSize, fBytesRead, nil);
Synchronize(fSyncProc);
until not(LRes) or Terminated;
end;

{================================================= =============================}

procedure TPipeReadThread.FSyncProc;
begin
fClbProc(Self, fBuffer, fBytesRead);
end;

{================================================= =============================}
{================================================= =============================}
{================================================= =============================}

procedure TForm1.FClbProc(Sender: TObject; const ABuffer: String; ABufSize: Cardinal);
var LNew: String;
LPos: Integer;
begin
LNew := copy(ABuffer, 1, ABufSize);
LPos := pos(#$C, LNew);
if (LPos > 0) then
begin
MemoOutput.Text := '';
LNew := copy(LNew, LPos + 1, Length(LNew));
end;
MemoOutput.Text := MemoOutput.Text + LNew;
PostMessage(MemoOutput.Handle, WM_VSCROLL, SB_BOTTOM, 0);
end;

{================================================= =============================}

procedure TForm1.FOpenProcess;
var LStartupInfo: TStartupInfo;
LProcessInfo: TProcessInformation;
LSecurityAttr: TSECURITYATTRIBUTES;
LSecurityDesc: TSecurityDescriptor;
begin
FillChar(LSecurityDesc, SizeOf(LSecurityDesc), 0);
InitializeSecurityDescriptor(@LSecurityDesc, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(@LSecurityDesc, True, nil, False);

LSecurityAttr.nLength := SizeOf(LSecurityAttr);
LSecurityAttr.lpSecurityDescriptor := @LSecurityDesc;
LSecurityAttr.bInheritHandle := True;

fProcess := 0;
if CreatePipe(fInputPipeRead, fInputPipeWrite, @LSecurityAttr, 0) then //Input-Pipe
begin
if CreatePipe(fOutputPipeRead, fOutputPipeWrite, @LSecurityAttr, 0) then //Output-Pipe
begin
FillChar(LStartupInfo, SizeOf(LStartupInfo), 0);
FillChar(LProcessInfo, SizeOf(LProcessInfo), 0);
LStartupInfo.cb := SizeOf(LStartupInfo);
LStartupInfo.hStdOutput := fOutputPipeWrite;
LStartupInfo.hStdInput := fInputPipeRead;
LStartupInfo.hStdError := fOutputPipeWrite;
LStartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
LStartupInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, 'cmd', @LSecurityAttr, nil, True, 0, nil, nil, LStartupInfo, LProcessInfo) then
begin
fProcess := LProcessInfo.hProcess;
TPipeReadThread.Create(FClbProc, fOutputPipeRead);
end else begin
CloseHandle(fInputPipeRead);
CloseHandle(fInputPipeWrite);
CloseHandle(fOutputPipeRead);
CloseHandle(fOutputPipeWrite);
end;
end else begin
CloseHandle(fInputPipeRead);
CloseHandle(fInputPipeWrite);
end;
end
end;

{================================================= =============================}

procedure TForm1.FCloseProcess;
begin
if (fProcess <> 0) then
begin
CloseHandle(fInputPipeRead);
CloseHandle(fInputPipeWrite);
CloseHandle(fOutputPipeRead);
CloseHandle(fOutputPipeWrite);
TerminateProcess(fProcess, 0);
fProcess := 0;
end;
end;

{================================================= =============================}

procedure TForm1.FWriteToStdIn(const AText: String);
var LPos,
LWritten: Cardinal;
LRes : Boolean;
begin
LPos := 1;
repeat
LWritten := 0;
LRes := WriteFile(fInputPipeWrite, AText[LPos], Cardinal(Length(AText)) - LPos + 1, LWritten, nil);
inc(LPos, LWritten);
until not(LRes) or (LPos > Cardinal(Length(AText)));
end;

{================================================= =============================}

procedure TForm1.FormCreate(Sender: TObject);
begin
fProcess := 0;
FOpenProcess;
end;

{================================================= =============================}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FCloseProcess;
end;

{================================================= =============================}




{================================================= =============================}

procedure TForm1.Button1Click(Sender: TObject);
VAR e: INTEGER;
begin

e := ShellExecute

(Handle,

NIL,

PCHAR('C:\Dokumente und Einstellungen\Administrator\Desktop\Alarm\NEF.BAT' ),

PCHAR(''),

NIL,

SW_SHOW);

IF (e<=32) THEN

begin

ShowMessage('Fehler: Batch-Datei konnte nicht ausgeführt werden!')

end

end;

end.



batchdatei zum test ping localhost probiert mal