jun353835273 发表于 2025-7-18 12:00:00

连接deepseek,需要申请deepseek的KEY 算是半成品,搞半天,返回值编码部分有问题...

本帖最后由 jun353835273 于 2025-7-18 12:05 编辑

算是半成品,搞半天,返回值编码部分有问题,高手来玩玩了
注册key需要花钱,1块钱可以玩很多长测试的
;; 主命令:启动对话框
(defun c:De1 (/ dcl_iddclf)
(vl-load-com)
(setq dclf (deepmake-dcl))
(setq dcl_id (load_dialog dclf))
(if (not (new_dialog "deepseek_dialog" dcl_id))
      (progn
      (alert "无法加载对话框!请确保deepseek.dcl文件正确")
      (unload_dialog dcl_id)
      (exit)
      )
)
;; 初始化界面
(if (setq env_key "sk-") ;需要在deepseek申请一个可用的 KEY
      (set_tile "api_key" env_key)
      (set_tile "api_key" "sk-"); 默认API Key前缀
)
(set_tile "response" "等待提问...")
(set_tile "question" "请翻译: 日久生情")

;; 设置按钮动作
(action_tile "test_connection" "(verify_connection)")
(action_tile "submit" "(submit_question)")
(action_tile "copy" "(copy_result)")
(action_tile "cancel" "(done_dialog)")

(start_dialog)
(unload_dialog dcl_id)
(if (findfile dclf ) (vl-file-delete dclf ))
(princ)
)
(defun ZZ:String:RegExpR (pat str nstr key / end)
(if (not *xxvbsexp)
    (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
)
(vlax-put *xxvbsexp 'Pattern pat)
(if (not key)
    (setq key "")
)
(setq key (strcase key))
(setq keys '(("I" "IgnoreCase") ("G" "Global") ("M" "Multiline")))
(mapcar
    '(lambda (x)
       (if (wcmatch key (strcat "*" (car x) "*"))
         (vlax-put *xxvbsexp (read (cadr x)) -1)
         (vlax-put *xxvbsexp (read (cadr x)) 0)
       )
   )
    keys
)
(vlax-invoke *xxvbsexp 'replace str nstr)
)
;; 验证API连接 - 修复版
(defun verify_connection (/ api_key result)
(setq api_key (get_tile "api_key"))
(if (= api_key "")
      (alert "请输入API Key!")
      (progn
      (set_tile "response" "正在验证API连接...")
      (setq result (deepseek-api-request api_key "test connection" t))
      (if (eq result t)
            (progn
            (setenv "DEEPSEEK_API_KEY" api_key)
            (set_tile "response" "? API连接成功!")
            )
            (set_tile "response" (strcat "? 连接失败: " result))
      )
      )
)
(princ)
)

;; 提交问题 - 修复版
(defun submit_question (/ api_key question response)
(setq api_key (get_tile "api_key")
      question (get_tile "question"))
(cond
    ((= api_key "")
   (alert "请先输入并验证API Key!"))
    ((= question "")
   (alert "请输入问题内容!"))
    (t
   (set_tile "response" "正在请求DeepSeek API...")
   (setq response (deepseek-api-request api_key question nil))
   (if (and response (not (eq response t)))
         (set_tile "response" (strcat "DeepSeek回复:\n" response))
         (set_tile "response" (strcat "? 请求失败: " (if response response "未知错误")))
   )
    )
)
(princ)
)


;; 核心:发送API请求 - 完全修复版
(defun deepseek-api-request (api_key question is_test / http request_body result status response json-response)


(setq http (vlax-create-object "WinHttp.WinHttpRequest.5.1"))
(setq result
    (vl-catch-all-apply
      '(lambda ()
         (vlax-invoke http 'Open "POST" "https://api.deepseek.com/v1/chat/completions" :vlax-false)
         (vlax-invoke http 'SetRequestHeader "Content-Type" "application/json")
         (vlax-invoke http 'SetRequestHeader "Authorization" (strcat "Bearer " api_key))
         (vlax-invoke http 'SetRequestHeader "Accept" "application/json")
         
         (setq request_body
         (if is_test
             "{\"model\":\"deepseek-chat\",\"messages\":[{\"role\":\"user\",\"content\":\"Test connection\"}],\"max_tokens\":10}"
             (strcat
               "{\"model\":\"deepseek-chat\","
               "\"messages\":["
               "{\"role\":\"system\",\"content\":\"你是一个有帮助的AI助手\"},"
               "{\"role\":\"user\",\"content\":\"" (escape-json question) "\"}"
               "],"
               "\"temperature\":0.7,"
               "\"max_tokens\":2000}"
             )
         )
         )
         
         (vlax-invoke http 'Send request_body)
         (vlax-invoke http 'WaitForResponse)
         (setq status (vlax-get http 'Status))
         (setq response (vlax-get http 'ResponseText))
         
         (if (/= status 200)
         (exit)
         )
         
         (if is_test
         (= status 200)
         (parse-api-response response)
         )
       )
    )
)

(vlax-release-object http)

(cond
    ((vl-catch-all-error-p result)
   (vl-catch-all-error-message result))
    ((eq result t) t)
    ((and (not is_test) response)
   (parse-api-response response))
    (t "未知错误")
)
)

;; JSON转义 - 修复版
(defun escape-json (str)
(if (null str) (setq str ""))
(setq str (ZZ:String:RegExpR "\"" str "\\\\\"" "G"))
(setq str (ZZ:String:RegExpR "\n" str "\\\\n" "G"))
(setq str (ZZ:String:RegExpR "\r" str "\\\\r" "G"))
(setq str (ZZ:String:RegExpR "\t" str "\\\\t" "G"))
str
)
;(setq json-str response)
;; 解析API响应 - 完全修复版





(defun parse-api-response (json-str / content start-pos end-pos)
(cond
    ((null json-str) "API返回空响应")
    ((/= (type json-str) 'STR) "API返回无效响应类型")
    (t
   ;; 先尝试直接提取"content"字段
   (if (setq start-pos (vl-string-search "\"content\":\"" json-str))
       (progn
         (setq start-pos (+ start-pos 11)) ; 跳过"content":"这部分
         (setq end-pos (vl-string-search "\"" json-str start-pos)) ; 找结束引号
         (if end-pos
         (progn
             (setq content (substr json-str start-pos (- end-pos start-pos)))
             ;; 仅保留可打印字符(过滤乱码)
             (setq content (vl-string-translate "\x00-\x1F\x80-\xFF" "" content))
             ;; 处理转义字符
             (setq content (ZZ:String:RegExpR "\\\\\"" content "\"" "G"))
             (setq content (ZZ:String:RegExpR "\\\\n" content "\n" "G"))
             (setq content (ZZ:String:RegExpR "\\\\t" content "\t" "G"))
             ;; 去除首尾空白字符
             (setq content (vl-string-trim " \t\n\r" content))
             content
         )
         "无法解析响应内容(未找到结束引号)"
         )
       )
       "无法解析响应内容(未找到content字段)"
   )
    )
)
)

;; 复制结果到剪贴板
(defun copy_result ()
(setq text (get_tile "response"))
(if (and text (/= text ""))
      (progn
      (setq html (vlax-create-object "htmlfile"))
      (vlax-invoke
          (vlax-get (vlax-get html 'parentWindow) 'clipboardData)
          'setData "Text" text)
      (vlax-release-object html)
      (alert "结果已复制到剪贴板!")
      )
      (alert "没有可复制的内容!")
)
(princ)
)
**** Hidden Message *****
(princ)


qifeifei 发表于 2025-7-18 12:47:11

下载测试一下

ocoipw 发表于 2025-7-18 19:55:25

搞不懂怎么用?

jun353835273 发表于 2025-7-19 22:53:40

ocoipw 发表于 2025-7-18 19:55
搞不懂怎么用?

注册deepseek的api

edata 发表于 2025-8-17 23:02:17

乱码试试用"Msxml2.xmlhttp",

jun353835273 发表于 2025-8-23 07:40:58

edata 发表于 2025-8-17 23:02
乱码试试用"Msxml2.xmlhttp",

好的,空了试一试。

lxl304712346 发表于 2025-10-28 17:19:06

回复的中文消息是乱码,怎么解决?英文能正常显示。

jun353835273 发表于 2025-10-29 07:46:08

lxl304712346 发表于 2025-10-28 17:19
回复的中文消息是乱码,怎么解决?英文能正常显示。

没有继续研究,编码没有研究透
页: [1]
查看完整版本: 连接deepseek,需要申请deepseek的KEY 算是半成品,搞半天,返回值编码部分有问题...