nach langer Arbeit mit Delphi, dachte ich mir, auf eine Programmiersprache umzusteigen, die Delphi ähnlich ist, dafür aber kostenlos und ohne Einschränkungen bzg. Erstellung kommerzieller Produkte. Und da bin ich "glücklicherwiese" fündig geworden mit Lazarus.
Nun zu meinem eigentlichen Problemkind:
(im Anhang ein Bild der Form)
ich versuche gerade die Kommandozeile in mein Programm zu integrieren und "LAZARUS" wirft mir gerade mehrere Fehler aus, mit denen ich irgendwie nichts anfangen kann. Ich hatte das ganze schonmal in Delphi verwendet, ohne Probleme.
Code: Alles auswählen
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.
Das wirft mir Lazarus aus:
command.pas(55,5) Warning: Constructor should be public
command.pas(87,23) Error: Incompatible type for arg no. 1: Got "untyped", expected ""
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
).
Verein
Links
Suche