ttw_fmx_v10/Services/uChatAPI.pas

unit uChatAPI;

interface

uses
  Classes, SysUtils, IdHTTP, System.JSON, IdSSLOpenSSL, IdGlobal;

type
  TMessage = procedure(s: string) of object;

type
  TChatAPI = class(TObject)
  protected
    FToken_api: string;
    FPrefix: string;
    FOnError: TMessage;
    function GetOtvetFromJson(jsonString: string; isOllama: boolean = false)
      : string; virtual;
    function CreateHTTPRequest(const url: string; const params: TStringStream;
      isOllama: boolean = false): string;

  public
    constructor Create(Sender: TObject; aToken: string;
      aprefix: string = ''); virtual;
    destructor Destroy; override;
    function GetGPTRequest(url: string; model: string; q: string;
      isOllama: boolean = false): string;
    property OnError: TMessage read FOnError write FOnError;
  end;

implementation

{ TChatAPI }

constructor TChatAPI.Create(Sender: TObject; aToken: string;
  aprefix: string = '');
begin
  FPrefix := aprefix;
  FToken_api := aToken;
end;

function TChatAPI.CreateHTTPRequest(const url: string;
  const params: TStringStream; isOllama: boolean = false): string;
var
  http: TIdHTTP;
  ssl: TIdSSLIOHandlerSocketOpenSSL;
  otv: string;
begin
  http := TIdHTTP.Create(nil);
  ssl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  try
    http.IOHandler := ssl;
    ssl.SSLOptions.method := sslvSSLv23;
    http.Request.UserAgent :=
      'Mozilla/5.0 (Windows NT 10.0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36';
    http.Request.CustomHeaders.Clear;
    // http.Request.CustomHeaders.Add('Content-Type: application/json; charset=utf-8');
    http.Request.ContentType := 'application/json; charset=utf-8';

    if FToken_api <> '' then
      http.Request.CustomHeaders.Add('Authorization: Bearer ' + FToken_api);
    http.Request.Accept := 'application/json; charset=utf-8';
    http.Request.CharSet := 'utf-8';
    http.Response.CharSet := 'utf-8';
    // http.Request.CustomHeaders.Add('Accept: application/json; charset=utf-8');
    http.Response.ContentEncoding := 'utf-8';
    http.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
    http.Request.ContentEncoding := 'utf-8';

    try
      otv := http.Post(url, params);
      Result := GetOtvetFromJson(otv, isOllama);
    except
      on E: Exception do
        if Assigned(OnError) then
          OnError(E.Message);
    end;
  finally
    params.Free;
    http.Free;
    ssl.Free;
  end;
end;

destructor TChatAPI.Destroy;
begin
  inherited;
end;

function ReplaceDelphiHexCodes(const InputStr: string): string;
var
  I, Start, HexVal: Integer;
  HexStr: string;
begin
  Result := '';
  I := 1;
  while I <= Length(InputStr) do
  begin
    if (I <= Length(InputStr) - 5) and (InputStr[I] = '#') and
      (InputStr[I + 1] = '$') then
    begin
      HexStr := Copy(InputStr, I + 2, 4);
      if TryStrToInt('$' + HexStr, HexVal) then
      begin
        Result := Result + WideChar(HexVal);
        Inc(I, 6); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> #$XXXX
        Continue;
      end;
    end;
    Result := Result + InputStr[I];
    Inc(I);
  end;
end;

function ConvertAnsiToUtf8(const AStr: string): string;
var
  AnsiBytes: TBytes;
begin
  AnsiBytes := TEncoding.ANSI.GetBytes(AStr);
  Result := TEncoding.UTF8.GetString(AnsiBytes);
end;

function TChatAPI.GetOtvetFromJson(jsonString: string;
  isOllama: boolean = false): string;
var
  JSON: TJSONObject;
  dataArray: TJSONArray;
  JSONValue: TJSONValue;
  JsonParts: TStringList;
  I: Integer;
  CleanedJson: string;
  JsonObj: TJSONObject;
  ResponseStr, FullResponse: string;
begin

  Result := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!';
  if isOllama then
  begin
    JSON := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
    try
      if Assigned(JSON) then
      begin
        JSONValue := TJSONObject(JSON);
        if JSONValue.TryGetValue('response', JSONValue) then
          Result := JSONValue.Value;
      end;
    finally
      JSON.Free;
    end;
  end
  else
  begin
    JSON := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
    try
      if Assigned(JSON) then
      begin
        if JSON.TryGetValue('messages', JSONValue) then
        begin
          dataArray := JSONValue as TJSONArray;
          if Assigned(dataArray) and (dataArray.Count > 0) then
            Result := dataArray.Items[0].GetValue<string>('content');
        end;
      end;
    finally
      JSON.Free;
    end;
  end;
end;

function TChatAPI.GetGPTRequest(url: string; model: string; q: string;
  isOllama: boolean = false): string;
var
  params: TStringStream;
  r: string;
begin

  q := StringReplace(q, '"', '''', [rfReplaceAll]);
  if isOllama then
    params := TStringStream.Create('{ "model": "' + model + '", "prompt": "' +
      FPrefix + q + '", "stream": false }', TEncoding.UTF8)
  else
    params := TStringStream.Create('{ "model": "' + model +
      '", "messages": [{ "role": "user", "content": "' + FPrefix + q +
      '" }], "stream": false }', CP_UTF8);

  try
    r := CreateHTTPRequest(url, params, isOllama);
  finally
    // params.Free;
  end;
  Result := r;

end;

end.