diff --git a/GeminiTest/GeminiTest.dpr b/GeminiTest/GeminiTest.dpr
new file mode 100644
index 0000000..3b14376
--- /dev/null
+++ b/GeminiTest/GeminiTest.dpr
@@ -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.
diff --git a/GeminiTest/GeminiTest.dproj b/GeminiTest/GeminiTest.dproj
new file mode 100644
index 0000000..5b1aeaa
--- /dev/null
+++ b/GeminiTest/GeminiTest.dproj
@@ -0,0 +1,1159 @@
+
+
+ {C61FC33B-44CC-44B8-81A4-C2ABEC37C72F}
+ 20.3
+ FMX
+ True
+ Debug
+ Win64
+ GeminiTest
+ 2
+ Application
+ GeminiTest.dpr
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ .\$(Platform)\$(Config)
+ .\$(Platform)\$(Config)
+ false
+ false
+ false
+ false
+ false
+ System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
+ $(BDS)\bin\delphi_PROJECTICON.ico
+ $(BDS)\bin\delphi_PROJECTICNS.icns
+ GeminiTest
+
+
+ vclwinx;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;FireDACCommonODBC;FireDACCommonDriver;IndyProtocols;vclx;Skia.Package.RTL;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;bindcompfmx;inetdb;FireDACSqliteDriver;DbxClientDriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;DBXMySQLDriver;VclSmp;inet;fmxase;vcltouch;dbrtl;Skia.Package.FMX;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;vcldsnap;DBXInterBaseDriver;IndySystem;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;adortl;vclimg;FireDACPgDriver;FireDAC;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;fmxobj;bindcompvclsmp;FMXTee;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+ $(BDS)\bin\default_app.manifest
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
+
+
+ vclwinx;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;FireDACCommonODBC;FireDACCommonDriver;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;bindcompfmx;inetdb;FireDACSqliteDriver;DbxClientDriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;DBXMySQLDriver;VclSmp;inet;fmxase;vcltouch;dbrtl;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;vcldsnap;DBXInterBaseDriver;IndySystem;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;adortl;vclimg;FireDACPgDriver;FireDAC;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;fmxobj;bindcompvclsmp;FMXTee;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+ $(BDS)\bin\default_app.manifest
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
+
+
+ DEBUG;$(DCC_Define)
+ true
+ false
+ true
+ true
+ true
+ true
+ true
+
+
+ false
+ PerMonitorV2
+
+
+ PerMonitorV2
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ 0
+
+
+ PerMonitorV2
+
+
+ PerMonitorV2
+
+
+
+ MainSource
+
+
+
+ fmx
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Application
+
+
+
+ GeminiTest.dpr
+
+
+
+
+
+ true
+
+
+
+
+ true
+
+
+
+
+ true
+
+
+
+
+ GeminiTest.exe
+ true
+
+
+
+
+ GeminiTest.exe
+ true
+
+
+
+
+ GeminiTest.rsm
+ true
+
+
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ res\xml
+ 1
+
+
+ res\xml
+ 1
+
+
+
+
+ library\lib\armeabi
+ 1
+
+
+ library\lib\armeabi
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ library\lib\mips
+ 1
+
+
+ library\lib\mips
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ library\lib\arm64-v8a
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-anydpi-v21
+ 1
+
+
+ res\drawable-anydpi-v21
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ res\values-v21
+ 1
+
+
+ res\values-v21
+ 1
+
+
+
+
+ res\values-v31
+ 1
+
+
+ res\values-v31
+ 1
+
+
+
+
+ res\values-v35
+ 1
+
+
+ res\values-v35
+ 1
+
+
+
+
+ res\drawable-anydpi-v26
+ 1
+
+
+ res\drawable-anydpi-v26
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-anydpi-v33
+ 1
+
+
+ res\drawable-anydpi-v33
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ res\values-night-v21
+ 1
+
+
+ res\values-night-v21
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+
+
+ res\drawable-ldpi
+ 1
+
+
+ res\drawable-ldpi
+ 1
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+
+
+ res\drawable-small
+ 1
+
+
+ res\drawable-small
+ 1
+
+
+
+
+ res\drawable-normal
+ 1
+
+
+ res\drawable-normal
+ 1
+
+
+
+
+ res\drawable-large
+ 1
+
+
+ res\drawable-large
+ 1
+
+
+
+
+ res\drawable-xlarge
+ 1
+
+
+ res\drawable-xlarge
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+ res\values
+ 1
+
+
+
+
+ res\drawable-anydpi-v24
+ 1
+
+
+ res\drawable-anydpi-v24
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-night-anydpi-v21
+ 1
+
+
+ res\drawable-night-anydpi-v21
+ 1
+
+
+
+
+ res\drawable-anydpi-v31
+ 1
+
+
+ res\drawable-anydpi-v31
+ 1
+
+
+
+
+ res\drawable-night-anydpi-v31
+ 1
+
+
+ res\drawable-night-anydpi-v31
+ 1
+
+
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ 0
+
+
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 0
+ .dll;.bpl
+
+
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 0
+ .bpl
+
+
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ 0
+
+
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+
+
+ Contents
+ 1
+
+
+ Contents
+ 1
+
+
+ Contents
+ 1
+
+
+
+
+ Contents\Resources
+ 1
+
+
+ Contents\Resources
+ 1
+
+
+ Contents\Resources
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ library\lib\arm64-v8a
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen
+ 64
+
+
+ ..\$(PROJECTNAME).launchscreen
+ 64
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ Assets
+ 1
+
+
+ Assets
+ 1
+
+
+
+
+ Assets
+ 1
+
+
+ Assets
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
+ 1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ False
+ False
+ False
+ False
+ False
+ False
+ False
+ False
+ False
+ True
+
+
+ 12
+
+
+
+
+
diff --git a/GeminiTest/GeminiTest.res b/GeminiTest/GeminiTest.res
new file mode 100644
index 0000000..e356e03
Binary files /dev/null and b/GeminiTest/GeminiTest.res differ
diff --git a/GeminiTest/MainUnit.fmx b/GeminiTest/MainUnit.fmx
new file mode 100644
index 0000000..9610ee3
--- /dev/null
+++ b/GeminiTest/MainUnit.fmx
@@ -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
diff --git a/GeminiTest/MainUnit.pas b/GeminiTest/MainUnit.pas
new file mode 100644
index 0000000..595d392
--- /dev/null
+++ b/GeminiTest/MainUnit.pas
@@ -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;
+ 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.
diff --git a/GeminiTest/Myc.Api.Gemini.pas b/GeminiTest/Myc.Api.Gemini.pas
new file mode 100644
index 0000000..596958b
--- /dev/null
+++ b/GeminiTest/Myc.Api.Gemini.pas
@@ -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;
+ 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): TGeminiResult; overload;
+
+ // Streaming Generation
+ function GenerateContentStream(const Prompt: string; const OnDelta: TStreamCallback): TGeminiResult; overload;
+ function GenerateContentStream(const History: TArray; const OnDelta: TStreamCallback): TGeminiResult; overload;
+
+ // Utilities
+ function ListModels: TArray;
+ 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;
+ function BuildJsonBody(const History: TArray): 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): TGeminiResult; overload;
+
+ function GenerateContentStream(const Prompt: string; const OnDelta: TStreamCallback): TGeminiResult; overload;
+ function GenerateContentStream(const History: TArray; const OnDelta: TStreamCallback): TGeminiResult; overload;
+
+ function ListModels: TArray;
+ 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;
+ 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;
+ 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): 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; 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): 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('text');
+
+ // Check for Native Thinking flag "thought": true
+ part.TryGetValue('thought', isDeltaThought);
+ end;
+ end;
+ end;
+
+ usageObj := jsonObj.GetValue('usageMetadata') as TJSONObject;
+ if Assigned(usageObj) then
+ begin
+ usageObj.TryGetValue('promptTokenCount', TotalResult.Usage.PromptTokens);
+ usageObj.TryGetValue('candidatesTokenCount', TotalResult.Usage.CandidatesTokens);
+ usageObj.TryGetValue('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('text');
+
+ // Check for thought flag
+ if part.TryGetValue('thought', isThought) then
+ Result.IsThought := isThought;
+ end;
+ end;
+ end;
+
+ usageObj := jsonObj.GetValue('usageMetadata') as TJSONObject;
+ if Assigned(usageObj) then
+ begin
+ usageObj.TryGetValue('promptTokenCount', Result.Usage.PromptTokens);
+ usageObj.TryGetValue('candidatesTokenCount', Result.Usage.CandidatesTokens);
+ usageObj.TryGetValue('totalTokenCount', Result.Usage.TotalTokens);
+ end;
+ finally
+ jsonObj.Free;
+ end;
+end;
+
+// --- Model Listing ---
+
+function TGeminiClient.ListModels: TArray;
+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;
+var
+ jsonObj: TJSONObject;
+ models, methods: TJSONArray;
+ model: TJSONObject;
+ i, j: Integer;
+ modelName: string;
+ canGen: Boolean;
+ list: TList;
+begin
+ SetLength(Result, 0);
+ jsonObj := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
+ if not Assigned(jsonObj) then
+ exit;
+
+ list := TList.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('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('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.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;
+begin
+ Result := FHistory.ToArray;
+end;
+
+end.
diff --git a/GeminiTest/Myc.System.Quota.pas b/GeminiTest/Myc.System.Quota.pas
new file mode 100644
index 0000000..4afa256
--- /dev/null
+++ b/GeminiTest/Myc.System.Quota.pas
@@ -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.
diff --git a/Src/AST/Myc.Ast.Json.Schema.pas b/Src/AST/Myc.Ast.Json.Schema.pas
index 6a031dc..e73bad0 100644
--- a/Src/AST/Myc.Ast.Json.Schema.pas
+++ b/Src/AST/Myc.Ast.Json.Schema.pas
@@ -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;
- 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
.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