Function CallDeepSeekAPI(api_key As String, inputText As String) As String
Dim API As String
Dim SendTxt As String
Dim Http As Object
Dim status_code As Integer
Dim response As String
API = "https://api.deepseek.com/chat/completions"
SendTxt = "{""model"": ""deepseek-reasoner"", ""messages"": [{""role"":""system"", ""content"":""你是一個樂于助人的AI助手，請根據(jù)用戶的問題給出詳細(xì)的解答。""}, {""role"":""user"", ""content"":""" & inputText & """}], ""stream"": false}"

Set Http = CreateObject("MSXML2.XMLHTTP")
With Http
    .Open "POST", API, False
    .setRequestHeader "Content-Type", "application/json"
    .setRequestHeader "Authorization", "Bearer " & api_key
    .send SendTxt
    status_code = .Status
    response = .responseText
End With

' 彈出窗口顯示 API 響應(yīng)（調(diào)試用）

' MsgBox "API Response: " & response, vbInformation, "Debug Info"

If status_code = 200 Then
    CallDeepSeekAPI = response
Else
    CallDeepSeekAPI = "Error: " & status_code & " - " & response
End If

Set Http = Nothing
End Function
Sub DeepSeekR1()
Dim api_key As String
Dim inputText As String
Dim response As String
Dim regex As Object
Dim reasoningRegex As Object
Dim contentRegex As Object
Dim matches As Object
Dim reasoningMatches As Object
Dim originalSelection As Object
Dim reasoningContent As String
Dim finalContent As String
api_key = "替換為你的api key"
If api_key = "" Then
    MsgBox "Please enter the API key."
    Exit Sub
ElseIf Selection.Type <> wdSelectionNormal Then
    MsgBox "Please select text."
    Exit Sub
End If

' 保存原始選中的文本
Set originalSelection = Selection.Range.Duplicate

inputText = Replace(Replace(Replace(Replace(Replace(Selection.text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
response = CallDeepSeekAPI(api_key, inputText)

If Left(response, 5) <> "Error" Then
    ' 創(chuàng)建正則表達(dá)式對象來分別匹配推理內(nèi)容和最終回答
    Set reasoningRegex = CreateObject("VBScript.RegExp")
    With reasoningRegex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = """reasoning_content"":""(.*?)"""
    End With
    
    Set contentRegex = CreateObject("VBScript.RegExp")
    With contentRegex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = """content"":""(.*?)"""
    End With

    ' 提取推理內(nèi)容
    Set reasoningMatches = reasoningRegex.Execute(response)
    If reasoningMatches.Count > 0 Then
        reasoningContent = reasoningMatches(0).SubMatches(0)
        reasoningContent = Replace(reasoningContent, "\n\n", vbNewLine)
        reasoningContent = Replace(reasoningContent, "\n", vbNewLine)
        reasoningContent = Replace(Replace(reasoningContent, """", Chr(34)), """", Chr(34))
    End If

    ' 提取最終回答
    Set matches = contentRegex.Execute(response)
    If matches.Count > 0 Then
        finalContent = matches(0).SubMatches(0)
        finalContent = Replace(finalContent, "\n\n", vbNewLine)
        finalContent = Replace(finalContent, "\n", vbNewLine)
        finalContent = Replace(Replace(finalContent, """", Chr(34)), """", Chr(34))

        ' 取消選中原始文本
        Selection.Collapse Direction:=wdCollapseEnd

        ' 插入推理過程（如果存在）
        If Len(reasoningContent) > 0 Then
            Selection.TypeParagraph
            Selection.TypeText "推理過程："
            Selection.TypeParagraph
            Selection.TypeText reasoningContent
            Selection.TypeParagraph
            Selection.TypeText "最終回答："
            Selection.TypeParagraph
        End If

        ' 插入最終回答
        Selection.TypeText finalContent

        ' 將光標(biāo)移回原來選中文本的末尾
        originalSelection.Select
    Else
        MsgBox "Failed to parse API response.", vbExclamation
    End If
Else
    MsgBox response, vbCritical
End If
End Sub