连接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)
下载测试一下 搞不懂怎么用? ocoipw 发表于 2025-7-18 19:55
搞不懂怎么用?
注册deepseek的api 乱码试试用"Msxml2.xmlhttp", edata 发表于 2025-8-17 23:02
乱码试试用"Msxml2.xmlhttp",
好的,空了试一试。 回复的中文消息是乱码,怎么解决?英文能正常显示。
lxl304712346 发表于 2025-10-28 17:19
回复的中文消息是乱码,怎么解决?英文能正常显示。
没有继续研究,编码没有研究透
页:
[1]