Gemini Test
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,16 @@
|
||||
program GeminiTest;
|
||||
|
||||
uses
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
MainUnit in 'MainUnit.pas' {Form1},
|
||||
Myc.Api.Gemini in 'Myc.Api.Gemini.pas',
|
||||
Myc.System.Quota in 'Myc.System.Quota.pas';
|
||||
|
||||
{$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.
@@ -0,0 +1,187 @@
|
||||
object Form1: TForm1
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 708
|
||||
ClientWidth = 906
|
||||
FormFactor.Width = 320
|
||||
FormFactor.Height = 480
|
||||
FormFactor.Devices = [Desktop]
|
||||
OnCreate = FormCreate
|
||||
DesignerMasterStyle = 0
|
||||
object AskButton: TButton
|
||||
Anchors = [akRight, akBottom]
|
||||
Position.X = 800.000000000000000000
|
||||
Position.Y = 577.000000000000000000
|
||||
TabOrder = 1
|
||||
Text = 'Ask'
|
||||
OnClick = AskButtonClick
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
Anchors = [akLeft, akBottom]
|
||||
TabOrder = 2
|
||||
Text = 'AIzaSyBiWN55O-lI36EXcBeqf_cne4jAzxNsfbg'
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 678.000000000000000000
|
||||
Size.Width = 145.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = Edit1Exit
|
||||
end
|
||||
object ModelsComboBox: TComboBox
|
||||
Anchors = [akLeft, akBottom]
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 577.000000000000000000
|
||||
Size.Width = 193.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 3
|
||||
end
|
||||
object AskMemo: TMemo
|
||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||
DataDetectorTypes = []
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
Position.X = 224.000000000000000000
|
||||
Position.Y = 577.000000000000000000
|
||||
Size.Width = 568.000000000000000000
|
||||
Size.Height = 123.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 5
|
||||
Viewport.Width = 564.000000000000000000
|
||||
Viewport.Height = 119.000000000000000000
|
||||
end
|
||||
object ResetChatButton: TButton
|
||||
Anchors = [akRight, akBottom]
|
||||
Position.X = 800.000000000000000000
|
||||
Position.Y = 645.000000000000000000
|
||||
TabOrder = 6
|
||||
Text = 'Reset'
|
||||
OnClick = ResetChatButtonClick
|
||||
end
|
||||
object TabControl1: TTabControl
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Size.Width = 906.000000000000000000
|
||||
Size.Height = 561.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabIndex = 0
|
||||
TabOrder = 7
|
||||
TabPosition = PlatformDefault
|
||||
Sizes = (
|
||||
906s
|
||||
535s
|
||||
906s
|
||||
535s
|
||||
906s
|
||||
535s)
|
||||
object ChatTabItem: TTabItem
|
||||
CustomIcon = <
|
||||
item
|
||||
end>
|
||||
IsSelected = True
|
||||
Size.Width = 45.000000000000000000
|
||||
Size.Height = 26.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
StyleLookup = ''
|
||||
TabOrder = 0
|
||||
Text = 'Chat'
|
||||
object ChatMemo: TMemo
|
||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||
DataDetectorTypes = []
|
||||
Align = Client
|
||||
Size.Width = 906.000000000000000000
|
||||
Size.Height = 535.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 1
|
||||
Viewport.Width = 902.000000000000000000
|
||||
Viewport.Height = 531.000000000000000000
|
||||
end
|
||||
end
|
||||
object CacheTabItem: TTabItem
|
||||
CustomIcon = <
|
||||
item
|
||||
end>
|
||||
IsSelected = False
|
||||
Size.Width = 53.000000000000000000
|
||||
Size.Height = 26.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
StyleLookup = ''
|
||||
TabOrder = 0
|
||||
Text = 'Cache'
|
||||
object CacheMemo: TMemo
|
||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||
DataDetectorTypes = []
|
||||
Align = Client
|
||||
Size.Width = 906.000000000000000000
|
||||
Size.Height = 535.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 1
|
||||
Viewport.Width = 902.000000000000000000
|
||||
Viewport.Height = 531.000000000000000000
|
||||
end
|
||||
end
|
||||
object SysInstrTabItem: TTabItem
|
||||
CustomIcon = <
|
||||
item
|
||||
end>
|
||||
IsSelected = False
|
||||
Size.Width = 61.000000000000000000
|
||||
Size.Height = 26.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
StyleLookup = ''
|
||||
TabOrder = 0
|
||||
Text = 'SysInstr'
|
||||
object SystemInstructionMemo: TMemo
|
||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||
DataDetectorTypes = []
|
||||
TextSettings.WordWrap = True
|
||||
Align = Client
|
||||
Size.Width = 906.000000000000000000
|
||||
Size.Height = 535.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 1
|
||||
Viewport.Width = 902.000000000000000000
|
||||
Viewport.Height = 531.000000000000000000
|
||||
end
|
||||
end
|
||||
end
|
||||
object UploadCacheButton: TButton
|
||||
Anchors = [akRight, akBottom]
|
||||
Position.X = 800.000000000000000000
|
||||
Position.Y = 675.000000000000000000
|
||||
TabOrder = 0
|
||||
Text = 'Upload'
|
||||
OnClick = UploadCacheButtonClick
|
||||
end
|
||||
object ThinkingCheckBox: TCheckBox
|
||||
Anchors = [akRight, akBottom]
|
||||
Position.X = 800.000000000000000000
|
||||
Position.Y = 607.000000000000000000
|
||||
Size.Width = 88.000000000000000000
|
||||
Size.Height = 19.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 8
|
||||
Text = 'Thinking'
|
||||
end
|
||||
object GlobalQuoteLabel: TLabel
|
||||
Anchors = [akLeft, akBottom]
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 608.000000000000000000
|
||||
Size.Width = 193.000000000000000000
|
||||
Size.Height = 17.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
Text = 'Global Quota: 0'
|
||||
TabOrder = 9
|
||||
end
|
||||
object QuotaLabel: TLabel
|
||||
Anchors = [akRight, akBottom]
|
||||
Position.X = 704.000000000000000000
|
||||
Position.Y = 537.000000000000000000
|
||||
Size.Width = 194.000000000000000000
|
||||
Size.Height = 16.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TextSettings.HorzAlign = Trailing
|
||||
Text = 'in/out'
|
||||
TabOrder = 4
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,347 @@
|
||||
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.Memo.Types,
|
||||
FMX.ScrollBox,
|
||||
FMX.Memo,
|
||||
FMX.Controls.Presentation,
|
||||
FMX.StdCtrls,
|
||||
FMX.Edit,
|
||||
FMX.ListBox,
|
||||
Myc.Api.Gemini,
|
||||
FMX.TabControl;
|
||||
|
||||
type
|
||||
TForm1 = class(TForm)
|
||||
AskButton: TButton;
|
||||
Edit1: TEdit;
|
||||
ModelsComboBox: TComboBox;
|
||||
QuotaLabel: TLabel;
|
||||
AskMemo: TMemo;
|
||||
ResetChatButton: TButton;
|
||||
TabControl1: TTabControl;
|
||||
ChatTabItem: TTabItem;
|
||||
CacheTabItem: TTabItem;
|
||||
SysInstrTabItem: TTabItem;
|
||||
ChatMemo: TMemo;
|
||||
CacheMemo: TMemo;
|
||||
SystemInstructionMemo: TMemo;
|
||||
UploadCacheButton: TButton;
|
||||
ThinkingCheckBox: TCheckBox;
|
||||
GlobalQuoteLabel: TLabel;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure AskButtonClick(Sender: TObject);
|
||||
procedure Edit1Exit(Sender: TObject);
|
||||
procedure ResetChatButtonClick(Sender: TObject);
|
||||
procedure UploadCacheButtonClick(Sender: TObject);
|
||||
private
|
||||
FChat: IGeminiChat;
|
||||
// Holds the client configured with the active cache
|
||||
FCachedClient: IGeminiClient;
|
||||
procedure InitChat;
|
||||
procedure UpdateQuotaDisplay;
|
||||
public
|
||||
procedure GetAvailableModels;
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Threading,
|
||||
Myc.System.Quota; // Einbindung für den globalen Zähler
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
const
|
||||
FallbackModel = 'gemini-3-flash-preview';
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
// Load default instructions if file exists
|
||||
if FileExists('T:\Myc\KI\gemini.md') then
|
||||
SystemInstructionMemo.Lines.LoadFromFile('T:\Myc\KI\gemini.md', TEncoding.UTF8);
|
||||
|
||||
// Initialen Global-Stand anzeigen
|
||||
UpdateQuotaDisplay;
|
||||
|
||||
GetAvailableModels;
|
||||
InitChat;
|
||||
end;
|
||||
|
||||
procedure TForm1.InitChat;
|
||||
begin
|
||||
if Assigned(FCachedClient) then
|
||||
begin
|
||||
FChat := FCachedClient.StartChat;
|
||||
ChatMemo.Lines.Add('--- New Chat Session (Cached Content Active) ---');
|
||||
end
|
||||
else
|
||||
begin
|
||||
FChat := nil; // Lazy init in AskButton
|
||||
ChatMemo.Lines.Add('--- New Chat Session ---');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.ResetChatButtonClick(Sender: TObject);
|
||||
begin
|
||||
InitChat;
|
||||
end;
|
||||
|
||||
procedure TForm1.UpdateQuotaDisplay;
|
||||
begin
|
||||
GlobalQuoteLabel.Text := 'Total: ' + TGlobalQuota.GetTotal.ToString + ', Today: ' + TGlobalQuota.GetDailyTotal.ToString;
|
||||
end;
|
||||
|
||||
procedure TForm1.AskButtonClick(Sender: TObject);
|
||||
var
|
||||
apiKey: string;
|
||||
modelName: string;
|
||||
prompt: string;
|
||||
begin
|
||||
apiKey := Edit1.Text;
|
||||
prompt := AskMemo.Text;
|
||||
|
||||
if ModelsComboBox.ItemIndex > -1 then
|
||||
modelName := ModelsComboBox.Items[ModelsComboBox.ItemIndex]
|
||||
else
|
||||
modelName := FallbackModel;
|
||||
|
||||
// --- LAZY INIT ---
|
||||
if FChat = nil then
|
||||
begin
|
||||
var client: IGeminiClient := TGeminiClient.Create(apiKey, modelName);
|
||||
|
||||
// 1. System Instructions (Ohne Hack, purer Text)
|
||||
if not SystemInstructionMemo.Text.Trim.IsEmpty then
|
||||
client.SystemInstruction := SystemInstructionMemo.Text;
|
||||
|
||||
// 2. Native Thinking aktivieren
|
||||
// Die API-Unit entscheidet, ob das Modell es unterstützt.
|
||||
// Falls ja, wird der 'thinking' Parameter gesendet.
|
||||
client.EnableThinking := ThinkingCheckBox.IsChecked;
|
||||
|
||||
FChat := client.StartChat;
|
||||
end;
|
||||
|
||||
AskButton.Enabled := False;
|
||||
ChatMemo.Lines.Add(sLineBreak + 'User: "' + prompt + '"');
|
||||
ChatMemo.Lines.Add('Gemini: ');
|
||||
AskMemo.Text := '';
|
||||
|
||||
TTask.Run(
|
||||
procedure
|
||||
var
|
||||
CurrentChat: IGeminiChat;
|
||||
resultData: TGeminiResult;
|
||||
begin
|
||||
CurrentChat := FChat;
|
||||
if CurrentChat = nil then
|
||||
exit;
|
||||
|
||||
// --- STREAMING ---
|
||||
resultData :=
|
||||
CurrentChat.SendMessageStream(
|
||||
prompt,
|
||||
procedure(const TextChunk: string; IsThought: Boolean)
|
||||
begin
|
||||
TThread.Queue(
|
||||
nil,
|
||||
procedure
|
||||
begin
|
||||
if IsThought then
|
||||
begin
|
||||
// Visuelle Kennzeichnung für Gedanken
|
||||
// (Hier einfach in eckigen Klammern, besser wäre Farbe)
|
||||
ChatMemo.Text := ChatMemo.Text + ' [Think: ' + TextChunk + '] ';
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Normale Antwort
|
||||
ChatMemo.Text := ChatMemo.Text + TextChunk;
|
||||
end;
|
||||
|
||||
ChatMemo.GoToTextEnd;
|
||||
end
|
||||
);
|
||||
end
|
||||
);
|
||||
|
||||
// Abschluss im Main Thread
|
||||
TThread.Queue(
|
||||
nil,
|
||||
procedure
|
||||
begin
|
||||
if resultData.Text.StartsWith('Error') then
|
||||
ChatMemo.Lines.Add(resultData.Text);
|
||||
|
||||
// Update Labels (Session & Global Registry)
|
||||
QuotaLabel.Text := Format('Input: %d | Output: %d', [resultData.Usage.PromptTokens, resultData.Usage.CandidatesTokens]);
|
||||
UpdateQuotaDisplay;
|
||||
|
||||
AskButton.Enabled := True;
|
||||
end
|
||||
);
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TForm1.Edit1Exit(Sender: TObject);
|
||||
begin
|
||||
GetAvailableModels;
|
||||
end;
|
||||
|
||||
procedure TForm1.GetAvailableModels;
|
||||
var
|
||||
apiKey: string;
|
||||
begin
|
||||
apiKey := Edit1.Text.Trim;
|
||||
if apiKey.IsEmpty then
|
||||
exit;
|
||||
|
||||
ChatMemo.Lines.Add('Fetching available models...');
|
||||
|
||||
TTask.Run(
|
||||
procedure
|
||||
var
|
||||
client: IGeminiClient;
|
||||
modelList: TArray<string>;
|
||||
begin
|
||||
client := TGeminiClient.Create(apiKey);
|
||||
modelList := client.ListModels;
|
||||
|
||||
TThread.Queue(
|
||||
nil,
|
||||
procedure
|
||||
var
|
||||
mName: string;
|
||||
begin
|
||||
if Length(modelList) = 0 then
|
||||
begin
|
||||
ChatMemo.Lines.Add('No models found.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
ModelsComboBox.BeginUpdate;
|
||||
try
|
||||
ModelsComboBox.Items.Clear;
|
||||
|
||||
for mName in modelList do
|
||||
ModelsComboBox.Items.Add(mName);
|
||||
|
||||
// Versuche Fallback zu finden (ggf. ohne Emoji suffix match)
|
||||
// Vereinfacht: Wähle ersten Index
|
||||
if ModelsComboBox.Items.Count > 0 then
|
||||
begin
|
||||
ModelsComboBox.ItemIndex := ModelsComboBox.Items.IndexOf(FallbackModel);
|
||||
if ModelsComboBox.ItemIndex < 0 then
|
||||
ModelsComboBox.ItemIndex := 0;
|
||||
end;
|
||||
|
||||
ChatMemo.Lines.Add(Format('Loaded %d models.', [Length(modelList)]));
|
||||
finally
|
||||
ModelsComboBox.EndUpdate;
|
||||
end;
|
||||
end
|
||||
);
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TForm1.UploadCacheButtonClick(Sender: TObject);
|
||||
var
|
||||
apiKey: string;
|
||||
content: string;
|
||||
sysInstr: string;
|
||||
modelName: string;
|
||||
begin
|
||||
apiKey := Edit1.Text;
|
||||
content := CacheMemo.Text;
|
||||
|
||||
// Keine künstlichen Prompts mehr, nur die reinen Instruktionen
|
||||
sysInstr := SystemInstructionMemo.Text;
|
||||
|
||||
if content.Trim.IsEmpty then
|
||||
begin
|
||||
ChatMemo.Lines.Add('Error: Cache content is empty.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
// Remove Emoji suffix if present from ComboBox for API call
|
||||
if ModelsComboBox.ItemIndex > -1 then
|
||||
modelName := ModelsComboBox.Items[ModelsComboBox.ItemIndex].Split([' '])[0]
|
||||
else
|
||||
modelName := FallbackModel;
|
||||
|
||||
UploadCacheButton.Enabled := False;
|
||||
ChatMemo.Lines.Add('Creating Cache (this may take a moment)...');
|
||||
|
||||
TTask.Run(
|
||||
procedure
|
||||
var
|
||||
client: IGeminiClient;
|
||||
cacheName: string;
|
||||
errMsg: string;
|
||||
begin
|
||||
try
|
||||
// 1. Client erstellen
|
||||
client := TGeminiClient.Create(apiKey, modelName);
|
||||
|
||||
// 2. Cache erstellen (Content + SysInstr)
|
||||
// Hinweis: Native Thinking ist ein Parameter der GENERIERUNG, nicht des Caches.
|
||||
// Daher laden wir den Cache "neutral" hoch.
|
||||
cacheName := client.CreateCache(content, sysInstr, 300);
|
||||
|
||||
// 3. Cache aktivieren
|
||||
client.ActiveCacheName := cacheName;
|
||||
|
||||
// 4. Client speichern
|
||||
// Wenn der User später "Ask" klickt, wird dort EnableThinking gesetzt
|
||||
FCachedClient := client;
|
||||
|
||||
TThread.Queue(
|
||||
nil,
|
||||
procedure
|
||||
begin
|
||||
ChatMemo.Lines.Add('Success: Cache created!');
|
||||
ChatMemo.Lines.Add('ID: ' + cacheName);
|
||||
|
||||
InitChat;
|
||||
UploadCacheButton.Enabled := True;
|
||||
end
|
||||
);
|
||||
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
errMsg := E.Message;
|
||||
TThread.Queue(
|
||||
nil,
|
||||
procedure
|
||||
begin
|
||||
ChatMemo.Lines.Add('Cache Upload Failed:');
|
||||
ChatMemo.Lines.Add(errMsg);
|
||||
UploadCacheButton.Enabled := True;
|
||||
end
|
||||
);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,822 @@
|
||||
unit Myc.Api.Gemini;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Net.HttpClient,
|
||||
System.Net.Mime,
|
||||
System.JSON,
|
||||
System.NetEncoding,
|
||||
System.Generics.Collections,
|
||||
System.SyncObjs,
|
||||
Myc.System.Quota; // Einbindung der Global Quota Unit
|
||||
|
||||
type
|
||||
// Represents usage statistics for a request
|
||||
TGeminiUsage = record
|
||||
PromptTokens: Integer;
|
||||
CandidatesTokens: Integer;
|
||||
TotalTokens: Integer;
|
||||
end;
|
||||
|
||||
// Represents the result of a generation request
|
||||
TGeminiResult = record
|
||||
Text: string;
|
||||
IsThought: Boolean; // True if this part contains reasoning/thoughts
|
||||
Usage: TGeminiUsage;
|
||||
end;
|
||||
|
||||
TChatRole = (User, Model);
|
||||
|
||||
TChatItem = record
|
||||
Role: TChatRole;
|
||||
Text: string;
|
||||
end;
|
||||
|
||||
// Callback for streaming: provides the new text delta and thought flag
|
||||
TStreamCallback = reference to procedure(const TextDelta: string; IsThought: Boolean);
|
||||
|
||||
// Interface for a chat session (maintains history)
|
||||
IGeminiChat = interface
|
||||
['{5C2F64C8-4D18-47C0-9513-332715053673}']
|
||||
function SendMessage(const Text: string): TGeminiResult;
|
||||
function SendMessageStream(const Text: string; const OnDelta: TStreamCallback): TGeminiResult;
|
||||
function GetHistory: TArray<TChatItem>;
|
||||
end;
|
||||
|
||||
// Interface for the API Client
|
||||
IGeminiClient = interface
|
||||
['{E6721670-3498-4660-848D-82F3B1A2B5E2}']
|
||||
// Standard Generation
|
||||
function GenerateContent(const Prompt: string): TGeminiResult; overload;
|
||||
function GenerateContent(const History: TArray<TChatItem>): TGeminiResult; overload;
|
||||
|
||||
// Streaming Generation
|
||||
function GenerateContentStream(const Prompt: string; const OnDelta: TStreamCallback): TGeminiResult; overload;
|
||||
function GenerateContentStream(const History: TArray<TChatItem>; const OnDelta: TStreamCallback): TGeminiResult; overload;
|
||||
|
||||
// Utilities
|
||||
function ListModels: TArray<string>;
|
||||
function StartChat: IGeminiChat;
|
||||
|
||||
// Context Caching
|
||||
function CreateCache(const Content: string; const SysInstructions: string; const TTLSeconds: Integer = 300): string;
|
||||
procedure SetActiveCache(const CacheName: string);
|
||||
function GetActiveCache: string;
|
||||
|
||||
// Configuration
|
||||
procedure SetSystemInstruction(const Value: string);
|
||||
function GetSystemInstruction: string;
|
||||
|
||||
// Native Thinking / Reasoning
|
||||
procedure SetEnableThinking(const Value: Boolean);
|
||||
function GetEnableThinking: Boolean;
|
||||
|
||||
property ActiveCacheName: string read GetActiveCache write SetActiveCache;
|
||||
property SystemInstruction: string read GetSystemInstruction write SetSystemInstruction;
|
||||
property EnableThinking: Boolean read GetEnableThinking write SetEnableThinking;
|
||||
end;
|
||||
|
||||
// Implementation of the API Client
|
||||
TGeminiClient = class(TInterfacedObject, IGeminiClient)
|
||||
private
|
||||
class var
|
||||
FTotalUsage: TGeminiUsage;
|
||||
private
|
||||
FApiKey: string;
|
||||
FBaseUrl: string;
|
||||
FStreamUrl: string;
|
||||
FListUrl: string;
|
||||
FModelName: string;
|
||||
FActiveCacheName: string;
|
||||
FSystemInstruction: string;
|
||||
FEnableThinking: Boolean;
|
||||
|
||||
function ParseResponse(const JsonStr: string): TGeminiResult;
|
||||
function ParseModels(const JsonStr: string): TArray<string>;
|
||||
function BuildJsonBody(const History: TArray<TChatItem>): TJSONObject;
|
||||
procedure ProcessStreamData(const Data: TBytes; var Buffer: string; const OnDelta: TStreamCallback; var TotalResult: TGeminiResult);
|
||||
public
|
||||
constructor Create(const AApiKey: string; const AModel: string = 'gemini-1.5-flash-001');
|
||||
|
||||
function GenerateContent(const Prompt: string): TGeminiResult; overload;
|
||||
function GenerateContent(const History: TArray<TChatItem>): TGeminiResult; overload;
|
||||
|
||||
function GenerateContentStream(const Prompt: string; const OnDelta: TStreamCallback): TGeminiResult; overload;
|
||||
function GenerateContentStream(const History: TArray<TChatItem>; const OnDelta: TStreamCallback): TGeminiResult; overload;
|
||||
|
||||
function ListModels: TArray<string>;
|
||||
function StartChat: IGeminiChat;
|
||||
|
||||
function CreateCache(const Content: string; const SysInstructions: string; const TTLSeconds: Integer = 300): string;
|
||||
procedure SetActiveCache(const CacheName: string);
|
||||
function GetActiveCache: string;
|
||||
|
||||
procedure SetSystemInstruction(const Value: string);
|
||||
function GetSystemInstruction: string;
|
||||
|
||||
procedure SetEnableThinking(const Value: Boolean);
|
||||
function GetEnableThinking: Boolean;
|
||||
|
||||
// Static access to session-global usage (RAM only)
|
||||
class property TotalUsage: TGeminiUsage read FTotalUsage;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
// Internal Chat Session Implementation
|
||||
TChatSession = class(TInterfacedObject, IGeminiChat)
|
||||
private
|
||||
FClient: IGeminiClient;
|
||||
FHistory: TList<TChatItem>;
|
||||
public
|
||||
constructor Create(const Client: IGeminiClient);
|
||||
destructor Destroy; override;
|
||||
function SendMessage(const Text: string): TGeminiResult;
|
||||
function SendMessageStream(const Text: string; const OnDelta: TStreamCallback): TGeminiResult;
|
||||
function GetHistory: TArray<TChatItem>;
|
||||
end;
|
||||
|
||||
{ TGeminiClient }
|
||||
|
||||
constructor TGeminiClient.Create(const AApiKey: string; const AModel: string);
|
||||
var
|
||||
LModel: string;
|
||||
encodedKey: string;
|
||||
begin
|
||||
inherited Create;
|
||||
FApiKey := AApiKey.Trim;
|
||||
LModel := AModel.Trim;
|
||||
|
||||
if LModel.IsEmpty then
|
||||
LModel := 'gemini-1.5-flash-001';
|
||||
|
||||
FModelName := LModel;
|
||||
if not FModelName.StartsWith('models/') then
|
||||
FModelName := 'models/' + FModelName;
|
||||
|
||||
encodedKey := TNetEncoding.URL.EncodeQuery(FApiKey);
|
||||
|
||||
// Endpoint construction
|
||||
FBaseUrl := Format('https://generativelanguage.googleapis.com/v1beta/%s:generateContent?key=%s', [FModelName, encodedKey]);
|
||||
|
||||
FStreamUrl := Format('https://generativelanguage.googleapis.com/v1beta/%s:streamGenerateContent?key=%s', [FModelName, encodedKey]);
|
||||
|
||||
FListUrl := Format('https://generativelanguage.googleapis.com/v1beta/models?key=%s', [encodedKey]);
|
||||
|
||||
FEnableThinking := False;
|
||||
end;
|
||||
|
||||
// --- Property Setters/Getters ---
|
||||
|
||||
procedure TGeminiClient.SetEnableThinking(const Value: Boolean);
|
||||
begin
|
||||
FEnableThinking := Value;
|
||||
end;
|
||||
|
||||
function TGeminiClient.GetEnableThinking: Boolean;
|
||||
begin
|
||||
Result := FEnableThinking;
|
||||
end;
|
||||
|
||||
procedure TGeminiClient.SetActiveCache(const CacheName: string);
|
||||
begin
|
||||
FActiveCacheName := CacheName;
|
||||
end;
|
||||
|
||||
function TGeminiClient.GetActiveCache: string;
|
||||
begin
|
||||
Result := FActiveCacheName;
|
||||
end;
|
||||
|
||||
procedure TGeminiClient.SetSystemInstruction(const Value: string);
|
||||
begin
|
||||
FSystemInstruction := Value;
|
||||
end;
|
||||
|
||||
function TGeminiClient.GetSystemInstruction: string;
|
||||
begin
|
||||
Result := FSystemInstruction;
|
||||
end;
|
||||
|
||||
// --- Core Logic ---
|
||||
|
||||
function TGeminiClient.GenerateContent(const Prompt: string): TGeminiResult;
|
||||
var
|
||||
item: TChatItem;
|
||||
begin
|
||||
item.Role := TChatRole.User;
|
||||
item.Text := Prompt;
|
||||
Result := GenerateContent([item]);
|
||||
end;
|
||||
|
||||
function TGeminiClient.GenerateContent(const History: TArray<TChatItem>): TGeminiResult;
|
||||
var
|
||||
httpClient: THTTPClient;
|
||||
requestBody: TJSONObject;
|
||||
response: IHTTPResponse;
|
||||
stringStream: TStringStream;
|
||||
begin
|
||||
Result.Text := '';
|
||||
Result.Usage := Default(TGeminiUsage);
|
||||
Result.IsThought := False;
|
||||
|
||||
httpClient := THTTPClient.Create;
|
||||
requestBody := BuildJsonBody(History);
|
||||
try
|
||||
stringStream := TStringStream.Create(requestBody.ToString, TEncoding.UTF8);
|
||||
try
|
||||
httpClient.CustomHeaders['Content-Type'] := 'application/json';
|
||||
httpClient.ConnectionTimeout := 10000;
|
||||
httpClient.ResponseTimeout := 30000;
|
||||
|
||||
try
|
||||
response := httpClient.Post(FBaseUrl, stringStream);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
Result.Text := 'Error: Connection failed - ' + E.Message;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (response.StatusCode = 200) then
|
||||
begin
|
||||
Result := ParseResponse(response.ContentAsString(TEncoding.UTF8));
|
||||
|
||||
// Update Usages
|
||||
if (Result.Usage.TotalTokens > 0) then
|
||||
begin
|
||||
// RAM Counter
|
||||
TInterlocked.Add(FTotalUsage.PromptTokens, Result.Usage.PromptTokens);
|
||||
TInterlocked.Add(FTotalUsage.CandidatesTokens, Result.Usage.CandidatesTokens);
|
||||
TInterlocked.Add(FTotalUsage.TotalTokens, Result.Usage.TotalTokens);
|
||||
|
||||
// Persistent System Counter
|
||||
TGlobalQuota.AddTokens(Result.Usage.TotalTokens);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result.Text :=
|
||||
Format('Error: %d - %s (%s)', [response.StatusCode, response.StatusText, response.ContentAsString(TEncoding.UTF8)]);
|
||||
end;
|
||||
finally
|
||||
stringStream.Free;
|
||||
end;
|
||||
finally
|
||||
httpClient.Free;
|
||||
requestBody.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGeminiClient.GenerateContentStream(const Prompt: string; const OnDelta: TStreamCallback): TGeminiResult;
|
||||
var
|
||||
item: TChatItem;
|
||||
begin
|
||||
item.Role := TChatRole.User;
|
||||
item.Text := Prompt;
|
||||
Result := GenerateContentStream([item], OnDelta);
|
||||
end;
|
||||
|
||||
function TGeminiClient.GenerateContentStream(const History: TArray<TChatItem>; const OnDelta: TStreamCallback): TGeminiResult;
|
||||
var
|
||||
httpClient: THTTPClient;
|
||||
requestBody: TJSONObject;
|
||||
stringStream: TStringStream;
|
||||
buffer: string;
|
||||
|
||||
// Captured local variable for the result state to avoid E2555
|
||||
LFullResult: TGeminiResult;
|
||||
begin
|
||||
// Init local result container
|
||||
LFullResult.Text := '';
|
||||
LFullResult.Usage := Default(TGeminiUsage);
|
||||
LFullResult.IsThought := False;
|
||||
buffer := '';
|
||||
|
||||
httpClient := THTTPClient.Create;
|
||||
requestBody := BuildJsonBody(History);
|
||||
try
|
||||
stringStream := TStringStream.Create(requestBody.ToString, TEncoding.UTF8);
|
||||
try
|
||||
httpClient.CustomHeaders['Content-Type'] := 'application/json';
|
||||
httpClient.ConnectionTimeout := 10000;
|
||||
httpClient.ResponseTimeout := 60000;
|
||||
|
||||
// Use ReceiveDataExCallback to access raw data chunks efficiently
|
||||
httpClient.ReceiveDataExCallback :=
|
||||
procedure(
|
||||
const Sender: TObject;
|
||||
AContentLength: Int64;
|
||||
AReadCount: Int64;
|
||||
AChunk: Pointer;
|
||||
AChunkLength: Cardinal;
|
||||
var AAbort: Boolean
|
||||
)
|
||||
var
|
||||
LBytes: TBytes;
|
||||
begin
|
||||
if AChunkLength > 0 then
|
||||
begin
|
||||
SetLength(LBytes, AChunkLength);
|
||||
Move(AChunk^, LBytes[0], AChunkLength);
|
||||
|
||||
ProcessStreamData(LBytes, buffer, OnDelta, LFullResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
try
|
||||
httpClient.Post(FStreamUrl, stringStream);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
LFullResult.Text := LFullResult.Text + sLineBreak + '[Error: ' + E.Message + ']';
|
||||
end;
|
||||
end;
|
||||
|
||||
// Update Usages
|
||||
if LFullResult.Usage.TotalTokens > 0 then
|
||||
begin
|
||||
// RAM Counter
|
||||
TInterlocked.Add(FTotalUsage.PromptTokens, LFullResult.Usage.PromptTokens);
|
||||
TInterlocked.Add(FTotalUsage.CandidatesTokens, LFullResult.Usage.CandidatesTokens);
|
||||
TInterlocked.Add(FTotalUsage.TotalTokens, LFullResult.Usage.TotalTokens);
|
||||
|
||||
// Persistent System Counter
|
||||
TGlobalQuota.AddTokens(LFullResult.Usage.TotalTokens);
|
||||
end;
|
||||
|
||||
finally
|
||||
stringStream.Free;
|
||||
end;
|
||||
finally
|
||||
httpClient.Free;
|
||||
requestBody.Free;
|
||||
end;
|
||||
|
||||
Result := LFullResult;
|
||||
end;
|
||||
|
||||
// --- JSON Body Construction ---
|
||||
|
||||
function TGeminiClient.BuildJsonBody(const History: TArray<TChatItem>): TJSONObject;
|
||||
var
|
||||
contentsArray, partsArray: TJSONArray;
|
||||
contentObj, partObj: TJSONObject;
|
||||
sysObj, sysPart: TJSONObject;
|
||||
sysPartsArr: TJSONArray;
|
||||
item: TChatItem;
|
||||
genConfig, thinkConfig: TJSONObject;
|
||||
begin
|
||||
Result := TJSONObject.Create;
|
||||
|
||||
// 1. Caching Strategy
|
||||
if not FActiveCacheName.IsEmpty then
|
||||
begin
|
||||
Result.AddPair('cachedContent', FActiveCacheName);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// 2. Dynamic System Instructions (only if no cache active)
|
||||
if not FSystemInstruction.IsEmpty then
|
||||
begin
|
||||
sysObj := TJSONObject.Create;
|
||||
|
||||
sysPartsArr := TJSONArray.Create;
|
||||
sysPart := TJSONObject.Create;
|
||||
sysPart.AddPair('text', FSystemInstruction);
|
||||
sysPartsArr.Add(sysPart);
|
||||
|
||||
sysObj.AddPair('parts', sysPartsArr);
|
||||
Result.AddPair('systemInstruction', sysObj);
|
||||
end;
|
||||
end;
|
||||
|
||||
// 3. Native Thinking Configuration
|
||||
if FEnableThinking then
|
||||
begin
|
||||
thinkConfig := TJSONObject.Create;
|
||||
thinkConfig.AddPair('includeThoughts', TJSONTrue.Create);
|
||||
// 'thinkingLevel' omitted to use model default
|
||||
|
||||
genConfig := TJSONObject.Create;
|
||||
genConfig.AddPair('thinkingConfig', thinkConfig);
|
||||
|
||||
Result.AddPair('generationConfig', genConfig);
|
||||
end;
|
||||
|
||||
// 4. Chat Contents
|
||||
contentsArray := TJSONArray.Create;
|
||||
|
||||
for item in History do
|
||||
begin
|
||||
contentObj := TJSONObject.Create;
|
||||
|
||||
// Delphi 13 inline if
|
||||
contentObj.AddPair(
|
||||
'role',
|
||||
if item.Role = TChatRole.User then 'user'
|
||||
else 'model'
|
||||
);
|
||||
|
||||
partObj := TJSONObject.Create;
|
||||
partObj.AddPair('text', item.Text);
|
||||
|
||||
partsArray := TJSONArray.Create;
|
||||
partsArray.Add(partObj);
|
||||
|
||||
contentObj.AddPair('parts', partsArray);
|
||||
contentsArray.Add(contentObj);
|
||||
end;
|
||||
Result.AddPair('contents', contentsArray);
|
||||
end;
|
||||
|
||||
// --- Response Parsing (Streaming) ---
|
||||
|
||||
procedure TGeminiClient.ProcessStreamData(
|
||||
const Data: TBytes;
|
||||
var Buffer: string;
|
||||
const OnDelta: TStreamCallback;
|
||||
var TotalResult: TGeminiResult
|
||||
);
|
||||
var
|
||||
chunkStr: string;
|
||||
jsonStart, jsonEnd: Integer;
|
||||
jsonSub: string;
|
||||
jsonObj: TJSONObject;
|
||||
candidates, parts: TJSONArray;
|
||||
part, usageObj: TJSONObject;
|
||||
deltaText: string;
|
||||
isDeltaThought: Boolean;
|
||||
braceCount, i: Integer;
|
||||
foundEnd: Boolean;
|
||||
begin
|
||||
chunkStr := TEncoding.UTF8.GetString(Data);
|
||||
Buffer := Buffer + chunkStr;
|
||||
|
||||
// Parse loop to extract complete JSON objects from buffer
|
||||
while True do
|
||||
begin
|
||||
jsonStart := Buffer.IndexOf('{');
|
||||
jsonEnd := -1;
|
||||
if jsonStart < 0 then
|
||||
break;
|
||||
|
||||
// Brackets matching to find end of JSON object
|
||||
braceCount := 0;
|
||||
foundEnd := False;
|
||||
for i := jsonStart to Buffer.Length - 1 do
|
||||
begin
|
||||
if Buffer.Chars[i] = '{' then
|
||||
inc(braceCount)
|
||||
else if Buffer.Chars[i] = '}' then
|
||||
dec(braceCount);
|
||||
|
||||
if (braceCount = 0) then
|
||||
begin
|
||||
jsonEnd := i;
|
||||
foundEnd := True;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if not foundEnd then
|
||||
break; // Object incomplete
|
||||
|
||||
jsonSub := Buffer.Substring(jsonStart, jsonEnd - jsonStart + 1);
|
||||
Buffer := Buffer.Substring(jsonEnd + 1);
|
||||
|
||||
jsonObj := TJSONObject.ParseJSONValue(jsonSub) as TJSONObject;
|
||||
if Assigned(jsonObj) then
|
||||
try
|
||||
deltaText := '';
|
||||
isDeltaThought := False;
|
||||
|
||||
candidates := jsonObj.GetValue('candidates') as TJSONArray;
|
||||
if (Assigned(candidates)) and (candidates.Count > 0) then
|
||||
begin
|
||||
var cand := candidates.Items[0] as TJSONObject;
|
||||
var content := cand.GetValue('content') as TJSONObject;
|
||||
if Assigned(content) then
|
||||
begin
|
||||
parts := content.GetValue('parts') as TJSONArray;
|
||||
if (Assigned(parts)) and (parts.Count > 0) then
|
||||
begin
|
||||
part := parts.Items[0] as TJSONObject;
|
||||
deltaText := part.GetValue<string>('text');
|
||||
|
||||
// Check for Native Thinking flag "thought": true
|
||||
part.TryGetValue<Boolean>('thought', isDeltaThought);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
usageObj := jsonObj.GetValue('usageMetadata') as TJSONObject;
|
||||
if Assigned(usageObj) then
|
||||
begin
|
||||
usageObj.TryGetValue<Integer>('promptTokenCount', TotalResult.Usage.PromptTokens);
|
||||
usageObj.TryGetValue<Integer>('candidatesTokenCount', TotalResult.Usage.CandidatesTokens);
|
||||
usageObj.TryGetValue<Integer>('totalTokenCount', TotalResult.Usage.TotalTokens);
|
||||
end;
|
||||
|
||||
if not deltaText.IsEmpty then
|
||||
begin
|
||||
// Append to full text (including thoughts)
|
||||
if not isDeltaThought then
|
||||
TotalResult.Text := TotalResult.Text + deltaText;
|
||||
|
||||
// Fire callback
|
||||
if Assigned(OnDelta) then
|
||||
OnDelta(deltaText, isDeltaThought);
|
||||
end;
|
||||
finally
|
||||
jsonObj.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// --- Response Parsing (Synchronous) ---
|
||||
|
||||
function TGeminiClient.ParseResponse(const JsonStr: string): TGeminiResult;
|
||||
var
|
||||
jsonObj: TJSONObject;
|
||||
candidates, parts: TJSONArray;
|
||||
candidate, content, part, usageObj: TJSONObject;
|
||||
isThought: Boolean;
|
||||
begin
|
||||
Result.Text := '';
|
||||
Result.Usage := Default(TGeminiUsage);
|
||||
Result.IsThought := False;
|
||||
|
||||
jsonObj := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
|
||||
if not Assigned(jsonObj) then
|
||||
exit;
|
||||
|
||||
try
|
||||
candidates := jsonObj.GetValue('candidates') as TJSONArray;
|
||||
if (Assigned(candidates)) and (candidates.Count > 0) then
|
||||
begin
|
||||
candidate := candidates.Items[0] as TJSONObject;
|
||||
content := candidate.GetValue('content') as TJSONObject;
|
||||
if Assigned(content) then
|
||||
begin
|
||||
parts := content.GetValue('parts') as TJSONArray;
|
||||
if (Assigned(parts)) and (parts.Count > 0) then
|
||||
begin
|
||||
part := parts.Items[0] as TJSONObject;
|
||||
Result.Text := part.GetValue<string>('text');
|
||||
|
||||
// Check for thought flag
|
||||
if part.TryGetValue<Boolean>('thought', isThought) then
|
||||
Result.IsThought := isThought;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
usageObj := jsonObj.GetValue('usageMetadata') as TJSONObject;
|
||||
if Assigned(usageObj) then
|
||||
begin
|
||||
usageObj.TryGetValue<Integer>('promptTokenCount', Result.Usage.PromptTokens);
|
||||
usageObj.TryGetValue<Integer>('candidatesTokenCount', Result.Usage.CandidatesTokens);
|
||||
usageObj.TryGetValue<Integer>('totalTokenCount', Result.Usage.TotalTokens);
|
||||
end;
|
||||
finally
|
||||
jsonObj.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
// --- Model Listing ---
|
||||
|
||||
function TGeminiClient.ListModels: TArray<string>;
|
||||
var
|
||||
httpClient: THTTPClient;
|
||||
response: IHTTPResponse;
|
||||
begin
|
||||
SetLength(Result, 0);
|
||||
httpClient := THTTPClient.Create;
|
||||
try
|
||||
httpClient.ConnectionTimeout := 10000;
|
||||
try
|
||||
response := httpClient.Get(FListUrl);
|
||||
if (response.StatusCode = 200) then
|
||||
Result := ParseModels(response.ContentAsString(TEncoding.UTF8));
|
||||
except
|
||||
// Return empty array on error
|
||||
end;
|
||||
finally
|
||||
httpClient.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGeminiClient.ParseModels(const JsonStr: string): TArray<string>;
|
||||
var
|
||||
jsonObj: TJSONObject;
|
||||
models, methods: TJSONArray;
|
||||
model: TJSONObject;
|
||||
i, j: Integer;
|
||||
modelName: string;
|
||||
canGen: Boolean;
|
||||
list: TList<string>;
|
||||
begin
|
||||
SetLength(Result, 0);
|
||||
jsonObj := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
|
||||
if not Assigned(jsonObj) then
|
||||
exit;
|
||||
|
||||
list := TList<string>.Create;
|
||||
try
|
||||
models := jsonObj.GetValue('models') as TJSONArray;
|
||||
if Assigned(models) then
|
||||
begin
|
||||
for i := 0 to models.Count - 1 do
|
||||
begin
|
||||
model := models.Items[i] as TJSONObject;
|
||||
modelName := model.GetValue<string>('name');
|
||||
|
||||
if modelName.StartsWith('models/') then
|
||||
modelName := modelName.Substring(7);
|
||||
|
||||
// Filter for Gemini models
|
||||
if not modelName.ToLower.Contains('gemini') then
|
||||
continue;
|
||||
if modelName.ToLower.Contains('embedding') then
|
||||
continue;
|
||||
if modelName.ToLower.Contains('robotics') then
|
||||
continue;
|
||||
if modelName.ToLower.Contains('computer-use') then
|
||||
continue;
|
||||
|
||||
// Filter for Generation capabilities
|
||||
canGen := False;
|
||||
methods := model.GetValue('supportedGenerationMethods') as TJSONArray;
|
||||
if Assigned(methods) then
|
||||
for j := 0 to methods.Count - 1 do
|
||||
if (methods.Items[j].Value = 'generateContent') then
|
||||
begin
|
||||
canGen := True;
|
||||
break;
|
||||
end;
|
||||
|
||||
if canGen then
|
||||
list.Add(modelName);
|
||||
end;
|
||||
end;
|
||||
Result := list.ToArray;
|
||||
finally
|
||||
list.Free;
|
||||
jsonObj.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
// --- Context Caching ---
|
||||
|
||||
function TGeminiClient.CreateCache(const Content: string; const SysInstructions: string; const TTLSeconds: Integer): string;
|
||||
var
|
||||
httpClient: THTTPClient;
|
||||
requestBody: TJSONObject;
|
||||
contentsArray, partsArray: TJSONArray;
|
||||
contentObj, partObj, sysObj: TJSONObject;
|
||||
sysPartsArr: TJSONArray;
|
||||
sysPart: TJSONObject;
|
||||
response: IHTTPResponse;
|
||||
stringStream: TStringStream;
|
||||
cacheUrl: string;
|
||||
respJson: TJSONObject;
|
||||
begin
|
||||
Result := '';
|
||||
cacheUrl := Format('https://generativelanguage.googleapis.com/v1beta/cachedContents?key=%s', [TNetEncoding.URL.EncodeQuery(FApiKey)]);
|
||||
|
||||
httpClient := THTTPClient.Create;
|
||||
requestBody := TJSONObject.Create;
|
||||
try
|
||||
requestBody.AddPair('model', FModelName);
|
||||
|
||||
partObj := TJSONObject.Create;
|
||||
partObj.AddPair('text', Content);
|
||||
|
||||
partsArray := TJSONArray.Create;
|
||||
partsArray.Add(partObj);
|
||||
|
||||
contentObj := TJSONObject.Create;
|
||||
contentObj.AddPair('parts', partsArray);
|
||||
contentObj.AddPair('role', 'user');
|
||||
|
||||
contentsArray := TJSONArray.Create;
|
||||
contentsArray.Add(contentObj);
|
||||
requestBody.AddPair('contents', contentsArray);
|
||||
|
||||
if not SysInstructions.IsEmpty then
|
||||
begin
|
||||
sysObj := TJSONObject.Create;
|
||||
|
||||
sysPartsArr := TJSONArray.Create;
|
||||
sysPart := TJSONObject.Create;
|
||||
sysPart.AddPair('text', SysInstructions);
|
||||
sysPartsArr.Add(sysPart);
|
||||
|
||||
sysObj.AddPair('parts', sysPartsArr);
|
||||
requestBody.AddPair('systemInstruction', sysObj);
|
||||
end;
|
||||
|
||||
requestBody.AddPair('ttl', IntToStr(TTLSeconds) + 's');
|
||||
|
||||
stringStream := TStringStream.Create(requestBody.ToString, TEncoding.UTF8);
|
||||
try
|
||||
httpClient.CustomHeaders['Content-Type'] := 'application/json';
|
||||
try
|
||||
response := httpClient.Post(cacheUrl, stringStream);
|
||||
except
|
||||
on E: Exception do
|
||||
raise Exception.Create('Cache Creation Failed: ' + E.Message);
|
||||
end;
|
||||
|
||||
// Success is 200 OK or 201 Created
|
||||
if (response.StatusCode = 200) or (response.StatusCode = 201) then
|
||||
begin
|
||||
respJson := TJSONObject.ParseJSONValue(response.ContentAsString(TEncoding.UTF8)) as TJSONObject;
|
||||
try
|
||||
if Assigned(respJson) then
|
||||
Result := respJson.GetValue<string>('name');
|
||||
finally
|
||||
respJson.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
raise Exception.CreateFmt('Cache Error %d: %s', [response.StatusCode, response.ContentAsString(TEncoding.UTF8)]);
|
||||
end;
|
||||
finally
|
||||
stringStream.Free;
|
||||
end;
|
||||
finally
|
||||
httpClient.Free;
|
||||
requestBody.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGeminiClient.StartChat: IGeminiChat;
|
||||
begin
|
||||
Result := TChatSession.Create(Self);
|
||||
end;
|
||||
|
||||
// --- TChatSession Implementation ---
|
||||
|
||||
constructor TChatSession.Create(const Client: IGeminiClient);
|
||||
begin
|
||||
inherited Create;
|
||||
FClient := Client;
|
||||
FHistory := TList<TChatItem>.Create;
|
||||
end;
|
||||
|
||||
destructor TChatSession.Destroy;
|
||||
begin
|
||||
FHistory.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TChatSession.SendMessage(const Text: string): TGeminiResult;
|
||||
var
|
||||
item: TChatItem;
|
||||
begin
|
||||
item.Role := TChatRole.User;
|
||||
item.Text := Text;
|
||||
FHistory.Add(item);
|
||||
|
||||
Result := FClient.GenerateContent(FHistory.ToArray);
|
||||
|
||||
if not Result.Text.IsEmpty and not Result.Text.StartsWith('Error') then
|
||||
begin
|
||||
item.Role := TChatRole.Model;
|
||||
item.Text := Result.Text;
|
||||
FHistory.Add(item);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChatSession.SendMessageStream(const Text: string; const OnDelta: TStreamCallback): TGeminiResult;
|
||||
var
|
||||
item: TChatItem;
|
||||
begin
|
||||
item.Role := TChatRole.User;
|
||||
item.Text := Text;
|
||||
FHistory.Add(item);
|
||||
|
||||
Result := FClient.GenerateContentStream(FHistory.ToArray, OnDelta);
|
||||
|
||||
if not Result.Text.IsEmpty and not Result.Text.StartsWith('Error') then
|
||||
begin
|
||||
item.Role := TChatRole.Model;
|
||||
item.Text := Result.Text;
|
||||
FHistory.Add(item);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChatSession.GetHistory: TArray<TChatItem>;
|
||||
begin
|
||||
Result := FHistory.ToArray;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,254 @@
|
||||
unit Myc.System.Quota;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Win.Registry,
|
||||
Winapi.Windows,
|
||||
System.Classes;
|
||||
|
||||
type
|
||||
// Handles global quota tracking via Windows Registry
|
||||
TGlobalQuota = class
|
||||
private
|
||||
const
|
||||
REG_KEY = 'Software\Myc\GeminiTools\Quota';
|
||||
|
||||
// Value names
|
||||
const
|
||||
VAL_TOTAL_TOKENS = 'TotalTokens';
|
||||
const
|
||||
VAL_DAILY_TOKENS = 'DailyTokens';
|
||||
const
|
||||
VAL_LAST_RESET = 'LastReset'; // Manual reset timestamp
|
||||
const
|
||||
VAL_LAST_UPDATE = 'LastUpdate'; // Last modification timestamp
|
||||
const
|
||||
VAL_DAILY_DATE = 'DailyDate'; // Date for the daily counter reference
|
||||
|
||||
public
|
||||
// Adds tokens to global and daily counters thread-safely
|
||||
// Automatically resets the daily counter if the day has changed
|
||||
class procedure AddTokens(Count: Integer);
|
||||
|
||||
// Reads the all-time total from registry
|
||||
class function GetTotal: Int64;
|
||||
|
||||
// Reads the accumulated tokens for the current day
|
||||
class function GetDailyTotal: Int64;
|
||||
|
||||
// Returns the date and time of the last modification (AddTokens)
|
||||
class function GetLastUpdate: TDateTime;
|
||||
|
||||
// Returns the date and time of the last manual reset
|
||||
class function GetLastReset: TDateTime;
|
||||
|
||||
// Resets all counters (Total and Daily) to zero
|
||||
class procedure Reset;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TGlobalQuota }
|
||||
|
||||
class procedure TGlobalQuota.AddTokens(Count: Integer);
|
||||
var
|
||||
reg: TRegistry;
|
||||
mutex: THandle;
|
||||
totalTokens, dailyTokens: Int64;
|
||||
strValue: string;
|
||||
lastDailyDate, today: TDateTime;
|
||||
begin
|
||||
if Count <= 0 then
|
||||
exit;
|
||||
|
||||
// Use a named mutex to prevent race conditions between different processes
|
||||
mutex := CreateMutex(nil, False, 'GlobalGeminiQuotaMutex');
|
||||
if WaitForSingleObject(mutex, 2000) = WAIT_OBJECT_0 then
|
||||
try
|
||||
reg := TRegistry.Create(KEY_READ or KEY_WRITE);
|
||||
try
|
||||
reg.RootKey := HKEY_CURRENT_USER;
|
||||
if reg.OpenKey(REG_KEY, True) then
|
||||
begin
|
||||
// 1. Handle Total Tokens
|
||||
totalTokens := 0;
|
||||
if reg.ValueExists(VAL_TOTAL_TOKENS) then
|
||||
begin
|
||||
strValue := reg.ReadString(VAL_TOTAL_TOKENS);
|
||||
TryStrToInt64(strValue, totalTokens);
|
||||
end;
|
||||
totalTokens := totalTokens + Count;
|
||||
|
||||
// 2. Handle Daily Tokens
|
||||
dailyTokens := 0;
|
||||
lastDailyDate := 0;
|
||||
today := Trunc(Now); // Date part only
|
||||
|
||||
if reg.ValueExists(VAL_DAILY_DATE) then
|
||||
lastDailyDate := reg.ReadDate(VAL_DAILY_DATE);
|
||||
|
||||
// Check if we are on a new day
|
||||
if lastDailyDate = today then
|
||||
begin
|
||||
// Same day, read existing daily count
|
||||
if reg.ValueExists(VAL_DAILY_TOKENS) then
|
||||
begin
|
||||
strValue := reg.ReadString(VAL_DAILY_TOKENS);
|
||||
TryStrToInt64(strValue, dailyTokens);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// New day (or first run), dailyTokens remains 0
|
||||
// Update the reference date
|
||||
reg.WriteDate(VAL_DAILY_DATE, today);
|
||||
end;
|
||||
|
||||
dailyTokens := dailyTokens + Count;
|
||||
|
||||
// 3. Write updates
|
||||
// Store numbers as String to support Int64 (Registry WriteInteger is 32-bit in older API wrappers)
|
||||
reg.WriteString(VAL_TOTAL_TOKENS, totalTokens.ToString);
|
||||
reg.WriteString(VAL_DAILY_TOKENS, dailyTokens.ToString);
|
||||
reg.WriteDateTime(VAL_LAST_UPDATE, Now);
|
||||
|
||||
reg.CloseKey;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
end;
|
||||
finally
|
||||
ReleaseMutex(mutex);
|
||||
CloseHandle(mutex);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TGlobalQuota.GetTotal: Int64;
|
||||
var
|
||||
reg: TRegistry;
|
||||
strValue: string;
|
||||
begin
|
||||
Result := 0;
|
||||
reg := TRegistry.Create(KEY_READ);
|
||||
try
|
||||
reg.RootKey := HKEY_CURRENT_USER;
|
||||
if reg.OpenKey(REG_KEY, False) then
|
||||
begin
|
||||
if reg.ValueExists(VAL_TOTAL_TOKENS) then
|
||||
begin
|
||||
strValue := reg.ReadString(VAL_TOTAL_TOKENS);
|
||||
TryStrToInt64(strValue, Result);
|
||||
end;
|
||||
reg.CloseKey;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TGlobalQuota.GetDailyTotal: Int64;
|
||||
var
|
||||
reg: TRegistry;
|
||||
strValue: string;
|
||||
lastDailyDate: TDateTime;
|
||||
begin
|
||||
Result := 0;
|
||||
reg := TRegistry.Create(KEY_READ);
|
||||
try
|
||||
reg.RootKey := HKEY_CURRENT_USER;
|
||||
if reg.OpenKey(REG_KEY, False) then
|
||||
begin
|
||||
// Check if the stored daily count belongs to today
|
||||
if reg.ValueExists(VAL_DAILY_DATE) then
|
||||
begin
|
||||
lastDailyDate := reg.ReadDate(VAL_DAILY_DATE);
|
||||
if lastDailyDate = Trunc(Now) then
|
||||
begin
|
||||
if reg.ValueExists(VAL_DAILY_TOKENS) then
|
||||
begin
|
||||
strValue := reg.ReadString(VAL_DAILY_TOKENS);
|
||||
TryStrToInt64(strValue, Result);
|
||||
end;
|
||||
end;
|
||||
// If date differs, Result remains 0 (logic effectively resets on read, though write happens in AddTokens)
|
||||
end;
|
||||
reg.CloseKey;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TGlobalQuota.GetLastUpdate: TDateTime;
|
||||
var
|
||||
reg: TRegistry;
|
||||
begin
|
||||
Result := 0;
|
||||
reg := TRegistry.Create(KEY_READ);
|
||||
try
|
||||
reg.RootKey := HKEY_CURRENT_USER;
|
||||
if reg.OpenKey(REG_KEY, False) then
|
||||
begin
|
||||
if reg.ValueExists(VAL_LAST_UPDATE) then
|
||||
Result := reg.ReadDateTime(VAL_LAST_UPDATE);
|
||||
reg.CloseKey;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TGlobalQuota.GetLastReset: TDateTime;
|
||||
var
|
||||
reg: TRegistry;
|
||||
begin
|
||||
Result := 0;
|
||||
reg := TRegistry.Create(KEY_READ);
|
||||
try
|
||||
reg.RootKey := HKEY_CURRENT_USER;
|
||||
if reg.OpenKey(REG_KEY, False) then
|
||||
begin
|
||||
if reg.ValueExists(VAL_LAST_RESET) then
|
||||
Result := reg.ReadDateTime(VAL_LAST_RESET);
|
||||
reg.CloseKey;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TGlobalQuota.Reset;
|
||||
var
|
||||
reg: TRegistry;
|
||||
mutex: THandle;
|
||||
begin
|
||||
// Reset also needs Mutex protection to avoid conflicting writes with AddTokens
|
||||
mutex := CreateMutex(nil, False, 'GlobalGeminiQuotaMutex');
|
||||
if WaitForSingleObject(mutex, 2000) = WAIT_OBJECT_0 then
|
||||
try
|
||||
reg := TRegistry.Create(KEY_WRITE);
|
||||
try
|
||||
reg.RootKey := HKEY_CURRENT_USER;
|
||||
if reg.OpenKey(REG_KEY, True) then
|
||||
begin
|
||||
reg.WriteString(VAL_TOTAL_TOKENS, '0');
|
||||
reg.WriteString(VAL_DAILY_TOKENS, '0');
|
||||
reg.WriteDate(VAL_DAILY_DATE, Trunc(Now));
|
||||
reg.WriteDateTime(VAL_LAST_RESET, Now);
|
||||
// We typically update LastUpdate on reset as well, or leave it as the last "Add" action.
|
||||
// Here we update it to indicate change.
|
||||
reg.WriteDateTime(VAL_LAST_UPDATE, Now);
|
||||
reg.CloseKey;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
end;
|
||||
finally
|
||||
ReleaseMutex(mutex);
|
||||
CloseHandle(mutex);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -47,20 +47,19 @@ class function TAstSchema.GetJsonType(Kind: TFieldKind): TJSONObject;
|
||||
Result.AddPair('type', ATypeName);
|
||||
end;
|
||||
|
||||
function JConst(const AVal: string): TJSONObject;
|
||||
// Use enum for const strings as it's widely supported
|
||||
function JEnum(const AVal: string): TJSONObject;
|
||||
var
|
||||
arr: TJSONArray;
|
||||
begin
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('const', AVal);
|
||||
Result := JType('string');
|
||||
arr := TJSONArray.Create;
|
||||
arr.Add(AVal);
|
||||
Result.AddPair('enum', arr);
|
||||
end;
|
||||
|
||||
function JArray(AItems: TJSONValue): TJSONObject;
|
||||
begin
|
||||
Result := JType('array');
|
||||
Result.AddPair('items', AItems);
|
||||
end;
|
||||
|
||||
// Combined function: Creates array from items and sets prefixItems + limits
|
||||
function JFixedArray(const AItems: array of TJSONValue): TJSONObject;
|
||||
// Tuple Array (Fixed items)
|
||||
function JTupleArray(const AItems: array of TJSONValue): TJSONObject;
|
||||
var
|
||||
arr: TJSONArray;
|
||||
item: TJSONValue;
|
||||
@@ -68,19 +67,22 @@ class function TAstSchema.GetJsonType(Kind: TFieldKind): TJSONObject;
|
||||
begin
|
||||
Result := JType('array');
|
||||
|
||||
// "items" as an array defines a Tuple schema in older drafts (supported by Gemini)
|
||||
arr := TJSONArray.Create;
|
||||
for item in AItems do
|
||||
arr.AddElement(item);
|
||||
|
||||
count := arr.Count;
|
||||
Result.AddPair('prefixItems', arr);
|
||||
Result.AddPair('items', arr); // Items as Array = Tuple Definition
|
||||
Result.AddPair('minItems', TJSONNumber.Create(count));
|
||||
Result.AddPair('maxItems', TJSONNumber.Create(count));
|
||||
Result.AddPair('additionalItems', TJSONBool.Create(False)); // No extra items allowed
|
||||
end;
|
||||
|
||||
function JTuple(AItems: TJSONValue): TJSONObject;
|
||||
begin
|
||||
Result := JFixedArray([JConst('Tuple'), AItems]);
|
||||
// ["Tuple", [...]]
|
||||
Result := JTupleArray([JEnum('Tuple'), AItems]);
|
||||
end;
|
||||
|
||||
function JAnyOf(AOptions: array of TJSONValue): TJSONObject;
|
||||
@@ -97,7 +99,7 @@ class function TAstSchema.GetJsonType(Kind: TFieldKind): TJSONObject;
|
||||
{$endregion}
|
||||
|
||||
var
|
||||
pair, selItems, selTuple, entryContent, entryNode: TJSONObject;
|
||||
pair, selTuple, entryNode: TJSONObject;
|
||||
begin
|
||||
case Kind of
|
||||
fkNode: Result := JDefRef('Node');
|
||||
@@ -105,28 +107,54 @@ begin
|
||||
fkKeyword: Result := JDefRef('Key');
|
||||
fkLambda: Result := JDefRef('Fn');
|
||||
fkIdentifier: Result := JDefRef('Id');
|
||||
|
||||
fkString: Result := JType('string');
|
||||
fkValue: Result := JAnyOf([JType('number'), JType('string'), JType('boolean')]);
|
||||
fkNullableNode: Result := JAnyOf([JDefRef('Node'), JType('null')]);
|
||||
fkArrayOfNodes: Result := JArray(JDefRef('Node'));
|
||||
|
||||
fkValue:
|
||||
begin
|
||||
// number | string | boolean
|
||||
Result := JAnyOf([JType('number'), JType('string'), JType('boolean')]);
|
||||
end;
|
||||
|
||||
fkNullableNode:
|
||||
begin
|
||||
// Node | null
|
||||
// Note: OpenAPI/Gemini often prefers 'nullable: true' over explicit null type,
|
||||
// but anyOf [Node, {type: null}] works in full JSON schema.
|
||||
Result := JAnyOf([JDefRef('Node'), JType('null')]);
|
||||
end;
|
||||
|
||||
fkArrayOfNodes:
|
||||
begin
|
||||
// standard array of Nodes
|
||||
Result := JType('array');
|
||||
Result.AddPair('items', JDefRef('Node'));
|
||||
end;
|
||||
|
||||
fkArrayOfPairs:
|
||||
begin
|
||||
// [[Cond, Branch], ...]
|
||||
pair := JFixedArray([JDefRef('Node'), JDefRef('Node')]);
|
||||
Result := JArray(pair);
|
||||
pair := JTupleArray([JDefRef('Node'), JDefRef('Node')]);
|
||||
Result := JType('array');
|
||||
Result.AddPair('items', pair);
|
||||
end;
|
||||
|
||||
fkPipeInputs:
|
||||
begin
|
||||
// 1. Selector Tuple: ["Tuple", [Key, ...]]
|
||||
selTuple := JTuple(JArray(JDefRef('Key')));
|
||||
// Note: This is an array of Keys inside the Tuple structure
|
||||
var keyArray := JType('array');
|
||||
keyArray.AddPair('items', JDefRef('Key'));
|
||||
selTuple := JTuple(keyArray);
|
||||
|
||||
// 2. Entry Node: ["Tuple", [Id, SelectorTuple]]
|
||||
entryNode := JTuple(JFixedArray([JDefRef('Id'), selTuple]));
|
||||
entryNode := JTupleArray([JDefRef('Id'), selTuple]);
|
||||
|
||||
// 3. Outer Inputs List: ["Tuple", [EntryNode, ...]]
|
||||
Result := JTuple(JArray(entryNode));
|
||||
// 3. Wrap in ["Tuple", [Array of EntryNodes]]
|
||||
var entriesArray := JType('array');
|
||||
entriesArray.AddPair('items', entryNode);
|
||||
|
||||
Result := JTuple(entriesArray);
|
||||
end;
|
||||
else
|
||||
Result := TJSONObject.Create;
|
||||
@@ -142,7 +170,11 @@ var
|
||||
anyOfNodes: TJSONArray;
|
||||
tag: string;
|
||||
fields: TList<AstFieldAttribute>;
|
||||
minCount, maxCount: Integer;
|
||||
itemsArr: TJSONArray;
|
||||
|
||||
// Properties Wrapper
|
||||
props, programProp: TJSONObject;
|
||||
reqArr: TJSONArray;
|
||||
begin
|
||||
ctx := TRttiContext.Create;
|
||||
Result := TJSONObject.Create;
|
||||
@@ -150,7 +182,7 @@ begin
|
||||
anyOfNodes := TJSONArray.Create;
|
||||
|
||||
try
|
||||
// 1. Scan all interfaces for AstTag metadata
|
||||
// 1. Scan all interfaces
|
||||
for typ in ctx.GetTypes do
|
||||
begin
|
||||
if typ.TypeKind <> tkInterface then
|
||||
@@ -170,39 +202,41 @@ begin
|
||||
if tag = '' then
|
||||
continue;
|
||||
|
||||
// Sort fields by index
|
||||
// Sort fields
|
||||
fields.Sort(
|
||||
TComparer<AstFieldAttribute>
|
||||
.Construct(function(const L, R: AstFieldAttribute): Integer begin Result := L.Index - R.Index; end)
|
||||
);
|
||||
|
||||
// Construct Tuple Definition for this Tag: ["Tag", Arg1, Arg2]
|
||||
nodeDef := TJSONObject.Create;
|
||||
nodeDef.AddPair('type', 'array');
|
||||
|
||||
var items := TJSONArray.Create;
|
||||
items.AddElement(TJSONObject.Create.AddPair('const', tag));
|
||||
itemsArr := TJSONArray.Create;
|
||||
|
||||
minCount := 1;
|
||||
maxCount := 1;
|
||||
// Item 0: The Tag (as Const/Enum)
|
||||
var tagConst := TJSONObject.Create;
|
||||
tagConst.AddPair('type', 'string');
|
||||
var enumArr := TJSONArray.Create;
|
||||
enumArr.Add(tag);
|
||||
tagConst.AddPair('enum', enumArr);
|
||||
itemsArr.AddElement(tagConst);
|
||||
|
||||
// Items 1..N: The Fields
|
||||
for var f in fields do
|
||||
begin
|
||||
inc(maxCount);
|
||||
// Only non-nullable fields increase minCount
|
||||
if f.Kind <> fkNullableNode then
|
||||
minCount := maxCount;
|
||||
|
||||
items.AddElement(GetJsonType(f.Kind));
|
||||
itemsArr.AddElement(GetJsonType(f.Kind));
|
||||
end;
|
||||
|
||||
nodeDef.AddPair('prefixItems', items);
|
||||
nodeDef.AddPair('minItems', TJSONNumber.Create(minCount));
|
||||
nodeDef.AddPair('maxItems', TJSONNumber.Create(maxCount));
|
||||
// additionalItems removed as maxItems guarantees strictness
|
||||
nodeDef.AddPair('items', itemsArr);
|
||||
nodeDef.AddPair('minItems', TJSONNumber.Create(itemsArr.Count));
|
||||
nodeDef.AddPair('maxItems', TJSONNumber.Create(itemsArr.Count));
|
||||
nodeDef.AddPair('additionalItems', TJSONBool.Create(False));
|
||||
|
||||
// Add to defs
|
||||
defs.AddPair(tag, nodeDef);
|
||||
|
||||
// Add reference to the global AstNode union
|
||||
// Add to main Node Union
|
||||
astNodeRef := TJSONObject.Create;
|
||||
astNodeRef.AddPair('$ref', '#/$defs/' + tag);
|
||||
anyOfNodes.AddElement(astNodeRef);
|
||||
@@ -212,13 +246,29 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// 2. Define the base AstNode anyOf union
|
||||
// 2. Define generic "Node" union
|
||||
var astNodeBase := TJSONObject.Create;
|
||||
|
||||
// WICHTIG: Das fehlende "type": "array" hat den Fehler verursacht.
|
||||
astNodeBase.AddPair('type', 'array');
|
||||
|
||||
astNodeBase.AddPair('anyOf', anyOfNodes);
|
||||
defs.AddPair('Node', astNodeBase);
|
||||
|
||||
// 3. Assemble final Root Object
|
||||
Result.AddPair('$ref', '#/$defs/Node');
|
||||
// 3. ROOT OBJECT WRAPPER
|
||||
Result.AddPair('type', 'object');
|
||||
|
||||
props := TJSONObject.Create;
|
||||
programProp := TJSONObject.Create;
|
||||
programProp.AddPair('$ref', '#/$defs/Node');
|
||||
props.AddPair('program', programProp);
|
||||
Result.AddPair('properties', props);
|
||||
|
||||
reqArr := TJSONArray.Create;
|
||||
reqArr.Add('program');
|
||||
Result.AddPair('required', reqArr);
|
||||
|
||||
Result.AddPair('additionalProperties', TJSONBool.Create(False));
|
||||
Result.AddPair('$defs', defs);
|
||||
|
||||
finally
|
||||
|
||||
Reference in New Issue
Block a user