Integration der CMD

[Störtebeker]

Hi,

habe mal wieder ein Sorgenkind:
und zwar versuche ich gerade die Kommandozeile in mein Programm zu integrieren und "LAZARUS" wirft mir gerade einen Fehler aus, mit dem ich irgendwie nichts anfangen kann. Ich hatte das ganze schonmal in Delphi verwendet, ohne Probleme.

Wo liegt der Fehler:

Delphi-Quellcode:

unit command;

{$mode objfpc}{$H+}

interface

uses
  Windows, Messages, Variants, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls;

type

  { TForm11 }

  TForm11 = class(TForm)
    //Items (Button, Labels, etc.)
    //Prozeduren (Click, Create, etc.)
  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
  Form11: TForm11; 

implementation

{ TForm11 }

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);                                                     //87.23
 until not (LRes) or Terminated;
end;

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

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

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

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

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

procedure TForm11.FOpenProcess;
var
    LStartupInfo : TStartupInfo;
    LProcessInfo : TProcessInformation;
    LSecurityAttr: TSECURITYATTRIBUTES;
    LSecurityDesc: TSecurityDescriptor;
begin
    FillChar(LSecurityDesc, SizeOf(LSecurityDesc),0);                      //124.27
    InitializeSecurityDescription(@LSecurityDesc, SECURITY_DESCRIPTOR_REVISION);  //125.34
    SetSecurityDescriptorDacl(@LSecurityDesc, True, nil, False);

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

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

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

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

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

procedure TForm11.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 TForm11.FormCreate(Sender: TObject);
var rgn: HRGN;
begin
  fProcess := 0;
  FOpenProcess;
  begin
    rgn := CreateRoundRectRgn(0,
    0,
    ClientWidth,
    ClientHight,
    40,
    40);
    SetWindowRgn(Handle, rgn, True);
end;
end;

procedure TForm11.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  FCloseProcess;
end;

procedure TForm11.Button2Click(Sender: TObject);
begin
  Form11.close;
end;

procedure TForm11.Button1Click(Sender: TObject);
begin
  FWriteToStdIn(EdCmd.Text + #13#10);                 // 222.22
  EdCmd.Text := '';                                   // 223.8
end;

procedure TForm11.(Sender : TObject; var Key: Char);   //226.19
begin
if Key = #13 then
begin
Key : = #0;
BtnWriteCmdClick(nil);
end;
end; 

initialization
  {$I command.lrs}

end.

Wäre für jede Hilfe dankbar.

Hätte ich fast vergessen:

Zitat:

command.pas(55,5) Warning: Constructor should be public
command.pas(87,23) Error: Incompatible type for arg no. 1: Got "untyped", expected "<procedure variable type of procedure of object;Register>"
Hint: Found declaration: TThread.Synchronize(TThreadMethod)
command.pas(124,27) Hint: Local variable "LSecurityDesc" does not seem to be initialized
command.pas(125,34) Error: Identifier not found "InitializeSecurityDescription"
command.pas(137,26) Hint: Local variable "LStartupInfo" does not seem to be initialized
command.pas(145,100) Hint: Local variable "LProcessInfo" does not seem to be initialized
command.pas(148,37) Error: Wrong number of parameters specified for call to "FClbProc"
command.pas(100,19) Hint: Found declaration: TForm11.FClbProc(TObject,const AnsiString, LongWord)
command.pas(222,22) Error: Identifier not found "EdCmd"
command.pas(223,8) Error: Identifier not found "EdCmd"
command.pas(226,19) Fatal: Syntax error, "identifier" expected but "(" found

[mashutu]

Ich finde Deinen Code etwas schwer zu verstehen. Aber der erste Fehler ist auf jeden Fall schon mal der, dass fSyncProc ohne Parameter deklariert und implementiert ist, du rufst die procedure aber mit einem Parameter auf.
Danach geht es ans eingemachte, da die zur Verfuegung stehenden Strukturen bei Lazarus und Delphi sich in diesem Bereich stark unterscheiden.
Ich habe jetzt eine ganze Weile kein Lazarus mehr in der Hand gehabt, hatte aber an der gleichen Stelle das gleiche Problem, als ich meinen Source portiert habe.

Den Source habe ich jetzt nicht hier. Aber schau doch mal in Lazarus-Foren.