本地Ollama部署DeepSeek R1模型接入Word

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地址    API = "http://localhost:11434/api/chat"        ' 修改请求体为与本地大模型相匹配的格式    SendTxt = "{""model"": ""deepseek-r1:1.5b"", ""messages"": [{""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 响应（调试用）    ' MsgBox "API Response: " & response, vbInformation, "Debug Info"               If status_code = 200 Then        CallDeepSeekAPI = response    Else        CallDeepSeekAPI = "Error: " & status_code & " - " & response    End If               Set Http = NothingEnd Function           Sub DeepSeekV3()    Dim api_key As String    Dim inputText As String    Dim response As String    Dim regex As Object    Dim matches As Object        Dim originalSelection As Object               api_key = "pass"    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        Set regex = CreateObject("VBScript.RegExp")                ' 步骤1：提取大模型回复内容            With regex            .Global = True            .MultiLine = True            .Pattern = """content"":\s*""([\s\S]*?)"""  ' 更稳健的提取逻辑        End With        If regex.Test(response) Then            response = regex.Execute(response)(0).SubMatches(0)                        ' 步骤2：处理Unicode转义字符（如\u003c -> <）            response = Replace(response, "\u003c", "<")            response = Replace(response, "\u003e", ">")                        ' 步骤3：删除标签及其内容            With regex                .Global = True                .MultiLine = True                .IgnoreCase = True                .Pattern = "[\s\S]*?"            End With            response = regex.Replace(response, "")                        ' 步骤4：转换\n为实际换行符                response = Replace(response, "\n", vbCrLf)                        ' 步骤5：移除Markdown格式            With regex                .Global = True                .Pattern = "(#+\s*|\*\*|__|`|\*{1,2}|_{1,2}|~~|^>\s)"                response = .Replace(response, "")            End With            response = regex.Replace(response, "")                       ' 取消选中原始文本            Selection.Collapse Direction:=wdCollapseEnd                       ' 将内容插入到选中文字的下一行            Selection.TypeParagraph ' 插入新行            Selection.TypeText Text:=response                       ' 将光标移回原来选中文本的末尾            originalSelection.Select        Else            MsgBox "Failed to parse API response.", vbExclamation        End If        Else        MsgBox response, vbCritical    End IfEnd Sub