Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Code-Formatting

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-12 17:10:01 +02:00
parent ce915e503a
commit 45ff69fd92
14 changed files with 638 additions and 594 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Blockly/Delphi/BlocklyTest.dpr
+7 -7
View File
@@ -1,15 +1,15 @@
program BlocklyTest;
uses
System.StartUpCopy,
FMX.Forms,
MainUnit in 'MainUnit.pas' {MainForm},
LLVM.Runner in 'LLVM.Runner.pas';
System.StartUpCopy,
FMX.Forms,
MainUnit in 'MainUnit.pas' {MainForm},
LLVM.Runner in 'LLVM.Runner.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
Blockly/Delphi/LLVM.Runner.pas
+52 -49
View File
@@ -3,40 +3,43 @@ unit LLVM.Runner;
interface
uses
System.SysUtils, Winapi.Windows, System.Classes;
System.SysUtils,
Winapi.Windows,
System.Classes;
type
// Callback-Prozedur, die von der DLL aufgerufen wird
TLogIntegerCallback = procedure( AValue: Integer ); stdcall;
TLogIntegerCallback = procedure(AValue: Integer); stdcall;
// NEU: Typ für die Host-Additionsfunktion
THostAddIntegersCallback = function( ANum1: Integer; ANum2: Integer ): Integer; stdcall;
THostAddIntegersCallback = function(ANum1: Integer; ANum2: Integer): Integer; stdcall;
// NEUE, VEREINFACHTE Signatur der exportierten DLL-Funktion
// Jetzt nur noch der Log-Callback und der neue Integer-Input-Parameter
TStarteLogikProc = procedure(
ALogIntProc: TLogIntegerCallback;
AHostInputInteger: Integer;
AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter
); stdcall;
TStarteLogikProc =
procedure(
ALogIntProc: TLogIntegerCallback;
AHostInputInteger: Integer;
AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter
); stdcall;
type
TLLVMRunner = class
private
FModule: HMODULE;
FStarteLogik: TStarteLogikProc;
class var
FLog: TStrings;
class procedure LogInteger( AValue: Integer ); static; stdcall;
// NEU: Host-Unterprogramm-Implementierung
class function HostAddIntegers( ANum1: Integer; ANum2: Integer ): Integer; static; stdcall;
public
constructor Create(const ADLLPath: string);
destructor Destroy; override;
procedure Execute( AInputInteger: Integer );
class property Log: TStrings read FLog write FLog;
end;
TLLVMRunner = class
private
FModule: HMODULE;
FStarteLogik: TStarteLogikProc;
class var
FLog: TStrings;
class procedure LogInteger(AValue: Integer); static; stdcall;
// NEU: Host-Unterprogramm-Implementierung
class function HostAddIntegers(ANum1: Integer; ANum2: Integer): Integer; static; stdcall;
public
constructor Create(const ADLLPath: string);
destructor Destroy; override;
procedure Execute(AInputInteger: Integer);
class property Log: TStrings read FLog write FLog;
end;
implementation
{ TLLVMRunner }
@@ -44,46 +47,46 @@ implementation
constructor TLLVMRunner.Create(const ADLLPath: string);
begin
inherited Create;
FModule := LoadLibrary( PChar( ADLLPath ) );
FModule := LoadLibrary(PChar(ADLLPath));
if FModule = 0 then
raise Exception.Create( 'Failed to load DLL.' );
raise Exception.Create('Failed to load DLL.');
FStarteLogik := GetProcAddress( FModule, 'StarteLogik' );
if not Assigned( FStarteLogik ) then
raise Exception.Create( 'Procedure "StarteLogik" not found in DLL.' );
FStarteLogik := GetProcAddress(FModule, 'StarteLogik');
if not Assigned(FStarteLogik) then
raise Exception.Create('Procedure "StarteLogik" not found in DLL.');
end;
destructor TLLVMRunner.Destroy;
begin
if FModule <> 0 then
FreeLibrary( FModule );
FreeLibrary(FModule);
inherited;
end;
// NEUE Implementierung der Host-Funktion
class function TLLVMRunner.HostAddIntegers( ANum1: Integer; ANum2: Integer ): Integer;
begin
Result := ANum1 + ANum2; // Die eigentliche Logik
if Assigned(FLog) then
FLog.Add(Format('DLL hat Host-Addition angefordert: %d + %d = %d', [ANum1, ANum2, Result]));
end;
// Die Execute-Methode muss angepasst werden, um den neuen Funktionszeiger zu übergeben
procedure TLLVMRunner.Execute( AInputInteger: Integer );
begin
if Assigned( FStarteLogik ) then
FStarteLogik(
LogInteger,
AInputInteger,
HostAddIntegers // <--- Adresse der Host-Funktion übergeben
);
class function TLLVMRunner.HostAddIntegers(ANum1: Integer; ANum2: Integer): Integer;
begin
Result := ANum1 + ANum2; // Die eigentliche Logik
if Assigned(FLog) then
FLog.Add(Format('DLL hat Host-Addition angefordert: %d + %d = %d', [ANum1, ANum2, Result]));
end;
// Die Execute-Methode muss angepasst werden, um den neuen Funktionszeiger zu übergeben
procedure TLLVMRunner.Execute(AInputInteger: Integer);
begin
if Assigned(FStarteLogik) then
FStarteLogik(
LogInteger,
AInputInteger,
HostAddIntegers // <--- Adresse der Host-Funktion übergeben
);
end;
// Dies ist die Methode, die die DLL für LogInteger aufruft.
class procedure TLLVMRunner.LogInteger( AValue: Integer );
class procedure TLLVMRunner.LogInteger(AValue: Integer);
begin
if Assigned( FLog ) then
FLog.Add( Format( 'DLL logged integer: %d', [AValue] ) );
if Assigned(FLog) then
FLog.Add(Format('DLL logged integer: %d', [AValue]));
end;
// Die Implementierungen von GetCurrentDateTimeUTCHost und GetComponentInZoneHost
Blockly/Delphi/MainUnit.pas
+119 -140
View File
@@ -3,12 +3,32 @@ unit MainUnit;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.WebBrowser,
Winapi.WebView2, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Edit, FMX.StdActns,
System.SysUtils,
System.Types,
System.UITypes,
System.Classes,
System.Variants,
FMX.Types,
FMX.Controls,
FMX.Forms,
FMX.Graphics,
FMX.Dialogs,
FMX.Controls.Presentation,
FMX.StdCtrls,
FMX.WebBrowser,
Winapi.WebView2,
FMX.Memo.Types,
FMX.ScrollBox,
FMX.Memo,
FMX.Edit,
FMX.StdActns,
// FMX.Edit für TEdit, FMX.StdActns oft für Standardaktionen
// Korrekte und vollständige Units
System.IOUtils, System.Threading, System.Diagnostics, Winapi.Windows, LLVM.Runner;
System.IOUtils,
System.Threading,
System.Diagnostics,
Winapi.Windows,
LLVM.Runner;
const
// Pfad zur HTML-Datei (BITTE HIER ANPASSEN!)
@@ -19,27 +39,27 @@ const
LLD_PATH = 'lld-link.exe'; // <--- PRÜFEN UND ANPASSEN!
type
TMainForm = class( TForm )
TMainForm = class(TForm)
WebBrowser1: TWebBrowser;
SaveWorkspaceButton: TSpeedButton;
GenerateCodeButton: TSpeedButton;
Memo: TMemo;
InputEdit: TEdit; // <--- Hinzugefügt (Optional für Beschriftung des InputEdit)
procedure FormCreate( Sender: TObject );
procedure FormDestroy( Sender: TObject );
procedure RefreshButtonClick( Sender: TObject );
procedure SaveWorkspaceButtonClick( Sender: TObject );
procedure GenerateCodeButtonClick( Sender: TObject );
procedure WebBrowser1DidFinishLoad( ASender: TObject );
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure RefreshButtonClick(Sender: TObject);
procedure SaveWorkspaceButtonClick(Sender: TObject);
procedure GenerateCodeButtonClick(Sender: TObject);
procedure WebBrowser1DidFinishLoad(ASender: TObject);
private
{ Private declarations }
FWebView: ICoreWebView2;
FWebMessageReceiver: ICoreWebView2WebMessageReceivedEventHandler;
FWebMessageReceivedToken: EventRegistrationToken;
procedure HandleWebMessage( const AMessage: string );
function ExecuteProcess( const ACommand: string; const AParameters: string ): string;
procedure HandleWebMessage(const AMessage: string);
function ExecuteProcess(const ACommand: string; const AParameters: string): string;
public
{ Public declarations }
{ Public declarations }
end;
var
@@ -49,55 +69,50 @@ implementation
{$R *.fmx}
type
TWebMessageReceiver = class( TInterfacedObject, ICoreWebView2WebMessageReceivedEventHandler )
TWebMessageReceiver = class(TInterfacedObject, ICoreWebView2WebMessageReceivedEventHandler)
private
FOwner: TMainForm;
public
constructor Create( AOwner: TMainForm );
function Invoke( const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs ): HResult; stdcall;
constructor Create(AOwner: TMainForm);
function Invoke(const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs): HResult; stdcall;
end;
constructor TWebMessageReceiver.Create( AOwner: TMainForm );
constructor TWebMessageReceiver.Create(AOwner: TMainForm);
begin
inherited Create;
FOwner := AOwner;
end;
function TWebMessageReceiver.Invoke( const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs ): HResult;
function TWebMessageReceiver.Invoke(const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs): HResult;
var
message: PWideChar;
begin
Result := args.TryGetWebMessageAsString( message );
if Succeeded( Result ) then
Result := args.TryGetWebMessageAsString(message);
if Succeeded(Result) then
begin
TThread.Queue( nil,
procedure
begin
FOwner.HandleWebMessage( string( message ) );
end );
TThread.Queue(nil, procedure begin FOwner.HandleWebMessage(string(message)); end);
end;
Result := S_OK;
end;
procedure TMainForm.FormCreate( Sender: TObject );
procedure TMainForm.FormCreate(Sender: TObject);
begin
TLLVMRunner.Log := Memo.Lines;
// Optional: Standardwert für InputEdit
InputEdit.Text := '123';
end;
procedure TMainForm.FormDestroy( Sender: TObject );
procedure TMainForm.FormDestroy(Sender: TObject);
begin
TLLVMRunner.Log := nil;
if ( FWebView <> nil ) and ( FWebMessageReceivedToken.value <> 0 ) then
if (FWebView <> nil) and (FWebMessageReceivedToken.value <> 0) then
begin
FWebView.remove_WebMessageReceived( FWebMessageReceivedToken );
FWebView.remove_WebMessageReceived(FWebMessageReceivedToken);
end;
end;
function TMainForm.ExecuteProcess( const ACommand: string; const AParameters: string ): string;
function TMainForm.ExecuteProcess(const ACommand: string; const AParameters: string): string;
var
sa: TSecurityAttributes;
si: TStartupInfo;
@@ -110,63 +125,52 @@ var
output, errors: string;
begin
// Pipe für StdOut und StdErr erstellen
sa.nLength := SizeOf( TSecurityAttributes );
sa.nLength := SizeOf(TSecurityAttributes);
sa.lpSecurityDescriptor := nil;
sa.bInheritHandle := True;
// Für stdout und stderr wird dieselbe Pipe verwendet, da clang Fehler auf stdout ausgibt
if not CreatePipe( stdOutRead, stdOutWrite, @sa, 0 ) then
Exit( 'Error creating pipe.' );
if not CreatePipe(stdOutRead, stdOutWrite, @sa, 0) then
Exit('Error creating pipe.');
try
// StartupInfo vorbereiten
FillChar( si, SizeOf( TStartupInfo ), 0 );
si.cb := SizeOf( TStartupInfo );
FillChar(si, SizeOf(TStartupInfo), 0);
si.cb := SizeOf(TStartupInfo);
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE; // Fenster explizit verstecken
si.hStdInput := GetStdHandle( STD_INPUT_HANDLE );
si.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
si.hStdOutput := stdOutWrite;
si.hStdError := stdOutWrite; // Leite stderr auf dieselbe Pipe wie stdout
cmdLine := Format( '"%s" %s', [ACommand, AParameters] );
cmdLine := Format('"%s" %s', [ACommand, AParameters]);
success := CreateProcess(
nil,
PChar( cmdLine ),
nil,
nil,
True,
CREATE_NO_WINDOW,
nil,
nil,
si,
pi
);
success := CreateProcess(nil, PChar(cmdLine), nil, nil, True, CREATE_NO_WINDOW, nil, nil, si, pi);
// Schreib-Handle der Pipe sofort schließen
CloseHandle( stdOutWrite );
CloseHandle(stdOutWrite);
if not success then
Exit( Format( 'CreateProcess failed. Code: %d', [GetLastError] ) );
Exit(Format('CreateProcess failed. Code: %d', [GetLastError]));
try
output := '';
// Warten, bis der Prozess fertig ist und alle Daten in die Pipe geschrieben hat
if WaitForSingleObject( pi.hProcess, 5000 ) = WAIT_TIMEOUT then // 5s Timeout
if WaitForSingleObject(pi.hProcess, 5000) = WAIT_TIMEOUT then // 5s Timeout
begin
TerminateProcess( pi.hProcess, 1 );
Exit( 'Process timed out.' );
TerminateProcess(pi.hProcess, 1);
Exit('Process timed out.');
end;
// Bytes aus der Pipe lesen
repeat
SetLength( buffer, 1024 );
SetLength(buffer, 1024);
bytesRead := 0;
if ReadFile( stdOutRead, buffer[0], Length( buffer ), bytesRead, nil ) and ( bytesRead > 0 ) then
if ReadFile(stdOutRead, buffer[0], Length(buffer), bytesRead, nil) and (bytesRead > 0) then
begin
SetLength( buffer, bytesRead );
SetLength(buffer, bytesRead);
// Gelesene Bytes mit dem Default-System-Encoding in einen String umwandeln
output := output + TEncoding.Default.GetString( buffer );
output := output + TEncoding.Default.GetString(buffer);
end
else
begin
@@ -175,33 +179,33 @@ begin
until False;
finally
CloseHandle( pi.hProcess );
CloseHandle( pi.hThread );
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
Result := output;
finally
CloseHandle( stdOutRead );
CloseHandle(stdOutRead);
end;
end;
procedure TMainForm.RefreshButtonClick( Sender: TObject );
procedure TMainForm.RefreshButtonClick(Sender: TObject);
begin
WebBrowser1.Navigate( PATH_BLOCKLY );
WebBrowser1.Navigate(PATH_BLOCKLY);
end;
procedure TMainForm.SaveWorkspaceButtonClick( Sender: TObject );
procedure TMainForm.SaveWorkspaceButtonClick(Sender: TObject);
begin
WebBrowser1.EvaluateJavaScript( 'saveWorkspace()' );
WebBrowser1.EvaluateJavaScript('saveWorkspace()');
end;
procedure TMainForm.GenerateCodeButtonClick( Sender: TObject );
procedure TMainForm.GenerateCodeButtonClick(Sender: TObject);
begin
WebBrowser1.EvaluateJavaScript( 'generateAndPostCode()' );
WebBrowser1.EvaluateJavaScript('generateAndPostCode()');
end;
procedure TMainForm.HandleWebMessage( const AMessage: string );
procedure TMainForm.HandleWebMessage(const AMessage: string);
var
llFile, objFile, dllFile: string;
compilerOutput: string;
@@ -209,16 +213,16 @@ var
InputInteger: Integer; // <--- Hinzugefügt
begin
Memo.Lines.Clear;
Memo.Lines.Add( 'LLVM-Code empfangen. Starte Kompilierung...' );
Memo.Lines.Add( AMessage );
Memo.Lines.Add( '--------------------' );
Memo.Lines.Add('LLVM-Code empfangen. Starte Kompilierung...');
Memo.Lines.Add(AMessage);
Memo.Lines.Add('--------------------');
// Wert aus dem InputEdit-Feld holen
try
InputInteger := StrToIntDef( InputEdit.Text, 0 ); // Standardwert 0, falls ungültig
InputInteger := StrToIntDef(InputEdit.Text, 0); // Standardwert 0, falls ungültig
except
InputInteger := 0;
Memo.Lines.Add( 'WARNUNG: Ungültige Eingabe im InputEdit-Feld. Verwende 0.' );
Memo.Lines.Add('WARNUNG: Ungültige Eingabe im InputEdit-Feld. Verwende 0.');
end;
TTask.Run(
@@ -228,107 +232,82 @@ begin
compilerOutputLocal: string;
successLocal: Boolean;
begin
llFileLocal := TPath.Combine( TPath.GetTempPath, 'poc.ll' );
objFileLocal := TPath.ChangeExtension( llFileLocal, '.obj' );
dllFileLocal := TPath.ChangeExtension( llFileLocal, '.dll' );
llFileLocal := TPath.Combine(TPath.GetTempPath, 'poc.ll');
objFileLocal := TPath.ChangeExtension(llFileLocal, '.obj');
dllFileLocal := TPath.ChangeExtension(llFileLocal, '.dll');
successLocal := False;
try
TFile.WriteAllText( llFileLocal, AMessage );
TFile.WriteAllText(llFileLocal, AMessage);
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( 'Kompiliere zu Objektdatei...' );
end );
compilerOutputLocal := ExecuteProcess( CLANG_PATH, Format( '-c "%s" -o "%s"', [llFileLocal, objFileLocal] ) );
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( compilerOutputLocal );
end );
TThread.Queue(nil, procedure begin Memo.Lines.Add('Kompiliere zu Objektdatei...'); end);
compilerOutputLocal := ExecuteProcess(CLANG_PATH, Format('-c "%s" -o "%s"', [llFileLocal, objFileLocal]));
TThread.Queue(nil, procedure begin Memo.Lines.Add(compilerOutputLocal); end);
if not TFile.Exists( objFileLocal ) then
if not TFile.Exists(objFileLocal) then
begin
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( 'FEHLER: Kompilierung fehlgeschlagen. .obj-Datei nicht erstellt.' );
end );
TThread
.Queue(nil, procedure begin Memo.Lines.Add('FEHLER: Kompilierung fehlgeschlagen. .obj-Datei nicht erstellt.'); end);
Exit;
end;
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( 'Linke zu DLL...' );
end );
compilerOutputLocal := ExecuteProcess( LLD_PATH, Format( '/dll /noentry "%s" /out:"%s"', [objFileLocal, dllFileLocal] ) );
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( compilerOutputLocal );
end );
TThread.Queue(nil, procedure begin Memo.Lines.Add('Linke zu DLL...'); end);
compilerOutputLocal := ExecuteProcess(LLD_PATH, Format('/dll /noentry "%s" /out:"%s"', [objFileLocal, dllFileLocal]));
TThread.Queue(nil, procedure begin Memo.Lines.Add(compilerOutputLocal); end);
if TFile.Exists( dllFileLocal ) then
if TFile.Exists(dllFileLocal) then
begin
successLocal := True;
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( Format( 'ERFOLG: DLL wurde erstellt: %s', [dllFileLocal] ) );
end );
TThread.Queue(nil, procedure begin Memo.Lines.Add(Format('ERFOLG: DLL wurde erstellt: %s', [dllFileLocal])); end);
end
else
begin
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( 'FEHLER: Linken fehlgeschlagen. .dll-Datei nicht erstellt.' );
end );
TThread.Queue(nil, procedure begin Memo.Lines.Add('FEHLER: Linken fehlgeschlagen. .dll-Datei nicht erstellt.'); end);
end;
finally
if TFile.Exists( llFileLocal ) then
TFile.Delete( llFileLocal );
if TFile.Exists( objFileLocal ) then
TFile.Delete( objFileLocal );
if not successLocal and TFile.Exists( dllFileLocal ) then
TFile.Delete( dllFileLocal );
if TFile.Exists(llFileLocal) then
TFile.Delete(llFileLocal);
if TFile.Exists(objFileLocal) then
TFile.Delete(objFileLocal);
if not successLocal and TFile.Exists(dllFileLocal) then
TFile.Delete(dllFileLocal);
end;
TThread.Queue( nil,
TThread.Queue(
nil,
procedure
begin
Memo.Lines.Add( '---------------------------------------------------------' );
Memo.Lines.Add( 'DLL wird aufgerufen:' );
Memo.Lines.Add('---------------------------------------------------------');
Memo.Lines.Add('DLL wird aufgerufen:');
if TFile.Exists( dllFileLocal ) then
if TFile.Exists(dllFileLocal) then
begin
var
Runner := TLLVMRunner.Create( dllFileLocal );
var Runner := TLLVMRunner.Create(dllFileLocal);
try
Runner.Execute( InputInteger ); // <--- HIER DEN INPUT-PARAMETER ÜBERGEBEN
Runner.Execute(InputInteger); // <--- HIER DEN INPUT-PARAMETER ÜBERGEBEN
finally
Runner.Free;
end;
end;
Memo.Lines.Add( 'DLL beendet.' );
Memo.CaretPosition := TCaretPosition.Create( Memo.Lines.Count-1, 1 );
end );
end );
Memo.Lines.Add('DLL beendet.');
Memo.CaretPosition := TCaretPosition.Create(Memo.Lines.Count - 1, 1);
end
);
end
);
end;
procedure TMainForm.WebBrowser1DidFinishLoad( ASender: TObject );
procedure TMainForm.WebBrowser1DidFinishLoad(ASender: TObject);
begin
if Assigned( FWebMessageReceiver ) then
if Assigned(FWebMessageReceiver) then
Exit;
if Supports( WebBrowser1, ICoreWebView2, FWebView ) then
if Supports(WebBrowser1, ICoreWebView2, FWebView) then
begin
FWebMessageReceiver := TWebMessageReceiver.Create( Self );
FWebView.add_WebMessageReceived( FWebMessageReceiver, FWebMessageReceivedToken );
FWebMessageReceiver := TWebMessageReceiver.Create(Self);
FWebView.add_WebMessageReceived(FWebMessageReceiver, FWebMessageReceivedToken);
end;
end;