unit Myc.Api.MarkdownStream; interface uses System.SysUtils, System.Classes, System.IOUtils, System.Threading, System.Generics.Collections, System.JSON, System.Types, FMX.WebBrowser; type TBlockType = (btMarkdown, btRawText, btHtml); // Manages an incremental Markdown/HTML stream within a TWebBrowser. // Supports block-based rendering and collapsible raw text sections. IMarkdownStream = interface procedure InitializeBrowser(const Browser: TWebBrowser); procedure BeginBlock(const AType: TBlockType; const ATitle: string = ''); procedure Append(const Content: string); procedure Clear; end; TMarkdownStream = class(TInterfacedObject, IMarkdownStream) strict private type TCmd = record Func: string; Arg: string; constructor Create(const F, A: string); end; strict private FBrowser: TWebBrowser; FIsReady: Boolean; FCommandQueue: TList; FTempFileName: string; procedure OnDidFinishLoad(Sender: TObject); function GetBaseHtml: string; procedure ExecuteJS(const FunctionName, Data: string); procedure FlushQueue; function BlockTypeToString(const AType: TBlockType): string; public constructor Create; destructor Destroy; override; procedure InitializeBrowser(const Browser: TWebBrowser); procedure BeginBlock(const AType: TBlockType; const ATitle: string = ''); procedure Append(const Content: string); procedure Clear; end; implementation { TMarkdownStream.TCmd } constructor TMarkdownStream.TCmd.Create(const F, A: string); begin Func := F; Arg := A; end; { TMarkdownStream } constructor TMarkdownStream.Create; begin inherited; FCommandQueue := TList.Create; FIsReady := False; FTempFileName := TPath.Combine(TPath.GetTempPath, 'myc_md_stream.html'); end; destructor TMarkdownStream.Destroy; begin if Assigned(FBrowser) then FBrowser.OnDidFinishLoad := nil; FCommandQueue.Free; if FileExists(FTempFileName) then try TFile.Delete(FTempFileName); except end; inherited; end; procedure TMarkdownStream.InitializeBrowser(const Browser: TWebBrowser); begin FBrowser := Browser; FIsReady := False; FCommandQueue.Clear; if Assigned(FBrowser) then begin FBrowser.OnDidFinishLoad := OnDidFinishLoad; try TFile.WriteAllText(FTempFileName, GetBaseHtml, TEncoding.UTF8); FBrowser.Navigate('file://' + FTempFileName); except on E: Exception do ; end; end; end; procedure TMarkdownStream.OnDidFinishLoad(Sender: TObject); begin TThread.ForceQueue( nil, procedure begin FIsReady := True; FlushQueue; end ); end; procedure TMarkdownStream.FlushQueue; var cmd: TCmd; begin if not Assigned(FBrowser) then exit; for cmd in FCommandQueue do ExecuteJS(cmd.Func, cmd.Arg); FCommandQueue.Clear; end; function TMarkdownStream.BlockTypeToString(const AType: TBlockType): string; begin case AType of btMarkdown: Result := 'markdown'; btRawText: Result := 'text'; btHtml: Result := 'html'; end; end; procedure TMarkdownStream.BeginBlock(const AType: TBlockType; const ATitle: string); var payload: string; begin payload := BlockTypeToString(AType) + '|' + ATitle; if FIsReady then ExecuteJS('startBlock', payload) else FCommandQueue.Add(TCmd.Create('startBlock', payload)); end; procedure TMarkdownStream.Append(const Content: string); begin if Content.IsEmpty then exit; if FIsReady then ExecuteJS('appendData', Content) else FCommandQueue.Add(TCmd.Create('appendData', Content)); end; procedure TMarkdownStream.Clear; begin FCommandQueue.Clear; if FIsReady then ExecuteJS('clearAll', '') else FCommandQueue.Add(TCmd.Create('clearAll', '')); end; procedure TMarkdownStream.ExecuteJS(const FunctionName, Data: string); var jsCommand: string; jsonVal: TJSONValue; begin if not Assigned(FBrowser) then exit; // Sicherer Umgang mit leeren Daten und korrektes Escaping jsonVal := TJSONString.Create(Data); try jsCommand := Format('window.%s(%s);', [FunctionName, jsonVal.ToJSON]); try FBrowser.EvaluateJavaScript(jsCommand); except // Browser-Context evtl. während der Zerstörung nicht mehr valide end; finally jsonVal.Free; end; end; function TMarkdownStream.GetBaseHtml: string; var rs: TResourceStream; ss: TStringStream; begin // Load HTML template from embedded resource (which is Myc.Api.MarkdownStream.Base.html) rs := TResourceStream.Create(HInstance, 'BASE_HTML', RT_RCDATA); try ss := TStringStream.Create('', TEncoding.UTF8); try ss.CopyFrom(rs, 0); Result := ss.DataString; finally ss.Free; end; finally rs.Free; end; end; end.