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.