跳转至

Delphi对接ChatGPT实战指南

在这个AI快速发展的时代，如何让我们熟悉的Delphi也能搭上AI的快车？本文将详细介绍如何在Delphi中集成ChatGPT API，打造属于自己的AI助手。

前言

作为一名"老炮"程序员，我深知Delphi在开发效率和程序性能上的优势。现在，让我们给它注入AI的能力，将传统应用提升到一个新的水平。

技术准备

在开始之前，我们需要准备以下资源：

  1. Delphi 10.4或更高版本：本文示例基于Delphi 11，但10.4及以上版本都应该可以正常工作。

  2. OpenAI API密钥：访问OpenAI官网注册并获取API密钥。

  3. REST客户端组件：可以使用Delphi自带的REST组件，也可以选择第三方组件如Indy或REST Debugger。

实现步骤

1. 环境搭建

首先，创建一个新的Delphi VCL或FMX应用程序，并添加必要的组件：

// 在窗体上添加以下组件
// TRESTClient, TRESTRequest, TRESTResponse, TRESTResponseDataSetAdapter
// TMemo (用于输入), TMemo (用于显示结果), TButton (发送请求)

设置REST组件的基本属性：

procedure TForm1.FormCreate(Sender: TObject);
begin
  RESTClient1.BaseURL := 'https://api.openai.com/v1';
  RESTRequest1.Resource := 'chat/completions';
  RESTRequest1.Method := TRESTRequestMethod.rmPOST;

  // 添加API密钥到请求头
  RESTRequest1.Params.AddHeader('Authorization', 'Bearer YOUR_API_KEY_HERE');
  RESTRequest1.Params.AddHeader('Content-Type', 'application/json');

  // 设置响应格式
  RESTRequest1.Response := RESTResponse1;
end;

2. API封装

创建一个专门的单元来封装ChatGPT API调用：

unit ChatGPTAPI;

interface

uses
  System.SysUtils, System.Classes, System.JSON, REST.Client, REST.Types;

type
  TChatGPTAPI = class
  private
    FRESTClient: TRESTClient;
    FRESTRequest: TRESTRequest;
    FRESTResponse: TRESTResponse;
    FAPIKey: string;
    FModel: string;
    FMaxTokens: Integer;
    FTemperature: Double;
  public
    constructor Create(const APIKey: string);
    destructor Destroy; override;

    function SendPrompt(const Prompt: string): string;
    function SendChatMessage(const Messages: TJSONArray): string;

    property Model: string read FModel write FModel;
    property MaxTokens: Integer read FMaxTokens write FMaxTokens;
    property Temperature: Double read FTemperature write FTemperature;
  end;

implementation

constructor TChatGPTAPI.Create(const APIKey: string);
begin
  inherited Create;

  FAPIKey := APIKey;
  FModel := 'gpt-3.5-turbo';
  FMaxTokens := 1000;
  FTemperature := 0.7;

  FRESTClient := TRESTClient.Create(nil);
  FRESTRequest := TRESTRequest.Create(nil);
  FRESTResponse := TRESTResponse.Create(nil);

  FRESTClient.BaseURL := 'https://api.openai.com/v1';
  FRESTRequest.Client := FRESTClient;
  FRESTRequest.Response := FRESTResponse;
  FRESTRequest.Method := TRESTRequestMethod.rmPOST;
  FRESTRequest.Resource := 'chat/completions';

  FRESTRequest.Params.AddHeader('Authorization', 'Bearer ' + FAPIKey);
  FRESTRequest.Params.AddHeader('Content-Type', 'application/json');
end;

destructor TChatGPTAPI.Destroy;
begin
  FRESTResponse.Free;
  FRESTRequest.Free;
  FRESTClient.Free;

  inherited;
end;

function TChatGPTAPI.SendPrompt(const Prompt: string): string;
var
  Messages: TJSONArray;
  MessageObj: TJSONObject;
begin
  Messages := TJSONArray.Create;
  try
    MessageObj := TJSONObject.Create;
    MessageObj.AddPair('role', 'user');
    MessageObj.AddPair('content', Prompt);
    Messages.AddElement(MessageObj);

    Result := SendChatMessage(Messages);
  finally
    Messages.Free;
  end;
end;

function TChatGPTAPI.SendChatMessage(const Messages: TJSONArray): string;
var
  RequestBody: TJSONObject;
  ResponseObj: TJSONObject;
  Choices: TJSONArray;
  Choice: TJSONObject;
  Message: TJSONObject;
begin
  Result := '';

  RequestBody := TJSONObject.Create;
  try
    RequestBody.AddPair('model', FModel);
    RequestBody.AddPair('messages', Messages.Clone as TJSONArray);
    RequestBody.AddPair('max_tokens', TJSONNumber.Create(FMaxTokens));
    RequestBody.AddPair('temperature', TJSONNumber.Create(FTemperature));

    FRESTRequest.Body.JSONObject := RequestBody;

    try
      FRESTRequest.Execute;

      if FRESTResponse.StatusCode = 200 then
      begin
        ResponseObj := FRESTResponse.JSONObject;
        Choices := ResponseObj.GetValue('choices') as TJSONArray;

        if (Choices <> nil) and (Choices.Count > 0) then
        begin
          Choice := Choices.Items[0] as TJSONObject;
          Message := Choice.GetValue('message') as TJSONObject;
          Result := Message.GetValue('content').Value;
        end;
      end
      else
      begin
        Result := 'Error: ' + FRESTResponse.StatusText;
      end;
    except
      on E: Exception do
        Result := 'Exception: ' + E.Message;
    end;
  finally
    // 不要释放RequestBody，因为它已经被赋值给FRESTRequest.Body.JSONObject
  end;
end;

end.

3. 界面设计

设计一个简单的聊天界面，包括： - 输入框（用户输入问题） - 发送按钮 - 聊天历史记录显示区域

// 在窗体上添加以下组件
// TMemo (InputMemo) - 用于用户输入
// TMemo (ChatHistoryMemo) - 用于显示聊天历史
// TButton (SendButton) - 发送按钮

实现发送按钮的点击事件：

procedure TForm1.SendButtonClick(Sender: TObject);
var
  UserMessage: string;
  AIResponse: string;
begin
  UserMessage := InputMemo.Text;
  if Trim(UserMessage) = '' then Exit;

  // 显示用户消息
  ChatHistoryMemo.Lines.Add('You: ' + UserMessage);
  InputMemo.Clear;

  // 禁用发送按钮，显示正在处理
  SendButton.Enabled := False;
  ChatHistoryMemo.Lines.Add('AI: Thinking...');
  Application.ProcessMessages;

  try
    // 调用API获取回复
    AIResponse := ChatGPTAPI.SendPrompt(UserMessage);

    // 更新聊天历史
    ChatHistoryMemo.Lines.Delete(ChatHistoryMemo.Lines.Count - 1); // 删除"Thinking..."
    ChatHistoryMemo.Lines.Add('AI: ' + AIResponse);
  finally
    SendButton.Enabled := True;
  end;
end;

4. 实现对话历史记录

为了实现连续对话，我们需要保存对话历史：

unit ChatHistory;

interface

uses
  System.SysUtils, System.Classes, System.JSON;

type
  TChatMessage = record
    Role: string;
    Content: string;
  end;

  TChatHistory = class
  private
    FMessages: TJSONArray;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddMessage(const Role, Content: string);
    function GetMessagesAsJSON: TJSONArray;
    procedure Clear;
  end;

implementation

constructor TChatHistory.Create;
begin
  inherited;
  FMessages := TJSONArray.Create;
end;

destructor TChatHistory.Destroy;
begin
  FMessages.Free;
  inherited;
end;

procedure TChatHistory.AddMessage(const Role, Content: string);
var
  MessageObj: TJSONObject;
begin
  MessageObj := TJSONObject.Create;
  MessageObj.AddPair('role', Role);
  MessageObj.AddPair('content', Content);
  FMessages.AddElement(MessageObj);
end;

function TChatHistory.GetMessagesAsJSON: TJSONArray;
begin
  Result := FMessages.Clone as TJSONArray;
end;

procedure TChatHistory.Clear;
begin
  FMessages.Free;
  FMessages := TJSONArray.Create;
end;

end.

然后在主窗体中使用这个类：

unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  REST.Client, REST.Types, ChatGPTAPI, ChatHistory;

type
  TForm1 = class(TForm)
    InputMemo: TMemo;
    ChatHistoryMemo: TMemo;
    SendButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
  private
    FChatGPTAPI: TChatGPTAPI;
    FChatHistory: TChatHistory;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FChatGPTAPI := TChatGPTAPI.Create('YOUR_API_KEY_HERE');
  FChatHistory := TChatHistory.Create;

  // 添加系统消息，设置AI助手的角色
  FChatHistory.AddMessage('system', '你是一个有用的助手，用简洁明了的中文回答问题。');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FChatHistory.Free;
  FChatGPTAPI.Free;
end;

procedure TForm1.SendButtonClick(Sender: TObject);
var
  UserMessage: string;
  AIResponse: string;
begin
  UserMessage := InputMemo.Text;
  if Trim(UserMessage) = '' then Exit;

  // 显示用户消息
  ChatHistoryMemo.Lines.Add('You: ' + UserMessage);
  InputMemo.Clear;

  // 添加到历史记录
  FChatHistory.AddMessage('user', UserMessage);

  // 禁用发送按钮，显示正在处理
  SendButton.Enabled := False;
  ChatHistoryMemo.Lines.Add('AI: Thinking...');
  Application.ProcessMessages;

  try
    // 调用API获取回复
    AIResponse := FChatGPTAPI.SendChatMessage(FChatHistory.GetMessagesAsJSON);

    // 添加AI回复到历史记录
    FChatHistory.AddMessage('assistant', AIResponse);

    // 更新聊天历史
    ChatHistoryMemo.Lines.Delete(ChatHistoryMemo.Lines.Count - 1); // 删除"Thinking..."
    ChatHistoryMemo.Lines.Add('AI: ' + AIResponse);
  finally
    SendButton.Enabled := True;
  end;
end;

end.

高级功能实现

1. 流式响应

OpenAI API支持流式响应，可以实现打字机效果：

function TChatGPTAPI.SendStreamingPrompt(const Messages: TJSONArray; 
  OnChunkReceived: TProc<string>): string;
var
  RequestBody: TJSONObject;
  HttpClient: THTTPClient;
  Response: IHTTPResponse;
  Stream: TStringStream;
  Line: string;
  JSONObj: TJSONObject;
  Choices: TJSONArray;
  Choice: TJSONObject;
  Delta: TJSONObject;
  Content: string;
  FullResponse: string;
begin
  Result := '';
  FullResponse := '';

  RequestBody := TJSONObject.Create;
  try
    RequestBody.AddPair('model', FModel);
    RequestBody.AddPair('messages', Messages.Clone as TJSONArray);
    RequestBody.AddPair('max_tokens', TJSONNumber.Create(FMaxTokens));
    RequestBody.AddPair('temperature', TJSONNumber.Create(FTemperature));
    RequestBody.AddPair('stream', TJSONBool.Create(True));

    HttpClient := THTTPClient.Create;
    try
      HttpClient.CustomHeaders['Authorization'] := 'Bearer ' + FAPIKey;
      HttpClient.CustomHeaders['Content-Type'] := 'application/json';

      Stream := TStringStream.Create('');
      try
        Response := HttpClient.Post('https://api.openai.com/v1/chat/completions', 
          TStringStream.Create(RequestBody.ToJSON), Stream);

        if Response.StatusCode = 200 then
        begin
          Stream.Position := 0;
          while not Stream.EOS do
          begin
            Line := Stream.ReadLine;
            if Line.StartsWith('data: ') and (Line <> 'data: [DONE]') then
            begin
              Line := Line.Substring(6);
              try
                JSONObj := TJSONObject.ParseJSONValue(Line) as TJSONObject;
                try
                  Choices := JSONObj.GetValue('choices') as TJSONArray;
                  if (Choices <> nil) and (Choices.Count > 0) then
                  begin
                    Choice := Choices.Items[0] as TJSONObject;
                    Delta := Choice.GetValue('delta') as TJSONObject;
                    if (Delta <> nil) and Delta.TryGetValue('content', Content) then
                    begin
                      FullResponse := FullResponse + Content;
                      if Assigned(OnChunkReceived) then
                        OnChunkReceived(Content);
                    end;
                  end;
                finally
                  JSONObj.Free;
                end;
              except
                // 忽略解析错误
              end;
            end;
          end;
        end
        else
        begin
          Result := 'Error: ' + Response.StatusText;
        end;
      finally
        Stream.Free;
      end;
    finally
      HttpClient.Free;
    end;
  finally
    RequestBody.Free;
  end;

  Result := FullResponse;
end;

在窗体中使用流式响应：

procedure TForm1.SendButtonClick(Sender: TObject);
var
  UserMessage: string;
  CurrentLine: Integer;
begin
  UserMessage := InputMemo.Text;
  if Trim(UserMessage) = '' then Exit;

  // 显示用户消息
  ChatHistoryMemo.Lines.Add('You: ' + UserMessage);
  InputMemo.Clear;

  // 添加到历史记录
  FChatHistory.AddMessage('user', UserMessage);

  // 禁用发送按钮，显示正在处理
  SendButton.Enabled := False;
  ChatHistoryMemo.Lines.Add('AI: ');
  CurrentLine := ChatHistoryMemo.Lines.Count - 1;
  Application.ProcessMessages;

  try
    // 调用流式API
    FChatGPTAPI.SendStreamingPrompt(FChatHistory.GetMessagesAsJSON,
      procedure(const Chunk: string)
      begin
        // 更新UI（需要同步到主线程）
        TThread.Synchronize(nil,
          procedure
          begin
            ChatHistoryMemo.Lines[CurrentLine] := 'AI: ' + 
              ChatHistoryMemo.Lines[CurrentLine].Substring(4) + Chunk;
            // 滚动到底部
            SendMessage(ChatHistoryMemo.Handle, EM_SCROLLCARET, 0, 0);
          end);
      end);

    // 获取完整响应并添加到历史
    FChatHistory.AddMessage('assistant', ChatHistoryMemo.Lines[CurrentLine].Substring(4));
  finally
    SendButton.Enabled := True;
  end;
end;

2. 函数调用

OpenAI API支持函数调用，可以让AI调用我们定义的函数：

type
  TFunctionDefinition = record
    Name: string;
    Description: string;
    Parameters: TJSONObject;
  end;

  TFunctionCall = record
    Name: string;
    Arguments: string;
  end;

  TFunctionCallHandler = reference to function(const FunctionName, Arguments: string): string;

// 在TChatGPTAPI类中添加
procedure TChatGPTAPI.AddFunction(const FunctionDef: TFunctionDefinition);
var
  FunctionObj: TJSONObject;
begin
  if FFunctions = nil then
    FFunctions := TJSONArray.Create;

  FunctionObj := TJSONObject.Create;
  FunctionObj.AddPair('name', FunctionDef.Name);
  FunctionObj.AddPair('description', FunctionDef.Description);
  FunctionObj.AddPair('parameters', FunctionDef.Parameters.Clone as TJSONObject);

  FFunctions.AddElement(FunctionObj);
end;

function TChatGPTAPI.SendChatMessageWithFunctions(const Messages: TJSONArray; 
  FunctionCallHandler: TFunctionCallHandler): string;
var
  RequestBody, ResponseObj, FunctionCallObj: TJSONObject;
  Choices: TJSONArray;
  Choice, Message: TJSONObject;
  FunctionCall: TFunctionCall;
  FunctionResponse: string;
  NewMessages: TJSONArray;
begin
  Result := '';

  RequestBody := TJSONObject.Create;
  try
    RequestBody.AddPair('model', FModel);
    RequestBody.AddPair('messages', Messages.Clone as TJSONArray);
    RequestBody.AddPair('max_tokens', TJSONNumber.Create(FMaxTokens));
    RequestBody.AddPair('temperature', TJSONNumber.Create(FTemperature));

    if FFunctions <> nil then
      RequestBody.AddPair('functions', FFunctions.Clone as TJSONArray);

    FRESTRequest.Body.JSONObject := RequestBody;

    try
      FRESTRequest.Execute;

      if FRESTResponse.StatusCode = 200 then
      begin
        ResponseObj := FRESTResponse.JSONObject;
        Choices := ResponseObj.GetValue('choices') as TJSONArray;

        if (Choices <> nil) and (Choices.Count > 0) then
        begin
          Choice := Choices.Items[0] as TJSONObject;
          Message := Choice.GetValue('message') as TJSONObject;

          // 检查是否有函数调用
          if Message.TryGetValue('function_call', FunctionCallObj) then
          begin
            // 解析函数调用
            FunctionCall.Name := FunctionCallObj.GetValue('name').Value;
            FunctionCall.Arguments := FunctionCallObj.GetValue('arguments').Value;

            // 调用处理函数
            if Assigned(FunctionCallHandler) then
              FunctionResponse := FunctionCallHandler(FunctionCall.Name, FunctionCall.Arguments);

            // 创建新的消息数组，包含函数调用结果
            NewMessages := Messages.Clone as TJSONArray;

            // 添加AI的函数调用消息
            var AIMessage := TJSONObject.Create;
            AIMessage.AddPair('role', 'assistant');
            AIMessage.AddPair('content', TJSONNull.Create);
            AIMessage.AddPair('function_call', FunctionCallObj.Clone as TJSONObject);
            NewMessages.AddElement(AIMessage);

            // 添加函数响应消息
            var FunctionMessage := TJSONObject.Create;
            FunctionMessage.AddPair('role', 'function');
            FunctionMessage.AddPair('name', FunctionCall.Name);
            FunctionMessage.AddPair('content', FunctionResponse);
            NewMessages.AddElement(FunctionMessage);

            // 递归调用，但不再传递函数处理器，避免无限循环
            Result := SendChatMessage(NewMessages);

            NewMessages.Free;
          end
          else
          begin
            // 普通消息响应
            Result := Message.GetValue('content').Value;
          end;
        end;
      end
      else
      begin
        Result := 'Error: ' + FRESTResponse.StatusText;
      end;
    except
      on E: Exception do
        Result := 'Exception: ' + E.Message;
    end;
  finally
    // 不要释放RequestBody
  end;
end;

使用函数调用功能：

procedure TForm1.FormCreate(Sender: TObject);
var
  WeatherFunctionDef: TFunctionDefinition;
  ParametersObj: TJSONObject;
  PropertiesObj: TJSONObject;
  LocationObj, UnitObj: TJSONObject;
begin
  FChatGPTAPI := TChatGPTAPI.Create('YOUR_API_KEY_HERE');
  FChatHistory := TChatHistory.Create;

  // 定义天气查询函数
  WeatherFunctionDef.Name := 'get_current_weather';
  WeatherFunctionDef.Description := '获取指定位置的当前天气';

  ParametersObj := TJSONObject.Create;
  ParametersObj.AddPair('type', 'object');

  PropertiesObj := TJSONObject.Create;

  LocationObj := TJSONObject.Create;
  LocationObj.AddPair('type', 'string');
  LocationObj.AddPair('description', '城市名称，如北京、上海');

  UnitObj := TJSONObject.Create;
  UnitObj.AddPair('type', 'string');
  UnitObj.AddPair('enum', TJSONArray.Create(['celsius', 'fahrenheit']));
  UnitObj.AddPair('description', '温度单位');

  PropertiesObj.AddPair('location', LocationObj);
  PropertiesObj.AddPair('unit', UnitObj);

  ParametersObj.AddPair('properties', PropertiesObj);
  ParametersObj.AddPair('required', TJSONArray.Create(['location']));

  WeatherFunctionDef.Parameters := ParametersObj;

  // 添加函数定义
  FChatGPTAPI.AddFunction(WeatherFunctionDef);

  // 添加系统消息
  FChatHistory.AddMessage('system', '你是一个有用的助手，可以回答问题并查询天气信息。');
end;

procedure TForm1.SendButtonClick(Sender: TObject);
var
  UserMessage: string;
  AIResponse: string;
begin
  UserMessage := InputMemo.Text;
  if Trim(UserMessage) = '' then Exit;

  // 显示用户消息
  ChatHistoryMemo.Lines.Add('You: ' + UserMessage);
  InputMemo.Clear;

  // 添加到历史记录
  FChatHistory.AddMessage('user', UserMessage);

  // 禁用发送按钮，显示正在处理
  SendButton.Enabled := False;
  ChatHistoryMemo.Lines.Add('AI: Thinking...');
  Application.ProcessMessages;

  try
    // 调用API获取回复，包含函数处理
    AIResponse := FChatGPTAPI.SendChatMessageWithFunctions(
      FChatHistory.GetMessagesAsJSON,
      function(const FunctionName, Arguments: string): string
      var
        ArgsObj: TJSONObject;
        Location, Unit_: string;
        Temperature: Integer;
      begin
        if FunctionName = 'get_current_weather' then
        begin
          ArgsObj := TJSONObject.ParseJSONValue(Arguments) as TJSONObject;
          try
            Location := ArgsObj.GetValue('location').Value;
            if ArgsObj.TryGetValue('unit', Unit_) then
              Unit_ := 'celsius';

            // 这里应该是实际的天气API调用，这里简化处理
            Randomize;
            Temperature := Random(30);

            Result := Format('{"location": "%s", "temperature": %d, "unit": "%s", "condition": "晴朗"}',
              [Location, Temperature, Unit_]);
          finally
            ArgsObj.Free;
          end;
        end
        else
        begin
          Result := '{"error": "Unknown function"}';
        end;
      end);

    // 添加AI回复到历史记录
    FChatHistory.AddMessage('assistant', AIResponse);

    // 更新聊天历史
    ChatHistoryMemo.Lines.Delete(ChatHistoryMemo.Lines.Count - 1); // 删除"Thinking..."
    ChatHistoryMemo.Lines.Add('AI: ' + AIResponse);
  finally
    SendButton.Enabled := True;
  end;
end;

实战案例

智能客服系统

结合以上技术，我们可以创建一个智能客服系统：

  1. 添加知识库功能，让AI能够回答关于产品的问题
  2. 集成函数调用，允许AI查询订单状态、产品库存等
  3. 实现对话历史保存和加载，方便用户查看历史对话
  4. 添加用户反馈机制，不断优化AI回答质量

代码助手

为开发者创建一个Delphi代码助手：

  1. 让AI理解Delphi语法和常用组件
  2. 实现代码生成、代码解释和代码优化功能
  3. 添加代码片段库，方便快速插入常用代码
  4. 集成到IDE中，提供实时编码建议

注意事项

  1. API密钥安全：不要在代码中硬编码API密钥，应该使用配置文件或环境变量
  2. 错误处理：添加完善的错误处理机制，处理网络问题和API限制
  3. 用户体验：使用流式响应提高用户体验，避免长时间等待
  4. 成本控制：监控API使用情况，避免意外的高额费用
  5. 内容过滤：根据需要添加内容过滤，避免不适当的内容

总结

通过本文的实践，我们成功地将现代AI能力注入传统Delphi应用，打造了一个功能强大的ChatGPT客户端。这不仅提升了应用的智能化水平，还为用户提供了更加便捷的AI交互体验。

随着AI技术的不断发展，Delphi应用与AI的结合将会有更多可能性。希望本文能够帮助更多Delphi开发者踏上AI集成之旅，创造出更加智能、更有价值的应用程序。

如果你有任何问题或建议，欢迎在评论区留言交流！