Blockly test
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,15 @@
|
||||
program BlocklyTest;
|
||||
|
||||
uses
|
||||
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;
|
||||
end.
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,68 @@
|
||||
unit LLVM.Runner;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, Winapi.Windows, System.Classes;
|
||||
|
||||
type
|
||||
// Callback-Prozedur, die von der DLL aufgerufen wird
|
||||
TLogIntegerCallback = procedure( AValue: Integer ); stdcall;
|
||||
|
||||
// Signatur der exportierten DLL-Funktion
|
||||
TStarteLogikProc = procedure( ALogCallback: TLogIntegerCallback ); stdcall;
|
||||
|
||||
type
|
||||
TLLVMRunner = class
|
||||
private
|
||||
FModule: HMODULE;
|
||||
FStarteLogik: TStarteLogikProc;
|
||||
class var
|
||||
FLog: TStrings;
|
||||
class procedure LogInteger( AValue: Integer ); static; stdcall;
|
||||
public
|
||||
constructor Create(const ADLLPath: string);
|
||||
destructor Destroy; override;
|
||||
procedure Execute;
|
||||
class property Log: TStrings read FLog write FLog;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TLLVMRunner }
|
||||
|
||||
constructor TLLVMRunner.Create(const ADLLPath: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FModule := LoadLibrary( PChar( ADLLPath ) );
|
||||
if FModule = 0 then
|
||||
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.' );
|
||||
end;
|
||||
|
||||
destructor TLLVMRunner.Destroy;
|
||||
begin
|
||||
if FModule <> 0 then
|
||||
FreeLibrary( FModule );
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TLLVMRunner.Execute;
|
||||
begin
|
||||
if Assigned( FStarteLogik ) then
|
||||
// Führe die DLL-Funktion aus und übergebe unsere Callback-Methode
|
||||
FStarteLogik( LogInteger );
|
||||
end;
|
||||
|
||||
// Dies ist die Methode, die die DLL aufruft.
|
||||
// Sie muss "static" (class procedure) sein, um eine feste Adresse zu haben.
|
||||
class procedure TLLVMRunner.LogInteger( AValue: Integer );
|
||||
begin
|
||||
if Assigned( FLOg ) then
|
||||
FLog.Add( Format( 'DLL logged integer: %d', [AValue] ) );
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,68 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 872
|
||||
ClientWidth = 1010
|
||||
FormFactor.Width = 320
|
||||
FormFactor.Height = 480
|
||||
FormFactor.Devices = [Desktop]
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
DesignerMasterStyle = 0
|
||||
object WebBrowser1: TWebBrowser
|
||||
Align = Top
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Size.Width = 1010.000000000000000000
|
||||
Size.Height = 633.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
WindowsEngine = EdgeOnly
|
||||
OnDidFinishLoad = WebBrowser1DidFinishLoad
|
||||
end
|
||||
object LauchSiteButton: TButton
|
||||
Anchors = [akLeft, akBottom]
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 744.000000000000000000
|
||||
TabOrder = 1
|
||||
Text = 'Lauch Site'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = LauchSiteButtonClick
|
||||
end
|
||||
object SaveWorkspaceButton: TButton
|
||||
Anchors = [akLeft, akBottom]
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 774.000000000000000000
|
||||
Size.Width = 97.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 2
|
||||
Text = 'Save Workspace'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = SaveWorkspaceButtonClick
|
||||
end
|
||||
object GenerateCodeButton: TButton
|
||||
Anchors = [akLeft, akBottom]
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 804.000000000000000000
|
||||
Size.Width = 97.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 3
|
||||
Text = 'Generate Code'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = GenerateCodeButtonClick
|
||||
end
|
||||
object Memo: TMemo
|
||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||
DataDetectorTypes = []
|
||||
Anchors = [akRight, akBottom]
|
||||
Position.X = 144.000000000000000000
|
||||
Position.Y = 641.000000000000000000
|
||||
Size.Width = 841.000000000000000000
|
||||
Size.Height = 223.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 4
|
||||
Viewport.Width = 837.000000000000000000
|
||||
Viewport.Height = 219.000000000000000000
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,314 @@
|
||||
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,
|
||||
// Korrekte und vollständige Units
|
||||
System.IOUtils, System.Threading, System.Diagnostics, Winapi.Windows, LLVM.Runner;
|
||||
|
||||
const
|
||||
// Pfad zur HTML-Datei
|
||||
PATH_BLOCKLY = 'T:\Myc\Blockly\blockly_LLVM.html';
|
||||
|
||||
// Pfade zu den LLVM-Werkzeugen
|
||||
CLANG_PATH = 'clang.exe';
|
||||
LLD_PATH = 'lld-link.exe';
|
||||
|
||||
type
|
||||
TMainForm = class( TForm )
|
||||
WebBrowser1: TWebBrowser;
|
||||
LauchSiteButton: TButton;
|
||||
SaveWorkspaceButton: TButton;
|
||||
GenerateCodeButton: TButton;
|
||||
Memo: TMemo;
|
||||
procedure FormCreate( Sender: TObject );
|
||||
procedure FormDestroy( Sender: TObject );
|
||||
procedure LauchSiteButtonClick( 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;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
MainForm: TMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
|
||||
type
|
||||
TWebMessageReceiver = class( TInterfacedObject, ICoreWebView2WebMessageReceivedEventHandler )
|
||||
private
|
||||
FOwner: TMainForm;
|
||||
public
|
||||
constructor Create( AOwner: TMainForm );
|
||||
function Invoke( const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs ): HResult; stdcall;
|
||||
end;
|
||||
|
||||
constructor TWebMessageReceiver.Create( AOwner: TMainForm );
|
||||
begin
|
||||
inherited Create;
|
||||
FOwner := AOwner;
|
||||
end;
|
||||
|
||||
function TWebMessageReceiver.Invoke( const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs ): HResult;
|
||||
var
|
||||
message: PWideChar;
|
||||
begin
|
||||
Result := args.TryGetWebMessageAsString( message );
|
||||
if Succeeded( Result ) then
|
||||
begin
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
FOwner.HandleWebMessage( string( message ) );
|
||||
end );
|
||||
end;
|
||||
Result := S_OK;
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormCreate( Sender: TObject );
|
||||
begin
|
||||
TLLVMRunner.Log := Memo.Lines;
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormDestroy( Sender: TObject );
|
||||
begin
|
||||
TLLVMRunner.Log := nil;
|
||||
if ( FWebView <> nil ) and ( FWebMessageReceivedToken.value <> 0 ) then
|
||||
begin
|
||||
FWebView.remove_WebMessageReceived( FWebMessageReceivedToken );
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainForm.ExecuteProcess( const ACommand: string; const AParameters: string ): string;
|
||||
var
|
||||
sa: TSecurityAttributes;
|
||||
si: TStartupInfo;
|
||||
pi: TProcessInformation;
|
||||
stdOutRead, stdOutWrite: THandle;
|
||||
success: Boolean;
|
||||
cmdLine: string;
|
||||
buffer: TBytes;
|
||||
bytesRead: Cardinal;
|
||||
output, errors: string;
|
||||
begin
|
||||
// Pipe für StdOut und StdErr erstellen
|
||||
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.' );
|
||||
|
||||
try
|
||||
// StartupInfo vorbereiten
|
||||
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.hStdOutput := stdOutWrite;
|
||||
si.hStdError := stdOutWrite; // Leite stderr auf dieselbe Pipe wie stdout
|
||||
|
||||
cmdLine := Format( '"%s" %s', [ACommand, AParameters] );
|
||||
|
||||
success := CreateProcess(
|
||||
nil,
|
||||
PChar( cmdLine ),
|
||||
nil,
|
||||
nil,
|
||||
True,
|
||||
CREATE_NO_WINDOW,
|
||||
nil,
|
||||
nil,
|
||||
si,
|
||||
pi
|
||||
);
|
||||
|
||||
// Schreib-Handle der Pipe sofort schließen
|
||||
CloseHandle( stdOutWrite );
|
||||
|
||||
if not success then
|
||||
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
|
||||
begin
|
||||
TerminateProcess( pi.hProcess, 1 );
|
||||
Exit( 'Process timed out.' );
|
||||
end;
|
||||
|
||||
// Bytes aus der Pipe lesen
|
||||
repeat
|
||||
SetLength( buffer, 1024 );
|
||||
bytesRead := 0;
|
||||
if ReadFile( stdOutRead, buffer[0], Length( buffer ), bytesRead, nil ) and ( bytesRead > 0 ) then
|
||||
begin
|
||||
SetLength( buffer, bytesRead );
|
||||
// Gelesene Bytes mit dem Default-System-Encoding in einen String umwandeln
|
||||
output := output + TEncoding.Default.GetString( buffer );
|
||||
end
|
||||
else
|
||||
begin
|
||||
break; // Pipe ist leer oder Fehler
|
||||
end;
|
||||
until False;
|
||||
|
||||
finally
|
||||
CloseHandle( pi.hProcess );
|
||||
CloseHandle( pi.hThread );
|
||||
end;
|
||||
|
||||
Result := output;
|
||||
|
||||
finally
|
||||
CloseHandle( stdOutRead );
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.LauchSiteButtonClick( Sender: TObject );
|
||||
begin
|
||||
WebBrowser1.Navigate( PATH_BLOCKLY );
|
||||
end;
|
||||
|
||||
procedure TMainForm.SaveWorkspaceButtonClick( Sender: TObject );
|
||||
begin
|
||||
WebBrowser1.EvaluateJavaScript( 'saveWorkspace()' );
|
||||
end;
|
||||
|
||||
procedure TMainForm.GenerateCodeButtonClick( Sender: TObject );
|
||||
begin
|
||||
WebBrowser1.EvaluateJavaScript( 'generateAndPostCode()' );
|
||||
end;
|
||||
|
||||
procedure TMainForm.HandleWebMessage( const AMessage: string );
|
||||
begin
|
||||
Memo.Lines.Clear;
|
||||
Memo.Lines.Add( 'LLVM-Code empfangen. Starte Kompilierung...' );
|
||||
Memo.Lines.Add( AMessage );
|
||||
Memo.Lines.Add( '--------------------' );
|
||||
|
||||
TTask.Run(
|
||||
procedure
|
||||
var
|
||||
llFile, objFile, dllFile: string;
|
||||
compilerOutput: string;
|
||||
success: Boolean;
|
||||
begin
|
||||
llFile := TPath.Combine( TPath.GetTempPath, 'poc.ll' );
|
||||
objFile := TPath.ChangeExtension( llFile, '.obj' );
|
||||
dllFile := TPath.ChangeExtension( llFile, '.dll' );
|
||||
success := False;
|
||||
|
||||
try
|
||||
TFile.WriteAllText( llFile, AMessage );
|
||||
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( 'Kompiliere zu Objektdatei...' );
|
||||
end );
|
||||
compilerOutput := ExecuteProcess( CLANG_PATH, Format( '-c "%s" -o "%s"', [llFile, objFile] ) );
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( compilerOutput );
|
||||
end );
|
||||
|
||||
if not TFile.Exists( objFile ) then
|
||||
begin
|
||||
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 );
|
||||
compilerOutput := ExecuteProcess( LLD_PATH, Format( '/dll /noentry "%s" /out:"%s"', [objFile, dllFile] ) );
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( compilerOutput );
|
||||
end );
|
||||
|
||||
if TFile.Exists( dllFile ) then
|
||||
begin
|
||||
success := True;
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( Format( 'ERFOLG: DLL wurde erstellt: %s', [dllFile] ) );
|
||||
end );
|
||||
end
|
||||
else
|
||||
begin
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( 'FEHLER: Linken fehlgeschlagen. .dll-Datei nicht erstellt.' );
|
||||
end );
|
||||
end;
|
||||
|
||||
finally
|
||||
if TFile.Exists( llFile ) then
|
||||
TFile.Delete( llFile );
|
||||
if TFile.Exists( objFile ) then
|
||||
TFile.Delete( objFile );
|
||||
if not success and TFile.Exists( dllFile ) then
|
||||
TFile.Delete( dllFile );
|
||||
end;
|
||||
|
||||
Memo.Lines.Add( '---------------------------------------------------------' );
|
||||
Memo.Lines.Add( 'DLL wird aufgerufen:' );
|
||||
|
||||
if TFile.Exists( dllFile ) then
|
||||
begin
|
||||
var
|
||||
Runner := TLLVMRunner.Create( dllFile );
|
||||
try
|
||||
Runner.Execute;
|
||||
finally
|
||||
Runner.Free;
|
||||
end;
|
||||
end;
|
||||
end );
|
||||
|
||||
Memo.Lines.Add( 'DLL beendet.' );
|
||||
end;
|
||||
|
||||
procedure TMainForm.WebBrowser1DidFinishLoad( ASender: TObject );
|
||||
begin
|
||||
if Assigned( FWebMessageReceiver ) then
|
||||
Exit;
|
||||
|
||||
if Supports( WebBrowser1, ICoreWebView2, FWebView ) then
|
||||
begin
|
||||
FWebMessageReceiver := TWebMessageReceiver.Create( Self );
|
||||
FWebView.add_WebMessageReceived( FWebMessageReceiver, FWebMessageReceivedToken );
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user