[delphi][code][
dp][center]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ShellAPI, ExtCtrls;
type
TForm1 = class(TForm)
MemoOutput: TMemo;
Button1: TButton;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Panel2: TPanel;
Panel3: TPanel;
Label4: TLabel;
Label5: TLabel;
Panel4: TPanel;
Label6: TLabel;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Label7: TLabel;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Button10: TButton;
Button11: TButton;
Button12: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
fInputPipeRead,
fInputPipeWrite,
fOutputPipeRead,
fOutputPipeWrite: Cardinal;
fProcess: Cardinal;
procedure FClbProc(Sender: TObject; const ABuffer: String; ABufSize: Cardinal);
procedure FOpenProcess;
procedure FCloseProcess;
{ 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.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;
procedure TForm1.Button2Click(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;
procedure TForm1.Button3Click(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;
procedure TForm1.Button4Click(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;
procedure TForm1.Button5Click(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.
so richtig zeig mir mal ein beispiel bitte