设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 211|回复: 6

[源码] 获取计算机信息

[复制链接]
发表于 2021-2-18 13:33:57 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
  1. (defun getbiso (/ WMI meth1 meth2 serial obj)
  2.           ;获取biso地址

  3.   (cond
  4.     ((and
  5.        (setq WMI (vl-catch-all-apply
  6.        'vlax-create-object
  7.        '("WbemScripting.SWbemLocator")
  8.      )
  9.        )
  10.        (not (vl-catch-all-error-p WMI))
  11.        (setq meth1 (vl-catch-all-apply
  12.          'vlax-invoke
  13.          (list
  14.            WMI
  15.            'ConnectServer
  16.            "."
  17.            "root/cimv2"
  18.          )
  19.        )
  20.        )
  21.        (not (vl-catch-all-error-p meth1))
  22.        (setq meth2 (vl-catch-all-apply
  23.          'vlax-invoke
  24.          (list
  25.            meth1
  26.            'ExecQuery
  27.            (strcat "Select * from Win32_" "BIOS")
  28.          )
  29.        )
  30.        )
  31.        (not (vl-catch-all-error-p meth2))
  32.        (vlax-for obj meth2
  33.    (vlax-for itm (vlax-get obj
  34.          'Properties_
  35.            )
  36.      (if
  37.        (and (not serial) (eq (vlax-get itm 'name) "SerialNumber"))
  38.         (setq serial (vlax-get itm 'value))
  39.      )
  40.    )
  41.        )
  42.      )
  43.      (mapcar 'vlax-release-object (list meth1 meth2 wmi))
  44.     )
  45.     (t
  46.      nil
  47.     )
  48.   )
  49.   (if serial
  50.     serial
  51.     ""
  52.   )
  53. )
  54. (defun getcpuid1 (/ item meth1 meth2 s serx wmi $EF_CPUIDpids*)
  55.   (setq exitflag 0)
  56.   (if (vl-bb-ref '$EF_CPUIDpids*)
  57.     (setq $EF_CPUIDpids* (vl-bb-ref '$EF_CPUIDpids*))
  58.     (progn
  59.       (setq
  60.   err
  61.    (vl-catch-all-apply
  62.      '(lambda ()
  63.         (and (setq WMI
  64.         (vlax-create-object "WbemScripting.SWbemLocator")
  65.        )
  66.        (not (vl-catch-all-error-p WMI))
  67.        (setq meth1 (VLAX-INVOKE
  68.          WMI    'ConnectServer    nil
  69.          nil    nil     nil      nil
  70.          nil    nil     nil
  71.         )
  72.        )
  73.        (not (vl-catch-all-error-p meth1))
  74.        (setq
  75.          meth2 (vlax-invoke
  76.            meth1
  77.            'ExecQuery
  78.            "select ProcessorId from Win32_Processor"
  79.          )
  80.        )
  81.        (not (vl-catch-all-error-p meth2))
  82.        (setq
  83.          s
  84.           (vlax-for  item meth2
  85.       (if (not serx)
  86.         (setq serx (vlax-get item 'ProcessorId))
  87.         serx
  88.       )
  89.           )
  90.        )
  91.         )
  92.         (setq $EF_CPUIDpids* s)
  93.       )
  94.    )
  95.       )
  96.       (vl-catch-all-apply 'vlax-release-object (list meth1))
  97.       (vl-catch-all-apply 'vlax-release-object (list meth2))
  98.       (vl-catch-all-apply 'vlax-release-object (list wmi))
  99.       (if (vl-catch-all-error-p err)
  100.   (setq inf (strcase (vl-catch-all-error-message err) t))
  101.       )
  102.     )
  103.   )
  104.   (if (and $EF_CPUIDpids* (= exitflag 0))
  105.     (progn
  106.       (if (not (vl-bb-ref '$EF_CPUIDpids*))
  107.   (vl-bb-set '$EF_CPUIDpids* $EF_CPUIDpids*)
  108.       )
  109.     )
  110.   )
  111.   (if $EF_CPUIDpids*
  112.     $EF_CPUIDpids*
  113.     ""
  114.   )
  115. )
  116. (defun getcpuid2 (/ scr str objwmi objcpu id $EF_CPUIDpids*)
  117.   (if (vl-bb-ref '$EF_CPUIDpids*)
  118.     (setq $EF_CPUIDpids* (vl-bb-ref '$EF_CPUIDpids*))
  119.     (progn
  120.       (and (setq scr (vl-catch-all-apply
  121.            'vlax-create-object
  122.            (list "ScriptControl")
  123.          )
  124.      )
  125.      (not (vl-catch-all-error-p scr))
  126.      (vlax-put scr 'language "VBS")
  127.      (setq str "Set mc=GetObject(\"Winmgmts:\")")
  128.      (vlax-invoke scr 'EXECUTESTATEMENT str)
  129.      (setq objWMI (vl-catch-all-apply 'vla-eval (list scr "mc")))
  130.      (not (vl-catch-all-error-p objWMI))
  131.      (setq objCPU  (vl-catch-all-apply
  132.         'vlax-invoke
  133.         (list objWMI 'InstancesOF "Win32_Processor")
  134.       )
  135.      )
  136.       )
  137.       (if (not (vl-catch-all-error-p objCPU))
  138.   (vlax-for obj objCPU
  139.     (if (not $EF_CPUIDpids*)
  140.       (setq $EF_CPUIDpids* (vlax-get obj 'ProcessorId))
  141.     )
  142.   )
  143.       )
  144.       (vl-catch-all-error-p 'vlax-release-object (list objCPU))
  145.       (vl-catch-all-error-p 'vlax-release-object (list objWMI))
  146.       (vl-catch-all-error-p 'vlax-release-object (list scr))
  147.       (if (not (vl-bb-ref '$EF_CPUIDpids*))
  148.   (vl-bb-set '$EF_CPUIDpids* $EF_CPUIDpids*)
  149.       )
  150.     )
  151.   )
  152.   $EF_CPUIDpids*
  153. )


  154. (defun getBaseBoardid (/ mac WMIobj serv lox bd)
  155.           ;获取主板ID
  156.   (if (SETQ WMIobj (VLAX-CREATE-OBJECT "wbemScripting.SwbemLocator"))
  157.     (progn
  158.       (and (SETQ serv (vl-catch-all-apply
  159.       'vlax-invoke
  160.       (list WMIobj "connectserver")
  161.           )
  162.      )
  163.      (not (vl-catch-all-error-p serv))
  164.      (setq lox (vl-catch-all-apply
  165.            'vlax-invoke
  166.            (list
  167.        serv
  168.        'ExecQuery
  169.        "SELECT * FROM Win32_BaseBoard"
  170.            )
  171.          )
  172.      )
  173.      (not (vl-catch-all-error-p lox))
  174.       )
  175.       (if (not (vl-catch-all-error-p lox))
  176.   (vlax-for item lox
  177.     (if (not bd)
  178.       (setq bd (vlax-get item 'SerialNumber))
  179.     )
  180.   )
  181.       )
  182.       (mapcar
  183.   (function
  184.     (lambda (a)
  185.       (vl-catch-all-apply 'vlax-release-object (list a))
  186.     )
  187.   )
  188.   (list lox serv WMIobj)
  189.       )
  190.     )
  191.   )
  192.   (if bd
  193.     bd
  194.     ""
  195.   )
  196. )
  197. (defun getVideoController (/ WMI svr v)
  198.           ;显卡
  199.   (if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator"))
  200.      (not (vl-catch-all-error-p WMI))
  201.      (setq SVR (VLAX-INVOKE WMI 'ConnectServer))
  202.      (not (vl-catch-all-error-p SVR))
  203.       )
  204.     (progn
  205.       (setq v nil)
  206.       (vlax-for  n
  207.     (vlax-invoke SVR 'InstancesOf "Win32_VideoController")
  208.   (if (not v)
  209.     (setq v (vlax-get n 'Caption))
  210.   )
  211.       )
  212.     )
  213.   )
  214.   v
  215. )
  216. (defun getSoundDevice (/ WMI svr v)
  217.           ;声卡
  218.   (if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator"))
  219.      (not (vl-catch-all-error-p WMI))
  220.      (setq SVR (VLAX-INVOKE WMI 'ConnectServer))
  221.      (not (vl-catch-all-error-p SVR))
  222.       )
  223.     (progn
  224.       (setq v nil)
  225.       (vlax-for  n (vlax-invoke SVR 'InstancesOf "Win32_SoundDevice")
  226.   (if (not v)
  227.     (setq v (vlax-get n 'ProductName))
  228.   )
  229.       )
  230.     )
  231.   )
  232.   v
  233. )
  234. (defun getNetwork (/ WMI svr v)
  235.           ;网卡
  236.   (if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator"))
  237.      (not (vl-catch-all-error-p WMI))
  238.      (setq SVR (VLAX-INVOKE WMI 'ConnectServer))
  239.      (not (vl-catch-all-error-p SVR))
  240.       )
  241.     (progn
  242.       (setq v nil)
  243.       (vlax-for  obj (vlax-invoke
  244.           SVR
  245.           'InstancesOF
  246.           "Win32_NetworkAdapterConfiguration"
  247.         )
  248.   (if (/= (vlax-get obj 'IPEnabled) 0)
  249.     (if (not v)
  250.       (setq v (vlax-get obj 'MacAddress))
  251.     )
  252.   )
  253.       )
  254.     )
  255.   )
  256.   v
  257. )
  258. (setq c-n (getenv "ComputerName"))  ;计算机名
  259. (setq u-n (geTVAR 'LOGINNAME))    ;登录名
  260. (setq biso (getbiso))      ;biso
  261. (setq cpuid (getcpuid2))    ;cpu
  262. (setq BaseBoardid (getBaseBoardid))  ;主板
  263. (setq VideoController (getVideoController)) ;显卡
  264. (setq SoundDevice (getSoundDevice))  ;声卡
  265. (setq Network (getNetwork))    ;网卡

评分

参与人数 1D豆 +5 收起 理由
/db_自贡黄明儒_ + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 604个

财富等级: 财运亨通

发表于 2021-2-18 14:04:45 | 显示全部楼层
我期待您举几个应用这些信息的例子
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2021-2-18 15:06:06 | 显示全部楼层
报错。      (vl-catch-all-error-p 'vlax-release-object (list objCPU))
      (vl-catch-all-error-p 'vlax-release-object (list objWMI))
      (vl-catch-all-error-p 'vlax-release-object (list scr))
说语法错误呢

点评

我修改提交,晓东拦截了,说是非法字串,你修改成VL-CATCH-ALL-APPLY  详情 回复 发表于 2021-2-19 09:49
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 143个

财富等级: 日进斗金

发表于 2021-2-18 16:50:20 | 显示全部楼层
过2天上班了试一试
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 5个

财富等级: 恭喜发财

发表于 2021-2-18 18:42:36 | 显示全部楼层
新年好,很实用,谢谢你
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 637个

财富等级: 财运亨通

发表于 2021-2-19 07:34:44 | 显示全部楼层
新年快乐,牛年大吉
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-2-19 09:49:42 | 显示全部楼层
tanjurun 发表于 2021-2-18 15:06
报错。      (vl-catch-all-error-p 'vlax-release-object (list objCPU))
  &# ...

我修改提交,晓东拦截了,说是非法字串,你修改成VL-CATCH-ALL-APPLY
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2021-3-2 21:39 , Processed in 0.151602 second(s), 28 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表