AI服务中枢实战
本节内容可以参考CaseStudy目录下的文件"AIServer.foxdb"
上一节我们讲了AI服务中枢的基础概念，这一节我们搭建一个具备使用意义的AI中枢。
这个AI中枢提供了三类工具：
1、自百度地图MCP拉取的工具
2、基于本地数据表生成的工具
3、直接通过硬编码设计的工具
AI服务中枢的痛点
既然是实战，就必须考虑到一个AI服务中枢可能有几十甚至数百个用户同时使用，换个说法就是可能有数百个LLMCaller同时运行。
如果还像以前一样每个LLMCaller都各自从MCP拉取工具、从数据表生成工具，这将严重浪费服务器资源，也将严重影响服务中枢的响应速度。
解决这个痛点的思路是：
经过这样的处理后，之前的痛点就不复存在了。
服务端代码
一、AfterOpenProject的代码如下，现在这个事件不仅仅负责启动Web服务，还需要负责工具的拉取和生成，所以代码比较长：
HttpServer.Prefixes.Add("http://*:18688/")
HttpServer.Start()
'开启Web服务
Dim
caller
As
New
LLMCaller
'创建一个Caller用于存储工具定义和执行逻辑
Vars("toolCaller")
= caller
'将其存储在Var变量中，方便其他Caller从这个Caller中提取工具定义和执行逻辑
Dim
mcpRouters
As
New
Dictionary(Of
String,
String)
' MCP路由字典，可以加入多个MCP，这里只加了百度地图MCP
mcpRouters("baidu")
=
"https://mcp.map.baidu.com/mcp?ak=bYDdADrPUCNkSAID9bJU70EF8Iy5htGu"
'请替换为自己的百度AK
'从MCP路由表拉取工具并注册到LLMCaller
For
Each
key
As
String
In
mcpRouters.Keys
'遍历MCP路由表
Try
'
用Try捕获错误，避免个别MCP连接出错影响整体
Dim
mcpUrl
As
String
= mcpRouters(key)
'
获取MCP服务的地址
Dim
hc
As
New
HttpClient(mcpUrl)
hc.SkipError =
True
hc.ContentType =
"application/json"
hc.Headers.Add("Accept",
"application/json, text/event-stream")
'
核心必填项：声明客户端支持的数据格式
hc.Content =
<![CDATA[
{"jsonrpc": "2.0","id": 1,"method": "tools/list","params": {}} ]]>.Value
Dim
listResp
As
String
= hc.GetData()
Dim
listJson
As
JObject = JsonConvert.DeserializeObject(listResp)
Dim
mcpTools
As
JArray = listJson("result")("tools")
caller.AddMCPTools(mcptools, key &
"_")
'将MCP工具注册到LLMCaller,注意要加上前缀
Catch
ex
As
Exception
MessageBoxA.Show(key &
"MCP连接失败")
End
Try
Next
'从数据表中读取工具定义
For
Each
tr
As
DataRow
In
DataTables("AITools").DataRows
Dim
tool
As
AITool = caller.AddTool(tr("ToolName"),
tr("Description"))
'添加工具
For
Each
pr
As
DataRow
In
DataTables("AIParameters").Select("ToolID
= "
& tr("ToolID"),
"SortOrder")
'根据SortOrder列排序
Dim
EnumValues()
As
String
=
Nothing
If
pr.IsNull("EnumValues")
=
False
Then
EnumValues = pr("EnumValues").Split({","c,
"，"c})
'假定候选值是用逗号隔开,用户容易混淆半角逗号和全角逗号，所以将两个都作为分割符号
End
If
tool.AddParameter(pr("ParameterName"),
pr("ParameterType"),
pr("Description"),
pr("IsRequired"),
pr("ArrayItemType"),
EnumValues)
Next
Next
'
硬编码一个本地工具，它不依赖
MCP，完全由本地代码处理
Dim
localTool
As
AITool = caller.AddTool("local_hello",
"向指定的人打招呼")
localTool.AddParameter("name",
"string",
"要打招呼的人名",
True)
'
设置混合路由工具执行器
caller.ToolExecutor =
Function(ttoolName
As
String,
targs
As
JObject)
As
String
'
尝试切分前缀
Dim
spidx
As
Integer
= ttoolName.IndexOf("_")
Dim
prefix
As
String
=
""
Dim
realToolName
As
String
= ttoolName
If
spidx > 0
Then
prefix = ttoolName.Substring(0, spidx)
realToolName = ttoolName.Substring(spidx + 1)
End
If
'
如果前缀存在于路由字典中，说明是外部
MCP 工具
If
prefix <>
""
AndAlso
mcpRouters
IsNot
Nothing
AndAlso
mcpRouters.ContainsKey(prefix)
Then
Dim
targetUrl
As
String
= mcpRouters(prefix)
Try
Dim
callReq
As
New
JObject
From
{
{"jsonrpc",
"2.0"},
{"id",
Rand.NextString(10)}, {"method",
"tools/call"},
{"params",
New
JObject
From
{{"name",
realToolName}, {"arguments",
targs}}}
}
Dim
hcCall
As
New
HttpClient(targetUrl)
hcCall.SkipError =
True
hcCall.ContentType =
"application/json"
hcCall.Headers.Add("Accept",
"application/json, text/event-stream")
hcCall.Content = callReq.ToString()
Dim
resp
As
String
= hcCall.GetData()
Dim
respJson
As
JObject = JsonConvert.DeserializeObject(resp)
If
respJson("result")
IsNot
Nothing
AndAlso
respJson("result")("content")
IsNot
Nothing
Then
Dim
content
As
JArray = respJson("result")("content")
If
content.Count > 0
Then
Return
content(0)("text").ToString()
End
If
Return
"外部
MCP 调用失败："
& resp
Catch
ex
As
Exception
Return
"调用外部
MCP 异常："
& ex.Message
End
Try
Else
'
本地工具执行逻辑
Select
Case
ttoolName
Case
"compute_table"
'条件计算
Dim
tableName
As
String
= targs("table_name").ToString()
If
DataTables.Contains(tableName) =
False
Then
Return
"{""error"":""表
'"
& tableName &
"'
不存在""}"
End
If
Dim
expression
As
String
= targs("expression").ToString()
Dim
filter
As
String
=
""
If
targs.ContainsKey("filter")
Then
filter = targs("filter").ToString()
Try
Dim
dt
As
DataTable = DataTables(tableName)
Dim
result
As
Object
= dt.Compute(expression, filter)
Return
result.ToString()
Catch
ex
As
Exception
Return
"{""error"":"""
& ex.Message &
"""}"
End
Try
Case
"add_row"
'增加行
Dim
tableName
As
String
= targs("table_name").ToString()
If
DataTables.Contains(tableName) =
False
Then
Return
"{""error"":""表
'"
& tableName &
"'
不存在""}"
End
If
Dim
rowData
As
JObject = targs("row_data")
Try
Dim
dt
As
DataTable = DataTables(tableName)
Dim
dr
As
DataRow = dt.AddNew()
'
添加新行
'
遍历
row_data
中的每个键值对
For
Each
prop
As
JProperty
In
rowData.Properties()
Dim
colName
As
String
= prop.Name
Dim
colValue
As
JToken = prop.Value
If
Not
dt.DataCols.Contains(colName)
Then
'
检查列是否存在
Continue
For
'
列不存在，跳过
End
If
dr(colName) = colValue.ToString()
Next
Return
"{""message"":""行已成功添加到表
'"
& tableName &
"'，请手动保存数据。""}"
Catch
ex
As
Exception
Return
"{""error"":"""
& ex.Message &
"""}"
End
Try
Case
"get_today_date"
Return
Format(Date.Now,
"yyyy-MM-dd")
Case
"list_tables"
'辅助工具，返回所有表名，以JSON数组形式返回
Dim
nms
As
New
JArray
For
Each
dt
As
DataTable
In
DataTables
nms.Add(dt.Name)
Next
Return
nms.ToString()
Case
"get_table_schema"
'辅助工具，用于获取指定表的表结构，用JSON数组形式返回
Dim
tableName
As
String
= targs("table_name").ToString()
If
DataTables.Contains(tableName) =
False
Then
Return
"{""error"":""表
'"
& tableName &
"'
不存在""}"
End
If
Dim
dt
As
DataTable = DataTables(tableName)
Dim
columns
As
New
JArray
For
Each
dc
As
DataCol
In
dt.DataCols
Dim
column
As
New
JObject
column("name")
= dc.Name
column("type")
= dc.DataType.Name
If
dc.Expression >
""
Then
column("expression")
= dc.Expression
End
If
columns.Add(column)
Next
Return
columns.ToString()
Case
"group_statistics"
'分组统计
Dim
tableName
As
String
= targs("table_name").ToString()
'获取表名
If
Not
DataTables.Contains(tableName)
Then
Return
"{""error"":""表
'"
& tableName &
"'
不存在""}"
End
If
Dim
groupCols
As
JArray = targs("group_columns")
'分组列
Dim
aggCols
As
JArray = targs("aggregates")
'统计列
Dim
dt
As
DataTable = DataTables(tableName)
Dim
gb
As
New
GroupTableBuilder("临时统计表",
dt)
For
Each
gcol
As
String
In
groupCols
'处理分组列
Dim
parts()
As
String
= gcol.Split("|"c)
Dim
colName
As
String
= parts(0)
'列名
If
dt.DataCols(colName).IsDate
Then
'如果
是日期列，根据工具定义：日期列格式严格按照'列名|日期分组颗粒度|新列名'
Dim
groupMode
As
DateGroupEnum = DateGroupEnum.Month
'默认按月分组
If
parts.Length > 1
Then
[Enum].TryParse(Of
DateGroupEnum)(parts(1),
True,
groupMode)
'出于健壮考虑，还是判断一下
Dim
aliasName
As
String
=
If(parts.Length
> 2, parts(2),
"")
'新列名，新列名为空会忽略
gb.Groups.AddDef(colName, groupMode, aliasName)
Else
'非日期列
If
parts.Length = 1
Then
gb.Groups.AddDef(colName)
ElseIf
parts.Length > 1
Then
gb.Groups.AddDef(colName, parts(1))
'指定了新列名
End
If
End
If
Next
For
Each
aggItem
As
String
In
aggCols
'处理统计列
Dim
parts()
As
String
= aggItem.Split("|"c)
Dim
colName
As
String
= parts(0)
'列名
Dim
aggMethod
As
String
=
If(parts.Length
> 1, parts(1).ToLower(),
"sum")
'统计类型
Dim
aliasName
As
String
=
If(parts.Length
> 2, parts(2),
"")
'新列名，新列名为空会忽略
Dim
aggType
As
AggregateEnum = AggregateEnum.Sum
If
aggMethod >
""
Then
[Enum].TryParse(Of
AggregateEnum)(aggMethod,
True,
aggType)
End
If
gb.Totals.AddDef(colName, aggType, aliasName)
Next
If
targs.ContainsKey("filter")
Then
gb.Filter = targs("filter").ToString()
If
targs.ContainsKey("same_period_growth")
Then
gb.SamePeriodGrowth = targs("same_period_growth").ToObject(Of
Boolean)()
If
targs.ContainsKey("circle_growth")
Then
gb.CircleGrowth = targs("circle_growth").ToObject(Of
Boolean)()
If
targs.ContainsKey("grand_proportion")
Then
gb.GrandProportion = targs("grand_proportion").ToObject(Of
Boolean)()
If
targs.ContainsKey("group_proportion")
Then
gb.GroupProportion = targs("group_proportion").ToObject(Of
Boolean)()
Dim
resultTable
As
DataTable = gb.Build(True)
Dim
resultJson
As
New
JObject
'
列名数组
Dim
colNames
As
New
JArray
For
Each
dc
As
DataCol
In
resultTable.DataCols
colNames.Add(dc.Caption)
'用的列标题代替列名称，因为统计表的列名可能不具备实际意义
Next
resultJson("columns")
= colNames
'行数据（最多给AI返回1000行）
Dim
rows
As
New
JArray
Dim
maxRows
As
Integer
= Math.Min(resultTable.dataRows.Count, 1000)
For
r
As
Integer
= 0
To
maxRows - 1
Dim
dr
As
DataRow = resultTable.DataRows(r)
Dim
rowArray
As
New
JArray
For
Each
dc
As
DataCol
In
resultTable.DataCols
If
dr.IsNull(dc)
Then
rowArray.Add(Nothing)
Else
rowArray.Add(dr(dc.Name))
End
If
Next
rows.Add(rowArray)
Next
resultJson("data")
= rows
Return
resultJson.ToString()
Case
"local_hello"
Dim
personName
As
String
= targs("name").ToString()
Return
"你好，"
& personName &
"！这是来自
Foxtable
本地代码的专属问候！"
Case
Else
Return
"未知工具："
& ttoolName
End
Select
End
If
End
Function
二、在HttpRequest事件中，接收客户端的提问并转发给大模型：
'''Async
If
e.Path =
"ask"
Then
e.AsyncExecute =
True
Await
Functions.ExecuteAsync("HandleAsk",
e)
e.Handled =
True
Else
e.WriteString("AI
Service Hub is running.")
End
If
三、创建自定义函数HandleAsk，这个函数负责创建LLMCaller、从toolCaller中提取工具定义和执行逻辑、访问大模型并维护上下文：
Dim
e
As
RequestEventArgs = Args(0)
Dim
apiKey
As
String
=
"sk-a734b83536da45e9aedc3e42605bfb3a"
'
请替换为自己的APIKey
' ==================== 1.
接收客户端数据
====================
Dim
req
As
JObject = JsonConvert.DeserializeObject(e.PlainText)
Dim
userId
As
String
= req("user_id").ToString()
Dim
question
As
String
= req("question").ToString()
Dim
clientMessages
As
JArray = req("messages")
'
==================== 2.
构造
LLMCaller ====================
Dim
toolCaller
As
LLMCaller = Vars("toolCaller")
Dim
caller
As
New
LLMCaller("https://api.deepseek.com/chat/completions",
"deepseek-flash",
apiKey)
caller.SystemPrompt =
"你是一个全能的数据分析助手。你可以调用百度地图工具，也可以直接查询、统计本地数据表。请自主规划并完成用户需求。"
If
clientMessages
IsNot
Nothing
AndAlso
clientMessages.Count > 0
Then
caller.Messages = clientMessages
Else
caller.Messages =
New
JArray()
End
If
caller.extra_body.user_id = userId
'注入
user_id，实现
KVCache、调度与安全物理隔离
caller.Tools = toolCaller.Tools
'从toolCaller获取工具定义
caller.ToolExecutor = toolCaller.ToolExecutor
'从toolCaller获取工具执行逻辑
'
==================== 3.
调用大模型并返回
====================
caller.UserMessage = question
Dim
respObj
As
New
JObject()
If
caller.GetResult()
Then
respObj("success")
=
True
respObj("answer")
= caller.Result
respObj("think")
= caller.Think
respObj("messages")
= caller.Messages
Else
respObj("success")
=
False
respObj("error")
= caller.Error
End
If
e.WriteString(respObj.ToString(),
"application/json")
客户端代码
员工电脑上的 Foxtable 客户端，极其轻量，完全没有工具定义的代码，只负责收发。
以下代码可在另一个项目的命令窗口执行：
'''Async
Dim
userId
As
String
=
"EMP_1001"
'
当前登录员工的身份标识
Dim
questions()
As
String
= {"2025年的销冠是哪个员工",
"2026年呢",
"向狐狸爸爸问好",
"从北京天安门到故宫的步行路线?"}
Dim
messages
As
New
JArray()
'用于保存对话历史的JArray
Dim
hc
As
New
HttpClient("http://127.0.0.1:18688/ask")
hc.SkipError =
True
hc.ContentType =
"application/json"
For
Each
question
As
String
In
questions
hc = hc.Clone()
'HttpClient不能复用，必须克隆
'
构造请求体
Dim
reqObj
As
New
JObject()
reqObj("user_id")
= userId
reqObj("question")
= question
reqObj("messages")
= messages
'开启多轮对话
hc.Content = reqObj.ToString()
Dim
res
As
String
= hc.GetData()
If
hc.StatusCode = 200
Then
Dim
respObj
As
JObject = JsonConvert.DeserializeObject(res)
If
respObj("success").ToObject(Of
Boolean)()
Then
MessageBox.Show(respObj("answer").ToString())
messages = respObj("messages")
'对话历史存入本地，用于下一轮对话继续发送
Else
MessageBox.Show("AI
报错："
& respObj("error").ToString())
End
If
Else
MessageBox.Show("无法连接到
AI 服务器，请检查网络。")
End
If
Next