cmd fenster

[technik05]

aber bei funktoniert es nicht !!!

[Die Muhkuh]

Und was funktioniert nicht?

Du schreibst immer nur, geht nicht, wir sollen es ausbaden und Du setzt nicht mal die Delphi-Tags korrekt um Deinen Code...

[taaktaak]

... dann ein gut gemeinter Rat:

Vergiss doch für ein paar Minuten dein eigentliches Programm und beschäftige dich ausschließlich mit der Umsetzung des dsdt-Beispiels: Kopiere die Funktion "GetConsoleOutput" in ein neues Projekt, packe auf das Form einen Button und ein Memo. In das OnClick des Buttons fügst du folgenden Code ein. Der ist gegenüber dem dsdt-Beispiel etwas erweitert, damit z.B. auch Umlaute im Memo korrekt dargestellt werden:

Delphi-Quellcode:

procedure T~~.Button1Click(Sender:TObject);
var   Output,
      Errors          : TStringList;
      CmdInterpreter,
      Command         : String;

  function IsWindowsNT:Boolean;
  begin
    Result:=(Win32Platform=Ver_Platform_Win32_NT);
  end;

  function ConsoleStr2AnsiStr(ConsoleStr:String):String;
  var Buffer : pChar;
  begin
    Result:=ConsoleStr;
    GetMem(Buffer,length(ConsoleStr)+1);
    try
      OEMToCharBuff(pChar(ConsoleStr),Buffer,length(ConsoleStr));
      SetString    (Result,Buffer,length(ConsoleStr));
    finally
      FreeMem(Buffer,length(ConsoleStr)+1);
      end;
  end;

begin
  Memo1.Clear;

  Command:='dir c:\'; // <<< hier DEINEN BatchAufruf placieren!!!!!!

  if IsWindowsNT then CmdInterpreter:='cmd'
                 else CmdInterpreter:='command';

  Output:=TStringList.Create;

  try
    Errors:=TStringList.Create;
    if GetConsoleOutput(CmdInterpreter+' /c '+Command,Output,Errors) then begin
      Memo1.Lines.AddStrings(Output);
      Memo1.Text:=ConsoleStr2AnsiStr(Memo1.Text);
      end

  finally
    Output.Free;
    Errors.Free;
    end;

end;

Und wenn hier alles funktioniert, übernimmst du das Ganze in dein eigentliches Projekt!
:hi: Viel Erfolg!

[technik05]

[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

[taaktaak]

Grrr........
(hier ein Beispiel)

[hoika]

Hallo,

und formatier bitte endlich den Code!
Ich bekomme Augenkrebs ...


Heiko

[Fussball-Robby]

Zitat:

Zitat von hoika

und formatier bitte endlich den Code!
Ich bekomme Augenkrebs ...

Ich auch :shock: Und ich glaube auch nicht, dass es weiterhilft, wenn du die gesamte Unit 4 mal postest :roll:

Mfg

[technik05]

so habe ich es gemacht ! bestimmt alles falsch oder :oops:

[delphi]
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Memo1Change(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);
begin
var Output,
Errors : TStringList;
CmdInterpreter,
Command : String;

function IsWindowsNT:Boolean;
begin
Result:=(Win32Platform=Ver_Platform_Win32_NT);
end;

function ConsoleStr2AnsiStr(ConsoleStr:String):String;
var Buffer : pChar;
begin
Result:=ConsoleStr;
GetMem(Buffer,length(ConsoleStr)+1);
try
OEMToCharBuff(pChar(ConsoleStr),Buffer,length(Cons oleStr));
SetString (Result,Buffer,length(ConsoleStr));
finally
FreeMem(Buffer,length(ConsoleStr)+1);
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
Memo1.Clear;

Command:='dir c:\'; // <<< hier DEINEN BatchAufruf placieren!!!!!!

if IsWindowsNT then CmdInterpreter:='cmd'
else CmdInterpreter:='command';

Output:=TStringList.Create;

try
Errors:=TStringList.Create;
if GetConsoleOutput(CmdInterpreter+' /c '+Command,Output,Errors) then begin
Memo1.Lines.AddStrings(Output);
Memo1.Text:=ConsoleStr2AnsiStr(Memo1.Text);
end

finally
Output.Free;
Errors.Free;
end;

end.

:wall:[pre][/pre][pre]

Code:

[dp][size=8][center][/size][size=24][cl][/dp]

[/pre]

[technik05]

ich bekomme gleich auch augenkrebs was mache ich falsch

[DeddyH]

Du musst den Tag mit

Delphi-Quellcode:

 öffnen und mit

schließen.