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\index.html'; // Pfade zu den LLVM-Werkzeugen CLANG_PATH = 'clang.exe'; LLD_PATH = 'lld-link.exe'; type TMainForm = class( TForm ) WebBrowser1: TWebBrowser; Memo: TMemo; Splitter1: TSplitter; ToolBar1: TToolBar; RefreshButton: TSpeedButton; SaveWorkspaceButton: TSpeedButton; GenerateCodeButton: TSpeedButton; 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; LauchSiteButtonClick(Self); 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: 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.