Whisper-Test

This commit is contained in:
Michael Schimmel
2026-02-04 12:23:55 +01:00
parent 0bb8dd2084
commit ef402b867a
8 changed files with 1709 additions and 0 deletions
+2
View File
@@ -0,0 +1,2 @@
const Ionos_Token := 'eyJ0eXAiOiJKV1QiLCJraWQiOiJmNDQwYzAxNi0zNDRjLTQ3MDktOWYxYS05MjgzZjY1Yjg1OWYiLCJhbGciOiJSUzI1NiJ9.eyJpc3MiOiJpb25vc2Nsb3VkIiwiaWF0IjoxNzcwMTI2OTIxLCJjbGllbnQiOiJVU0VSIiwiaWRlbnRpdHkiOnsicmVzZWxsZXJJZCI6MSwicmVnRG9tYWluIjoiaW9ub3MuZGUiLCJyb2xlIjoib3duZXIiLCJjb250cmFjdE51bWJlciI6MzcyNzM0MjcsImlzUGFyZW50IjpmYWxzZSwicHJpdmlsZWdlcyI6WyJEQVRBX0NFTlRFUl9DUkVBVEUiLCJTTkFQU0hPVF9DUkVBVEUiLCJJUF9CTE9DS19SRVNFUlZFIiwiTUFOQUdFX0RBVEFQTEFURk9STSIsIkFDQ0VTU19BQ1RJVklUWV9MT0ciLCJQQ0NfQ1JFQVRFIiwiQUNDRVNTX1MzX09CSkVDVF9TVE9SQUdFIiwiQkFDS1VQX1VOSVRfQ1JFQVRFIiwiQ1JFQVRFX0lOVEVSTkVUX0FDQ0VTUyIsIks4U19DTFVTVEVSX0NSRUFURSIsIkZMT1dfTE9HX0NSRUFURSIsIkFDQ0VTU19BTkRfTUFOQUdFX01PTklUT1JJTkciLCJBQ0NFU1NfQU5EX01BTkFHRV9DRVJUSUZJQ0FURVMiLCJBQ0NFU1NfQU5EX01BTkFHRV9MT0dHSU5HIiwiTUFOQUdFX0RCQUFTIiwiQUNDRVNTX0FORF9NQU5BR0VfRE5TIiwiTUFOQUdFX1JFR0lTVFJZIiwiQUNDRVNTX0FORF9NQU5BR0VfQ0ROIiwiQUNDRVNTX0FORF9NQU5BR0VfVlBOIiwiQUNDRVNTX0FORF9NQU5BR0VfQVBJX0dBVEVXQVkiLCJBQ0NFU1NfQU5EX01BTkFHRV9OR1MiLCJBQ0NFU1NfQU5EX01BTkFHRV9LQUFTIiwiQUNDRVNTX0FORF9NQU5BR0VfTkVUV09SS19GSUxFX1NUT1JBR0UiLCJBQ0NFU1NfQU5EX01BTkFHRV9BSV9NT0RFTF9IVUIiLCJDUkVBVEVfTkVUV09SS19TRUNVUklUWV9HUk9VUFMiLCJBQ0NFU1NfQU5EX01BTkFHRV9JQU1fUkVTT1VSQ0VTIl0sInV1aWQiOiIwYTRlYjRhNi1hODUwLTQ0NTMtODhlYS0zYzA3YWM3NGE3ODAifSwiZXhwIjoxNzcwNzMxNzIxfQ.g6iVxzHfzgUntUmtRSCY_5L8bLXQ35TKoXyxkxpMUlP9XzpgP1-dwceJQDuJSMfROL5Yp5YpYVRbQG7ppKN2Hy_JUsR7NmXlcGP6oMFsLb4NjFf1SXB1JeScGOfCm-bCa7iCru3o25D4FruTmkCEoGzphkLkiY8iZMbIwQi6ICclcc3E8m4C2wsVhBk3EN7WOeFN023zaKBw4SxUDJvBH41slJaqvujS27wiLpOmWNdPkIXoohRWVQH_2GaHvP-t3CqadSMafZNSmihQKSYZ6biRR-LMlFP6DT4LXxHcFEKjWofB2EFsX1oANpqoL7U4DulkKhZ2shFWLVefJCE3kQ';
end;
+88
View File
@@ -0,0 +1,88 @@
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 757
ClientWidth = 771
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
DesignerMasterStyle = 0
object RecordButton: TButton
Position.X = 56.000000000000000000
Position.Y = 24.000000000000000000
Size.Width = 113.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Text = 'Record'
OnClick = RecordButtonClick
end
object LogMemo: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
Anchors = [akLeft, akTop, akRight]
Position.X = 8.000000000000000000
Position.Y = 84.000000000000000000
Size.Width = 755.000000000000000000
Size.Height = 77.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
Viewport.Width = 751.000000000000000000
Viewport.Height = 73.000000000000000000
end
object OutputMemo: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
TextSettings.WordWrap = True
Anchors = [akLeft, akTop, akRight, akBottom]
Position.X = 8.000000000000000000
Position.Y = 170.000000000000000000
Size.Width = 755.000000000000000000
Size.Height = 579.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
Viewport.Width = 751.000000000000000000
Viewport.Height = 575.000000000000000000
end
object DebugCheckBox: TCheckBox
IsChecked = True
Position.X = 176.000000000000000000
Position.Y = 57.000000000000000000
TabOrder = 3
Text = 'Debug-Ausgaben'
end
object InputMemo: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
Lines.Strings = (
'Patient, m'#228'nnlich, 64 Jahre alt, Vorstellung mit akuten retroste' +
'rnalen Schmerzen, dauerhaft seit ca. 20 Minuten, Ausstrahlung in' +
' den linken Arm, vegetative Symptomatik, Bl'#228'sse, Kaltschwei'#223'igke' +
'it, Verdacht auf akuten Myokardinfarkt, Sofortige not'#228'rztliche A' +
'larmierung und pr'#228'klinische Behandlung eingeleitet. Transport in' +
' die n'#228'chste Klinik.')
TextSettings.WordWrap = True
Anchors = [akLeft, akTop, akRight]
Position.X = 304.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 459.000000000000000000
Size.Height = 68.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
Viewport.Width = 439.000000000000000000
Viewport.Height = 64.000000000000000000
end
object LLMButton: TButton
Position.X = 56.000000000000000000
Position.Y = 54.000000000000000000
Size.Width = 112.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
Text = 'LLM'
OnClick = LLMButtonClick
end
end
+439
View File
@@ -0,0 +1,439 @@
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.
File diff suppressed because one or more lines are too long
+14
View File
@@ -0,0 +1,14 @@
program WhisperTest;
uses
System.StartUpCopy,
FMX.Forms,
WhisperMain in 'WhisperMain.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
File diff suppressed because it is too large Load Diff
Binary file not shown.
+28
View File
@@ -0,0 +1,28 @@
# MISSION
You are a highly precise Medical Scribe. Your task is Passive Medical Data Extraction. Convert STT (Speech-to-Text) transcripts into professional German medical summaries (Arztbrief-Stil).
# THE STRICTION (MANDATORY)
- LITERAL EXTRACTION ONLY: Extract only facts explicitly stated in the transcript.
- ZERO EXTERNAL KNOWLEDGE: Do NOT supplement the text with clinical guidelines, standard procedures, or medical "common sense."
- NO INFERRED NEGATIVES: Do NOT list "negative findings" (e.g., "no fever," "no pain") unless the speaker explicitly mentioned their absence.
- NO FILLERS: If a specific category (e.g., Medication) is not mentioned, use ONLY the phrase: "Im Gespräch nicht thematisiert" or "Keine Medikation erwähnt."
- VERBATIM TERMINOLOGY: Use the clinical terms provided in the text. Do not upgrade "progressive" to "extensive" unless the speaker used that specific word.
# OUTPUT STRUCTURE (German Headings)
- Anlass der Vorstellung: (Reason for visit)
- Aktuelle Anamnese: (Symptoms & history from text)
- Körperliche Untersuchung / Befunde: (Physical findings/imaging mentioned in the text)
- Diagnosen / Verdacht: (Explicitly mentioned diagnoses or suspicions)
- Therapie & Maßnahmen: (Explicitly ordered steps/interventions only)
-Medikation: (Names & dosages. If none: "Keine Medikation erwähnt.")
# NEGATIVE CONSTRAINTS (What to avoid)
- Do NOT mention "EKG" or "Physical Examination" if the transcript only talks about "Imaging."
- Do NOT list what was NOT done (e.g., "No surgery planned") if the transcript is silent on the matter.
- Do NOT assume a doctor's signature or title if not provided.
# QUALITY CHECK PROCESS
Before outputting, ask yourself: "Did the speaker say this exact word or fact?" If the answer is "I am assuming this because it's standard medical practice," DELETE IT.
# Input Transcript: