From dad953716f2018da6f63b4639e4c56f5f032ccef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=D0=94=D0=B0=D0=BD=D0=B8=D0=BB=20=D0=AF=D0=BA=D1=83=D1=88?= =?UTF-8?q?=D0=B5=D0=B2?= Date: Wed, 24 Dec 2025 14:43:29 +0300 Subject: [PATCH] New chatgpt and gemini files --- Src/AI/DelphiAIDev.AI.ChatGPT.pas | 193 +++++++++++---- Src/AI/DelphiAIDev.AI.Gemini.pas | 397 +++++++++++++++++++++++++++--- 2 files changed, 519 insertions(+), 71 deletions(-) diff --git a/Src/AI/DelphiAIDev.AI.ChatGPT.pas b/Src/AI/DelphiAIDev.AI.ChatGPT.pas index 7409225..ad31b4e 100644 --- a/Src/AI/DelphiAIDev.AI.ChatGPT.pas +++ b/Src/AI/DelphiAIDev.AI.ChatGPT.pas @@ -35,68 +35,177 @@ constructor TDelphiAIDevAIChatGPT.Create(const ASettings: TDelphiAIDevSettings; end; function TDelphiAIDevAIChatGPT.GetResponse(const AQuestion: string): IDelphiAIDevAIResponse; + + // --- ЛОКАЛЬНАЯ ФУНКЦИЯ ДОЛЖНА БЫТЬ ДО ПЕРВЫХ ОПЕРАТОРОВ! --- + function ParseSSEToText(const AContent: string): string; + var + Lines: TArray; + Line, JsonText: string; + V, ChoicesVal, DeltaVal, MsgVal, TextVal: TJSONValue; + O, ChoiceObj, DeltaObj, MsgObj: TJSONObject; + Choices: TJSONArray; + begin + Result := ''; + Lines := AContent.Replace(#13, '').Split([#10]); + + for Line in Lines do + begin + if not Line.StartsWith('data: ') then + Continue; + + JsonText := Trim(Copy(Line, 7, MaxInt)); + if (JsonText = '') or (SameText(JsonText, '[DONE]')) then + Continue; + + V := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(JsonText), 0); + try + if not (V is TJSONObject) then + Continue; + + O := TJSONObject(V); + ChoicesVal := O.GetValue('choices'); + if not (ChoicesVal is TJSONArray) then + Continue; + + Choices := TJSONArray(ChoicesVal); + if (Choices.Count = 0) or not (Choices.Items[0] is TJSONObject) then + Continue; + + ChoiceObj := TJSONObject(Choices.Items[0]); + + // chat/completions -> delta.content + DeltaVal := ChoiceObj.GetValue('delta'); + if (DeltaVal is TJSONObject) then + begin + DeltaObj := TJSONObject(DeltaVal); + if DeltaObj.GetValue('content') is TJSONString then + Result := Result + TJSONString(DeltaObj.GetValue('content')).Value; + Continue; + end; + + // иногда приходит message.content + MsgVal := ChoiceObj.GetValue('message'); + if (MsgVal is TJSONObject) then + begin + MsgObj := TJSONObject(MsgVal); + if MsgObj.GetValue('content') is TJSONString then + Result := Result + TJSONString(MsgObj.GetValue('content')).Value; + Continue; + end; + + // completions -> text + TextVal := ChoiceObj.GetValue('text'); + if TextVal is TJSONString then + Result := Result + TJSONString(TextVal).Value; + finally + V.Free; + end; + end; + + Result := Result.Trim; + end; + var LResponse: IResponse; - LJsonValueAll: TJSONValue; - LJsonValueChoices: TJSONValue; + Body: TJSONObject; + Arr: TJSONArray; + Msg: TJSONObject; + LJsonValueAll, LJsonValueChoices, LJsonValueMessage, LJsonValueText: TJSONValue; LJsonArrayChoices: TJSONArray; - LJsonObjChoices: TJSONObject; - LJsonValueMessage: TJSONValue; - LJsonObjMessage: TJSONObject; + LJsonObjChoices, LJsonObjMessage: TJSONObject; LItemChoices: Integer; LResult: string; begin Result := FResponse; - LResponse := TRequest.New - .BaseURL(FSettings.BaseUrlOpenAI) - .ContentType(TConsts.APPLICATION_JSON) - .Accept(TConsts.APPLICATION_JSON) - .Token('Bearer ' + FSettings.ApiKeyOpenAI) - .AddBody(Format(API_JSON_BODY_BASE, [FSettings.ModelOpenAI, AQuestion])) - .Post; + // --- сборка тела запроса --- + Body := TJSONObject.Create; + try + if FSettings.ModelOpenAI.Trim <> '' then + Body.AddPair('model', FSettings.ModelOpenAI); + + Arr := TJSONArray.Create; + Msg := TJSONObject.Create; + Msg.AddPair('role', 'user'); + Msg.AddPair('content', AQuestion); + Arr.AddElement(Msg); + Body.AddPair('messages', Arr); + + // если хотите получать один объект без стрима — раскомментируйте: + // Body.AddPair('stream', TJSONBool.Create(False)); + + LResponse := TRequest.New + .BaseURL(FSettings.BaseUrlOpenAI) // например: http://192.168.110.24:6560 + .Resource('/v1/chat/completions') + .ContentType('application/json') + .Accept('application/json') + .TokenBearer(FSettings.ApiKeyOpenAI) // "auth_..." + .AddBody(Body.ToJSON) + .Post; + finally + Body.Free; + end; FResponse.SetStatusCode(LResponse.StatusCode); - if LResponse.StatusCode <> 200 then begin FResponse.SetContentText('Question cannot be answered' + sLineBreak + 'Return: ' + LResponse.Content); Exit; end; - LJsonValueAll := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(LResponse.Content), 0); - if not(LJsonValueAll is TJSONObject) then - begin - FResponse.SetContentText('The question cannot be answered, return object not found.' + sLineBreak + - 'Return: ' + LResponse.Content); - Exit; - end; - - LJsonValueChoices := TJSONObject(LJsonValueAll).GetValue('choices'); - if not(LJsonValueChoices is TJSONArray) then + // --- поддержка стриминга (SSE) --- + if (LResponse.Content.StartsWith('data:')) or + (LResponse.Content.IndexOf('chat.completion.chunk') >= 0) then begin - FResponse.SetContentText('The question cannot be answered, choices not found.' + sLineBreak + - 'Return: ' + LResponse.Content); + LResult := ParseSSEToText(LResponse.Content); + if LResult <> '' then + FResponse.SetContentText(LResult) + else + FResponse.SetContentText('The question cannot be answered, empty SSE stream.'); Exit; end; - LJsonArrayChoices := LJsonValueChoices as TJSONArray; - for LItemChoices := 0 to Pred(LJsonArrayChoices.Count) do - begin - if not(LJsonArrayChoices.Items[LItemChoices] is TJSONObject) then - Continue; - - //CAST ITEM CHOICES LIKE TJSONObject - LJsonObjChoices := LJsonArrayChoices.Items[LItemChoices] as TJSONObject; - - //GET MESSAGE LIKE TJSONValue - LJsonValueMessage := LJsonObjChoices.GetValue('message'); - if not(LJsonValueMessage is TJSONObject) then - Continue; - - //GET MESSAGE LIKE TJSONObject - LJsonObjMessage := LJsonValueMessage as TJSONObject; - LResult := LResult + TJSONString(LJsonObjMessage.GetValue('content')).Value.Trim + sLineBreak; + // --- обычный (нестримовый) JSON --- + LJsonValueAll := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(LResponse.Content), 0); + try + if not (LJsonValueAll is TJSONObject) then + begin + FResponse.SetContentText('The question cannot be answered, return object not found.' + sLineBreak + + 'Return: ' + LResponse.Content); + Exit; + end; + + LJsonValueChoices := TJSONObject(LJsonValueAll).GetValue('choices'); + if not (LJsonValueChoices is TJSONArray) then + begin + FResponse.SetContentText('The question cannot be answered, choices not found.' + sLineBreak + + 'Return: ' + LResponse.Content); + Exit; + end; + + LJsonArrayChoices := TJSONArray(LJsonValueChoices); + for LItemChoices := 0 to Pred(LJsonArrayChoices.Count) do + if LJsonArrayChoices.Items[LItemChoices] is TJSONObject then + begin + LJsonObjChoices := TJSONObject(LJsonArrayChoices.Items[LItemChoices]); + + // chat/completions -> choices[].message.content + LJsonValueMessage := LJsonObjChoices.GetValue('message'); + if (LJsonValueMessage is TJSONObject) then + begin + LJsonObjMessage := TJSONObject(LJsonValueMessage); + if LJsonObjMessage.GetValue('content') is TJSONString then + LResult := LResult + TJSONString(LJsonObjMessage.GetValue('content')).Value.Trim + sLineBreak; + Continue; + end; + + // completions -> choices[].text + LJsonValueText := LJsonObjChoices.GetValue('text'); + if LJsonValueText is TJSONString then + LResult := LResult + TJSONString(LJsonValueText).Value.Trim + sLineBreak; + end; + finally + LJsonValueAll.Free; end; FResponse.SetContentText(LResult.Trim); diff --git a/Src/AI/DelphiAIDev.AI.Gemini.pas b/Src/AI/DelphiAIDev.AI.Gemini.pas index ed284cf..db027bb 100644 --- a/Src/AI/DelphiAIDev.AI.Gemini.pas +++ b/Src/AI/DelphiAIDev.AI.Gemini.pas @@ -11,6 +11,9 @@ interface DelphiAIDev.Utils, DelphiAIDev.Settings, DelphiAIDev.AI.Interfaces, + System.StrUtils, + System.Character, + ToolsAPI, DelphiAIDev.AI.Response; type @@ -26,8 +29,201 @@ TDelphiAIDevAIGemini = class(TInterfacedObject, IDelphiAIDevAI) implementation -const - API_JSON_BODY_BASE = '{"contents": [{"parts": [ {"text": "%s"}]}]}'; +uses + System.IOUtils, + System.DateUtils; + +// ЛОГ UTF-8 c BOM + +function _LogDir: string; +begin + Result := TPath.Combine(TPath.GetDocumentsPath, 'DelphiAIDev\logs'); +end; + +function _LogFile: string; +begin + Result := TPath.Combine(_LogDir, Format('completion-%s.log', [FormatDateTime('yyyymmdd', Now)])); +end; + +procedure _EnsureUtf8BomFile(const Fn: string); +var + fs: TFileStream; + head: array[0..2] of Byte; + hasBom: Boolean; +begin + TDirectory.CreateDirectory(TPath.GetDirectoryName(Fn)); + + if not TFile.Exists(Fn) then + begin + fs := TFileStream.Create(Fn, fmCreate or fmShareDenyNone); + try + if Length(TEncoding.UTF8.GetPreamble) > 0 then + fs.WriteBuffer(TEncoding.UTF8.GetPreamble[0], Length(TEncoding.UTF8.GetPreamble)); + finally + fs.Free; + end; + Exit; + end; + + hasBom := False; + fs := TFileStream.Create(Fn, fmOpenReadWrite or fmShareDenyNone); + try + if fs.Size >= 3 then + begin + fs.ReadBuffer(head, 3); + hasBom := (head[0] = $EF) and (head[1] = $BB) and (head[2] = $BF); + end; + if not hasBom then + begin + var bytes := TFile.ReadAllBytes(Fn); + fs.Size := 0; + if Length(TEncoding.UTF8.GetPreamble) > 0 then + fs.WriteBuffer(TEncoding.UTF8.GetPreamble[0], Length(TEncoding.UTF8.GetPreamble)); + if Length(bytes) > 0 then + fs.WriteBuffer(bytes[0], Length(bytes)); + end; + finally + fs.Free; + end; +end; + +procedure _AppendUtf8WithBom(const Fn, Line: string); +var + fs: TFileStream; + bytes: TBytes; + s: string; +begin + _EnsureUtf8BomFile(Fn); + fs := TFileStream.Create(Fn, fmOpenReadWrite or fmShareDenyNone); + try + fs.Seek(0, soEnd); + s := FormatDateTime('hh:nn:ss.zzz', Now) + ' ' + Line + sLineBreak; + bytes := TEncoding.UTF8.GetBytes(s); + if Length(bytes) > 0 then + fs.WriteBuffer(bytes[0], Length(bytes)); + finally + fs.Free; + end; +end; + +procedure _Log(const S: string); overload; +begin + try + _AppendUtf8WithBom(_LogFile, S); + except + end; +end; + +procedure _Log(const Fmt: string; const Args: array of const); overload; +begin + _Log(Format(Fmt, Args)); +end; + +// Утилиты + +function JoinUrl(const BaseUrl, Path: string): string; +var + B, P: string; +begin + B := Trim(BaseUrl); + P := Trim(Path); + while (B <> '') and B.EndsWith('/') do Delete(B, Length(B), 1); + while (P <> '') and P.StartsWith('/') do Delete(P, 1, 1); + if (B <> '') and (P <> '') then Result := B + '/' + P else Result := B + P; +end; + +function _Trunc(const S: string; MaxLen: Integer = 800): string; +begin + if Length(S) <= MaxLen then + Result := S + else + Result := Copy(S, 1, MaxLen) + '…'; +end; + +function LastPosEx(const SubStr, S: string): Integer; +var + p, i: Integer; +begin + Result := 0; + if (SubStr = '') or (S = '') then Exit; + i := 1; + repeat + p := PosEx(SubStr, S, i); + if p = 0 then Break; + Result := p; + i := p + 1; + until False; +end; + +function JsonEscapesToReadable(const S: string): string; + function Hex4ToChar(const h4: string): Char; + var v, i: Integer; + begin + v := 0; + for i := 1 to 4 do + begin + v := v shl 4; + case h4[i] of + '0'..'9' : v := v + Ord(h4[i]) - Ord('0'); + 'A'..'F' : v := v + 10 + Ord(h4[i]) - Ord('A'); + 'a'..'f' : v := v + 10 + Ord(h4[i]) - Ord('a'); + else + Exit('?'); + end; + end; + Result := Char(v); + end; +var + i, n: Integer; +begin + Result := ''; + i := 1; n := Length(S); + while i <= n do + begin + if (S[i] = '\') and (i < n) then + begin + Inc(i); + case S[i] of + '"': Result := Result + '"'; + '\': Result := Result + '\'; + '/': Result := Result + '/'; + 'b': Result := Result + #8; + 'f': Result := Result + #12; + 'n': Result := Result + #10; + 'r': Result := Result + #13; + 't': Result := Result + #9; + 'u': + if i + 4 <= n then + begin + Result := Result + Hex4ToChar(Copy(S, i+1, 4)); + Inc(i, 4); + end + else + Result := Result + '\u'; + else + Result := Result + '\' + S[i]; + end; + end + else + Result := Result + S[i]; + Inc(i); + end; +end; + +function MakeRelativePath(const BaseDir, AbsPath: string): string; +var + B, A: string; +begin + B := IncludeTrailingPathDelimiter(ExpandFileName(BaseDir)); + A := ExpandFileName(AbsPath); + + if SameText(Copy(A, 1, Length(B)), B) then + Result := Copy(A, Length(B) + 1, MaxInt) + else + Result := A; +end; + +// Основа constructor TDelphiAIDevAIGemini.Create(const ASettings: TDelphiAIDevSettings; const AResponse: IDelphiAIDevAIResponse); begin @@ -35,57 +231,200 @@ constructor TDelphiAIDevAIGemini.Create(const ASettings: TDelphiAIDevSettings; c FResponse := AResponse; end; +function _OsUser: string; +begin + Result := GetEnvironmentVariable('USERNAME'); + if Result = '' then + Result := GetEnvironmentVariable('USER'); +end; + function TDelphiAIDevAIGemini.GetResponse(const AQuestion: string): IDelphiAIDevAIResponse; +const + MAX_PREFIX = 8000; + MAX_SUFFIX = 4000; var - LApiUrl: string; + LUrl: string; LResponse: IResponse; - LJsonValueAll: TJSONVALUE; - LJsonArrayCandidates: TJsonArray; - LJsonArrayParts: TJsonArray; - LJsonObjContent: TJsonObject; - LJsonObjParts: TJsonObject; - LItemCandidates: Integer; - LItemParts: Integer; - LResult: string; + Root, ChoicesVal, TextVal: TJSONValue; + Choices: TJSONArray; + I: Integer; + LResult, BodyJson, RespPreview, TokenPreview: string; + Tag: string; + TagPos: Integer; + PrefixRaw, SuffixRaw, PrefixWin, SuffixWin: string; + Body, Segments: TJSONObject; + OsUser, CurrentFileAbs, CurrentFileRel, GitRoot: string; + + function FindGitRoot(const StartDir: string): string; + var + Dir, Parent: string; + begin + Dir := ExcludeTrailingPathDelimiter(StartDir); + repeat + if TDirectory.Exists(TPath.Combine(Dir, '.git')) then + Exit(Dir); + Parent := TDirectory.GetParent(Dir); + if (Parent = '') or (Parent = Dir) then + Break; + Dir := Parent; + until False; + Result := ''; + end; + begin Result := FResponse; - LApiUrl := FSettings.BaseUrlGemini + FSettings.ModelGemini + '?key=' + FSettings.ApiKeyGemini; + // подготовка prefix/suffix + Tag := TConsts.TAG_CODE_COMPLETION; + TagPos := LastPosEx(Tag, AQuestion); + if TagPos > 0 then + begin + PrefixRaw := Copy(AQuestion, 1, TagPos - 1); + SuffixRaw := Copy(AQuestion, TagPos + Tag.Length, MaxInt); + + if Length(PrefixRaw) > MAX_PREFIX then + PrefixWin := Copy(PrefixRaw, Length(PrefixRaw) - MAX_PREFIX + 1, MAX_PREFIX) + else + PrefixWin := PrefixRaw; + + if Length(SuffixRaw) > MAX_SUFFIX then + SuffixWin := Copy(SuffixRaw, 1, MAX_SUFFIX) + else + SuffixWin := SuffixRaw; + end + else + begin + PrefixWin := AQuestion; + SuffixWin := ''; + end; + + // endpoint + тело запроса + LUrl := JoinUrl(FSettings.BaseUrlGemini, 'v1/completions'); + + Body := TJSONObject.Create; + Segments := TJSONObject.Create; + try + Segments.AddPair('prefix', PrefixWin); + Segments.AddPair('suffix', SuffixWin); + Body.AddPair('language', 'pascal'); + Body.AddPair('segments', Segments); + + OsUser := _OsUser; + if OsUser <> '' then + Body.AddPair('user', OsUser); + + CurrentFileAbs := ''; + CurrentFileRel := ''; + try + if Assigned(BorlandIDEServices) then + begin + var EditorServices: IOTAEditorServices := nil; + if Supports(BorlandIDEServices, IOTAEditorServices, EditorServices) then + begin + if Assigned(EditorServices.TopBuffer) then + CurrentFileAbs := EditorServices.TopBuffer.FileName; + end; + end; + except + CurrentFileAbs := ''; + end; + + if CurrentFileAbs <> '' then + begin + GitRoot := FindGitRoot(ExtractFilePath(CurrentFileAbs)); + if (GitRoot <> '') and CurrentFileAbs.StartsWith(GitRoot, True) then + CurrentFileRel := MakeRelativePath(GitRoot, CurrentFileAbs) + else + CurrentFileRel := CurrentFileAbs; + + Body.AddPair('filepath', CurrentFileRel); + end; + + BodyJson := Body.ToJSON; + finally + Body.Free; + end; + + if FSettings.ApiKeyGemini.Length > 6 then + TokenPreview := Copy(FSettings.ApiKeyGemini, 1, 3) + '...' + + Copy(FSettings.ApiKeyGemini, Length(FSettings.ApiKeyGemini)-2, 3) + else + TokenPreview := ''; + + _Log('DEBUG CurrentFileAbs=%s GitRoot=%s Rel=%s', [CurrentFileAbs, GitRoot, CurrentFileRel]); + _Log('Prefix.len=%d Suffix.len=%d', [Length(PrefixWin), Length(SuffixWin)]); + _Log('Prefix.head = "%s"', [_Trunc(PrefixWin, 200)]); + _Log('Suffix.head = "%s"', [_Trunc(SuffixWin, 200)]); + _Log('REQ -> URL=%s', [LUrl]); + _Log('REQ Token(Bearer)=%s', [TokenPreview]); + _Log('REQ BODY HUMAN (first 800)=%s', [_Trunc(JsonEscapesToReadable(BodyJson), 800)]); + LResponse := TRequest.New - .BaseURL(LApiUrl) + .BaseURL(LUrl) .Accept(TConsts.APPLICATION_JSON) - .AddBody(Format(API_JSON_BODY_BASE, [AQuestion])) + .ContentType(TConsts.APPLICATION_JSON) + .TokenBearer(FSettings.ApiKeyGemini) + .AddBody(BodyJson) .Post; FResponse.SetStatusCode(LResponse.StatusCode); + RespPreview := Copy(LResponse.Content, 1, 1000); + + _Log('RESP -> STATUS=%d', [LResponse.StatusCode]); + _Log('RESP -> BODY HUMAN (first 800)=%s', [_Trunc(JsonEscapesToReadable(LResponse.Content), 800)]); if LResponse.StatusCode <> 200 then begin - FResponse.SetContentText('Question cannot be answered' + sLineBreak + 'Return: ' + LResponse.Content); + FResponse.SetContentText('Question cannot be answered' + sLineBreak + + 'Return: ' + LResponse.Content); Exit; end; - LJsonValueAll := TJsonObject.ParseJSONValue(LResponse.Content); - if not(LJsonValueAll is TJSONObject) then + if LResponse.StatusCode = 200 then begin - FResponse.SetContentText('The question cannot be answered, return object not found.' + sLineBreak + - 'Return: ' + LResponse.Content); + FResponse.SetContentText(LResponse.Content); Exit; end; - LJsonArrayCandidates := (LJsonValueAll as TJsonObject).GetValue('candidates'); - for LItemCandidates := 0 to Pred(LJsonArrayCandidates.Count) do - begin - LJsonObjContent := LJsonArrayCandidates.Items[LItemCandidates].GetValue('content'); - LJsonArrayParts := LJsonObjContent.GetValue('parts'); - for LItemParts := 0 to Pred(LJsonArrayParts.Count) do + Root := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(LResponse.Content), 0); + try + if not (Root is TJSONObject) then begin - LJsonObjParts := LJsonArrayParts.Items[LItemParts] as TJsonObject; - LResult := LResult + LJsonObjParts.GetValue('text').Trim + sLineBreak; + FResponse.SetContentText('Invalid response JSON: ' + LResponse.Content); + Exit; + end; + + ChoicesVal := TJSONObject(Root).GetValue('choices'); + if not (ChoicesVal is TJSONArray) then + begin + FResponse.SetContentText('Invalid response: choices not found' + sLineBreak + + 'Return: ' + LResponse.Content); + Exit; + end; + + Choices := TJSONArray(ChoicesVal); + if Choices.Count = 0 then + begin + FResponse.SetContentText('Invalid response: choices is empty' + sLineBreak + + 'Return: ' + LResponse.Content); + Exit; end; - end; - FResponse.SetContentText(LResult.Trim); + LResult := ''; + for I := 0 to Choices.Count - 1 do + begin + TextVal := TJSONObject(Choices.Items[I]).GetValue('text'); + if TextVal is TJSONString then + LResult := LResult + TJSONString(TextVal).Value; + end; + + LResult := LResult.Trim([#10, #13]); + + FResponse.SetContentText(LResult); + + finally + Root.Free; + end; end; end.