unit WhisperMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.IOUtils, FMX.Types, FMX.Controls, System.Net.Mime, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Controls.Presentation, FMX.StdCtrls, System.JSON, System.Net.HttpClient, System.Net.HttpClientComponent, FMX.Media; type TForm1 = class(TForm) RecordButton: TButton; LogMemo: TMemo; OutputMemo: TMemo; DebugCheckBox: TCheckBox; InputMemo: TMemo; LLMButton: TButton; procedure FormCreate(Sender: TObject); procedure RecordButtonClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure LLMButtonClick(Sender: TObject); private FCapture: TAudioCaptureDevice; FIsRecording: Boolean; FTempCapturePath: string; procedure Log(const Msg: string); procedure LogDebug(const Msg: string); procedure SendToWhisperAsync(const SourceFile: string); procedure QueryLLM(const UserInput: string); procedure StartCapture; procedure StopCapture; public end; var Form1: TForm1; implementation {$R *.fmx} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin FIsRecording := False; RecordButton.Text := 'Start Recording'; end; procedure TForm1.Log(const Msg: string); begin TThread.Queue(nil, procedure begin LogMemo.Lines.Add(FormatDateTime('hh:nn:ss.zzz', Now) + ': ' + Msg); LogMemo.GoToTextEnd; end); end; procedure TForm1.LogDebug(const Msg: string); begin if not DebugCheckBox.IsChecked then exit; TThread.Queue(nil, procedure begin LogMemo.Lines.Add(FormatDateTime('hh:nn:ss.zzz', Now) + ' [DEBUG]: ' + Msg); LogMemo.GoToTextEnd; end); end; procedure TForm1.StartCapture; var guid: TGUID; begin if FIsRecording then exit; FCapture := TCaptureDeviceManager.Current.DefaultAudioCaptureDevice; if not Assigned(FCapture) then begin Log('Error: No Microphone found.'); exit; end; // Unique filename via GUID to prevent "File in use" errors if CreateGUID(guid) = S_OK then FTempCapturePath := TPath.Combine(TPath.GetTempPath, 'whisper_' + GUIDToString(guid) + '.wav') else FTempCapturePath := TPath.Combine(TPath.GetTempPath, 'whisper_' + GetTickCount64.ToString + '.wav'); FCapture.FileName := FTempCapturePath; try FCapture.StartCapture; FIsRecording := True; RecordButton.Text := 'Stop Recording'; Log('Recording started...'); LogDebug('Capture path: ' + FTempCapturePath); except on E: Exception do Log('Error starting capture: ' + E.Message); end; end; procedure TForm1.StopCapture; begin if not FIsRecording then exit; if Assigned(FCapture) then begin FCapture.StopCapture; FIsRecording := False; RecordButton.Text := 'Start Recording'; LogDebug('Capture stopped.'); end; end; procedure TForm1.RecordButtonClick(Sender: TObject); begin if not FIsRecording then StartCapture else begin StopCapture; if TFile.Exists(FTempCapturePath) then begin // Button sofort sperren und Status anzeigen RecordButton.Enabled := False; RecordButton.Text := 'Uploading...'; SendToWhisperAsync(FTempCapturePath); end else begin Log('Error: Capture file not found.'); RecordButton.Enabled := True; RecordButton.Text := 'Start Recording'; end; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin if FIsRecording then StopCapture; end; procedure TForm1.LLMButtonClick(Sender: TObject); var UserText: string; begin UserText := InputMemo.Text.Trim; if UserText.IsEmpty then exit; // UI Update immediate InputMemo.Lines.Clear; OutputMemo.Lines.Add('Me: ' + UserText); // Call API in background thread to avoid freezing the UI TThread.CreateAnonymousThread( procedure begin QueryLLM(UserText); end).Start; end; procedure TForm1.SendToWhisperAsync(const SourceFile: string); begin TThread.CreateAnonymousThread( procedure var client: TNetHTTPClient; formData: TMultipartFormData; resp: IHTTPResponse; jsonResp, jsonResult: TJSONObject; taskID, status, transcriptionText: string; url: string; isDone: Boolean; resVal, segmentsVal: TJSONValue; segmentsArray: TJSONArray; segmentObj: TJSONObject; i: Integer; sText: string; begin client := TNetHTTPClient.Create(nil); formData := TMultipartFormData.Create; try try url := 'http://minerva.lan:8000/service/transcribe?language=de&model=large-v3&device=cuda'; formData.AddFile('file', SourceFile); resp := client.Post(url, formData); if resp.StatusCode = 200 then begin jsonResp := TJSONObject.ParseJSONValue(resp.ContentAsString(TEncoding.UTF8)) as TJSONObject; if Assigned(jsonResp) and jsonResp.TryGetValue('identifier', taskID) then begin isDone := False; transcriptionText := ''; // UI Update via Queue TThread.Queue(nil, procedure begin RecordButton.Text := 'Transcribing...'; end); repeat TThread.Sleep(500); try resp := client.Get('http://minerva.lan:8000/task/' + taskID); if resp.StatusCode = 200 then begin jsonResult := TJSONObject.ParseJSONValue(resp.ContentAsString(TEncoding.UTF8)) as TJSONObject; if Assigned(jsonResult) then try jsonResult.TryGetValue('status', status); if status = 'completed' then begin resVal := jsonResult.GetValue('result'); if (resVal is TJSONObject) and TJSONObject(resVal).TryGetValue('segments', segmentsVal) then begin segmentsArray := segmentsVal as TJSONArray; for i := 0 to segmentsArray.Count - 1 do begin segmentObj := segmentsArray.Items[i] as TJSONObject; if segmentObj.TryGetValue('text', sText) then transcriptionText := transcriptionText + sText; end; end; isDone := True; end else if (status = 'failed') or (status = 'error') then isDone := True; finally jsonResult.Free; end; end; except on E: Exception do isDone := True; // Exit on polling error end; until isDone; if transcriptionText <> '' then begin transcriptionText := transcriptionText.Trim; // NEW: Put result into InputMemo instead of sending directly TThread.Queue(nil, procedure begin if InputMemo.Text.IsEmpty then InputMemo.Text := transcriptionText else InputMemo.Text := InputMemo.Text + ' ' + transcriptionText; end); end; end; if Assigned(jsonResp) then jsonResp.Free; end else Log('WhisperX Error (' + resp.StatusCode.ToString + '): ' + resp.StatusText); except on E: Exception do Log('API Exception: ' + E.Message); end; finally formData.Free; client.Free; if TFile.Exists(SourceFile) then TFile.Delete(SourceFile); // Button unter allen Umstaenden reaktivieren TThread.Queue(nil, procedure begin RecordButton.Text := 'Start Recording'; RecordButton.Enabled := True; end); end; end).Start; end; procedure TForm1.QueryLLM(const UserInput: string); var client: TNetHTTPClient; reqBody: TStringStream; reqJson, msgObj: TJSONObject; msgs: TJSONArray; resp: IHTTPResponse; respJson, messageObj: TJSONObject; choices: TJSONArray; choiceItem: TJSONObject; content, refusal, reasoning, systemPrompt, promptPath, token, rawResponse: string; tokenPath: string; finishReason: string; begin // Load Token from Environment token := GetEnvironmentVariable('IONOS_JWT'); if token.IsEmpty then begin // Fallback: try to load from "Token.txt" in application directory // tokenPath := TPath.Combine(ExtractFilePath(ParamStr(0)), 'Token.txt'); tokenPath := 'C:\Users\Brummel\Downloads\f440c016-344c-4709-9f1a-9283f65b859f.txt'; if TFile.Exists(tokenPath) then begin token := TFile.ReadAllText(tokenPath, TEncoding.UTF8).Trim; end; if token.IsEmpty then begin Log('Error: IONOS_JWT environment variable not set and Token.txt missing or empty.'); exit; end; end; promptPath := TPath.Combine(ExtractFilePath(ParamStr(0)), '..\..\Prompt.md'); if TFile.Exists(promptPath) then systemPrompt := TFile.ReadAllText(promptPath, TEncoding.UTF8) else systemPrompt := 'You are a helpful assistant.'; client := TNetHTTPClient.Create(nil); reqJson := TJSONObject.Create; try // Set Headers client.ContentType := 'application/json'; client.CustomHeaders['Authorization'] := 'Bearer ' + token; // Build Request reqJson.AddPair('model', 'openai/gpt-oss-120b'); reqJson.AddPair('temperature', TJSONNumber.Create(0.6)); // Slightly lower temp for better adherence // FIX: Increased token limit to allow reasoning + content reqJson.AddPair('max_completion_tokens', TJSONNumber.Create(2048)); msgs := TJSONArray.Create; msgObj := TJSONObject.Create; msgObj.AddPair('role', 'system'); msgObj.AddPair('content', systemPrompt); msgs.Add(msgObj); msgObj := TJSONObject.Create; msgObj.AddPair('role', 'user'); msgObj.AddPair('content', UserInput); msgs.Add(msgObj); reqJson.AddPair('messages', msgs); reqBody := TStringStream.Create(reqJson.ToJSON, TEncoding.UTF8); try // Log Request for debugging LogDebug('Sending Request to IONOS...'); resp := client.Post('https://openai.inference.de-txl.ionos.com/v1/chat/completions', reqBody); rawResponse := resp.ContentAsString(TEncoding.UTF8); if resp.StatusCode = 200 then begin // Log the full raw JSON to see exactly what is returned LogDebug('Raw JSON Response: ' + rawResponse); respJson := TJSONObject.ParseJSONValue(rawResponse) as TJSONObject; if Assigned(respJson) then try // 1. Check for 'choices' array choices := respJson.GetValue('choices') as TJSONArray; if (Assigned(choices)) and (choices.Count > 0) then begin choiceItem := choices.Items[0] as TJSONObject; // Check finish_reason for debugging if choiceItem.TryGetValue('finish_reason', finishReason) then begin if finishReason = 'length' then Log('Warning: Output truncated (Token limit reached).'); end; // 2. Check for 'message' object inside choice messageObj := choiceItem.GetValue('message') as TJSONObject; if Assigned(messageObj) then begin // 3. Try to get 'content' // Handle explicit null or missing content if messageObj.TryGetValue('content', content) and (content <> '') then begin TThread.Queue(nil, procedure begin OutputMemo.Lines.Add('IONOS: ' + content); end); end // 4. Fallback: Check for 'refusal' else if messageObj.TryGetValue('refusal', refusal) and (refusal <> '') then begin Log('Model Refusal: ' + refusal); TThread.Queue(nil, procedure begin OutputMemo.Lines.Add('IONOS [Refusal]: ' + refusal); end); end // 5. Emergency Fallback: If content is null but reasoning exists (Token limit edge case) else if messageObj.TryGetValue('reasoning', reasoning) then begin Log('Error: Content is empty, but reasoning was found. Token limit likely too low.'); TThread.Queue(nil, procedure begin OutputMemo.Lines.Add('IONOS [Incomplete - Reasoning Only]: ' + reasoning); end); end else begin Log('Error: Message object has neither content, refusal nor reasoning.'); end; end else begin Log('Error: No "message" object found in first choice.'); end; end else begin Log('Error: "choices" array is missing or empty.'); end; finally respJson.Free; end else begin Log('Error: Failed to parse JSON response.'); end; end else begin Log('IONOS HTTP Error (' + resp.StatusCode.ToString + '): ' + resp.StatusText); LogDebug('Error Body: ' + rawResponse); end; finally reqBody.Free; end; finally reqJson.Free; client.Free; end; end; end.