Whisper-Test
This commit is contained in:
Michael Schimmel
@@ -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.
|
||||
Reference in New Issue
Block a user