获取计算机信息

dcl1214 · 发表于 2021-2-18 13:33:57

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

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun getbiso (/ WMI meth1 meth2 serial obj)
;获取biso地址
(cond
((and
(setq WMI (vl-catch-all-apply
'vlax-create-object
'("WbemScripting.SWbemLocator")
)
)
(not (vl-catch-all-error-p WMI))
(setq meth1 (vl-catch-all-apply
'vlax-invoke
(list
WMI
'ConnectServer
"."
"root/cimv2"
)
)
)
(not (vl-catch-all-error-p meth1))
(setq meth2 (vl-catch-all-apply
'vlax-invoke
(list
meth1
'ExecQuery
(strcat "Select * from Win32_" "BIOS")
)
)
)
(not (vl-catch-all-error-p meth2))
(vlax-for obj meth2
(vlax-for itm (vlax-get obj
'Properties_
)
(if
(and (not serial) (eq (vlax-get itm 'name) "SerialNumber"))
(setq serial (vlax-get itm 'value))
)
)
)
)
(mapcar 'vlax-release-object (list meth1 meth2 wmi))
)
(t
nil
)
)
(if serial
serial
""
)
)
(defun getcpuid1 (/ item meth1 meth2 s serx wmi $EF_CPUIDpids*)
(setq exitflag 0)
(if (vl-bb-ref '$EF_CPUIDpids*)
(setq $EF_CPUIDpids* (vl-bb-ref '$EF_CPUIDpids*))
(progn
(setq
err
(vl-catch-all-apply
'(lambda ()
(and (setq WMI
(vlax-create-object "WbemScripting.SWbemLocator")
)
(not (vl-catch-all-error-p WMI))
(setq meth1 (VLAX-INVOKE
WMI 'ConnectServer nil
nil nil nil nil
nil nil nil
)
)
(not (vl-catch-all-error-p meth1))
(setq
meth2 (vlax-invoke
meth1
'ExecQuery
"select ProcessorId from Win32_Processor"
)
)
(not (vl-catch-all-error-p meth2))
(setq
s
(vlax-for item meth2
(if (not serx)
(setq serx (vlax-get item 'ProcessorId))
serx
)
)
)
)
(setq $EF_CPUIDpids* s)
)
)
)
(vl-catch-all-apply 'vlax-release-object (list meth1))
(vl-catch-all-apply 'vlax-release-object (list meth2))
(vl-catch-all-apply 'vlax-release-object (list wmi))
(if (vl-catch-all-error-p err)
(setq inf (strcase (vl-catch-all-error-message err) t))
)
)
)
(if (and $EF_CPUIDpids* (= exitflag 0))
(progn
(if (not (vl-bb-ref '$EF_CPUIDpids*))
(vl-bb-set '$EF_CPUIDpids* $EF_CPUIDpids*)
)
)
)
(if $EF_CPUIDpids*
$EF_CPUIDpids*
""
)
)
(defun getcpuid2 (/ scr str objwmi objcpu id $EF_CPUIDpids*)
(if (vl-bb-ref '$EF_CPUIDpids*)
(setq $EF_CPUIDpids* (vl-bb-ref '$EF_CPUIDpids*))
(progn
(and (setq scr (vl-catch-all-apply
'vlax-create-object
(list "ScriptControl")
)
)
(not (vl-catch-all-error-p scr))
(vlax-put scr 'language "VBS")
(setq str "Set mc=GetObject(\"Winmgmts:\")")
(vlax-invoke scr 'EXECUTESTATEMENT str)
(setq objWMI (vl-catch-all-apply 'vla-eval (list scr "mc")))
(not (vl-catch-all-error-p objWMI))
(setq objCPU (vl-catch-all-apply
'vlax-invoke
(list objWMI 'InstancesOF "Win32_Processor")
)
)
)
(if (not (vl-catch-all-error-p objCPU))
(vlax-for obj objCPU
(if (not $EF_CPUIDpids*)
(setq $EF_CPUIDpids* (vlax-get obj 'ProcessorId))
)
)
)
(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))
(if (not (vl-bb-ref '$EF_CPUIDpids*))
(vl-bb-set '$EF_CPUIDpids* $EF_CPUIDpids*)
)
)
)
$EF_CPUIDpids*
)
(defun getBaseBoardid (/ mac WMIobj serv lox bd)
;获取主板ID
(if (SETQ WMIobj (VLAX-CREATE-OBJECT "wbemScripting.SwbemLocator"))
(progn
(and (SETQ serv (vl-catch-all-apply
'vlax-invoke
(list WMIobj "connectserver")
)
)
(not (vl-catch-all-error-p serv))
(setq lox (vl-catch-all-apply
'vlax-invoke
(list
serv
'ExecQuery
"SELECT * FROM Win32_BaseBoard"
)
)
)
(not (vl-catch-all-error-p lox))
)
(if (not (vl-catch-all-error-p lox))
(vlax-for item lox
(if (not bd)
(setq bd (vlax-get item 'SerialNumber))
)
)
)
(mapcar
(function
(lambda (a)
(vl-catch-all-apply 'vlax-release-object (list a))
)
)
(list lox serv WMIobj)
)
)
)
(if bd
bd
""
)
)
(defun getVideoController (/ WMI svr v)
;显卡
(if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator"))
(not (vl-catch-all-error-p WMI))
(setq SVR (VLAX-INVOKE WMI 'ConnectServer))
(not (vl-catch-all-error-p SVR))
)
(progn
(setq v nil)
(vlax-for n
(vlax-invoke SVR 'InstancesOf "Win32_VideoController")
(if (not v)
(setq v (vlax-get n 'Caption))
)
)
)
)
v
)
(defun getSoundDevice (/ WMI svr v)
;声卡
(if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator"))
(not (vl-catch-all-error-p WMI))
(setq SVR (VLAX-INVOKE WMI 'ConnectServer))
(not (vl-catch-all-error-p SVR))
)
(progn
(setq v nil)
(vlax-for n (vlax-invoke SVR 'InstancesOf "Win32_SoundDevice")
(if (not v)
(setq v (vlax-get n 'ProductName))
)
)
)
)
v
)
(defun getNetwork (/ WMI svr v)
;网卡
(if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator"))
(not (vl-catch-all-error-p WMI))
(setq SVR (VLAX-INVOKE WMI 'ConnectServer))
(not (vl-catch-all-error-p SVR))
)
(progn
(setq v nil)
(vlax-for obj (vlax-invoke
SVR
'InstancesOF
"Win32_NetworkAdapterConfiguration"
)
(if (/= (vlax-get obj 'IPEnabled) 0)
(if (not v)
(setq v (vlax-get obj 'MacAddress))
)
)
)
)
)
v
)
(setq c-n (getenv "ComputerName")) ;计算机名
(setq u-n (geTVAR 'LOGINNAME)) ;登录名
(setq biso (getbiso)) ;biso
(setq cpuid (getcpuid2)) ;cpu
(setq BaseBoardid (getBaseBoardid)) ;主板
(setq VideoController (getVideoController)) ;显卡
(setq SoundDevice (getSoundDevice)) ;声卡
(setq Network (getNetwork)) ;网卡

(defun getbiso (/ WMI meth1 meth2 serial obj) 
          ;获取biso地址 
 
  (cond 
    ((and 
       (setq WMI (vl-catch-all-apply 
       'vlax-create-object 
       '("WbemScripting.SWbemLocator") 
     ) 
       ) 
       (not (vl-catch-all-error-p WMI)) 
       (setq meth1 (vl-catch-all-apply 
         'vlax-invoke 
         (list 
           WMI 
           'ConnectServer 
           "." 
           "root/cimv2" 
         ) 
       ) 
       ) 
       (not (vl-catch-all-error-p meth1)) 
       (setq meth2 (vl-catch-all-apply 
         'vlax-invoke 
         (list 
           meth1 
           'ExecQuery 
           (strcat "Select * from Win32_" "BIOS") 
         ) 
       ) 
       ) 
       (not (vl-catch-all-error-p meth2)) 
       (vlax-for obj meth2 
   (vlax-for itm (vlax-get obj 
         'Properties_ 
           ) 
     (if 
       (and (not serial) (eq (vlax-get itm 'name) "SerialNumber")) 
        (setq serial (vlax-get itm 'value)) 
     ) 
   ) 
       ) 
     ) 
     (mapcar 'vlax-release-object (list meth1 meth2 wmi)) 
    ) 
    (t 
     nil 
    ) 
  ) 
  (if serial 
    serial 
    "" 
  ) 
) 
(defun getcpuid1 (/ item meth1 meth2 s serx wmi $EF_CPUIDpids*) 
  (setq exitflag 0) 
  (if (vl-bb-ref '$EF_CPUIDpids*) 
    (setq $EF_CPUIDpids* (vl-bb-ref '$EF_CPUIDpids*)) 
    (progn 
      (setq 
  err 
   (vl-catch-all-apply 
     '(lambda () 
        (and (setq WMI 
        (vlax-create-object "WbemScripting.SWbemLocator") 
       ) 
       (not (vl-catch-all-error-p WMI)) 
       (setq meth1 (VLAX-INVOKE 
         WMI    'ConnectServer    nil 
         nil    nil     nil      nil 
         nil    nil     nil 
        ) 
       ) 
       (not (vl-catch-all-error-p meth1)) 
       (setq 
         meth2 (vlax-invoke 
           meth1 
           'ExecQuery 
           "select ProcessorId from Win32_Processor" 
         ) 
       ) 
       (not (vl-catch-all-error-p meth2)) 
       (setq 
         s 
          (vlax-for  item meth2 
      (if (not serx) 
        (setq serx (vlax-get item 'ProcessorId)) 
        serx 
      ) 
          ) 
       ) 
        ) 
        (setq $EF_CPUIDpids* s) 
      ) 
   ) 
      ) 
      (vl-catch-all-apply 'vlax-release-object (list meth1)) 
      (vl-catch-all-apply 'vlax-release-object (list meth2)) 
      (vl-catch-all-apply 'vlax-release-object (list wmi)) 
      (if (vl-catch-all-error-p err) 
  (setq inf (strcase (vl-catch-all-error-message err) t)) 
      ) 
    ) 
  ) 
  (if (and $EF_CPUIDpids* (= exitflag 0)) 
    (progn 
      (if (not (vl-bb-ref '$EF_CPUIDpids*)) 
  (vl-bb-set '$EF_CPUIDpids* $EF_CPUIDpids*) 
      ) 
    ) 
  ) 
  (if $EF_CPUIDpids* 
    $EF_CPUIDpids* 
    "" 
  ) 
) 
(defun getcpuid2 (/ scr str objwmi objcpu id $EF_CPUIDpids*) 
  (if (vl-bb-ref '$EF_CPUIDpids*) 
    (setq $EF_CPUIDpids* (vl-bb-ref '$EF_CPUIDpids*)) 
    (progn 
      (and (setq scr (vl-catch-all-apply 
           'vlax-create-object 
           (list "ScriptControl") 
         ) 
     ) 
     (not (vl-catch-all-error-p scr)) 
     (vlax-put scr 'language "VBS") 
     (setq str "Set mc=GetObject(\"Winmgmts:\")") 
     (vlax-invoke scr 'EXECUTESTATEMENT str) 
     (setq objWMI (vl-catch-all-apply 'vla-eval (list scr "mc"))) 
     (not (vl-catch-all-error-p objWMI)) 
     (setq objCPU  (vl-catch-all-apply 
        'vlax-invoke 
        (list objWMI 'InstancesOF "Win32_Processor") 
      ) 
     ) 
      ) 
      (if (not (vl-catch-all-error-p objCPU)) 
  (vlax-for obj objCPU 
    (if (not $EF_CPUIDpids*) 
      (setq $EF_CPUIDpids* (vlax-get obj 'ProcessorId)) 
    ) 
  ) 
      ) 
      (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)) 
      (if (not (vl-bb-ref '$EF_CPUIDpids*)) 
  (vl-bb-set '$EF_CPUIDpids* $EF_CPUIDpids*) 
      ) 
    ) 
  ) 
  $EF_CPUIDpids* 
) 
 
 
(defun getBaseBoardid (/ mac WMIobj serv lox bd) 
          ;获取主板ID 
  (if (SETQ WMIobj (VLAX-CREATE-OBJECT "wbemScripting.SwbemLocator")) 
    (progn 
      (and (SETQ serv (vl-catch-all-apply 
      'vlax-invoke 
      (list WMIobj "connectserver") 
          ) 
     ) 
     (not (vl-catch-all-error-p serv)) 
     (setq lox (vl-catch-all-apply 
           'vlax-invoke 
           (list 
       serv 
       'ExecQuery 
       "SELECT * FROM Win32_BaseBoard" 
           ) 
         ) 
     ) 
     (not (vl-catch-all-error-p lox)) 
      ) 
      (if (not (vl-catch-all-error-p lox)) 
  (vlax-for item lox 
    (if (not bd) 
      (setq bd (vlax-get item 'SerialNumber)) 
    ) 
  ) 
      ) 
      (mapcar 
  (function 
    (lambda (a) 
      (vl-catch-all-apply 'vlax-release-object (list a)) 
    ) 
  ) 
  (list lox serv WMIobj) 
      ) 
    ) 
  ) 
  (if bd 
    bd 
    "" 
  ) 
) 
(defun getVideoController (/ WMI svr v) 
          ;显卡 
  (if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator")) 
     (not (vl-catch-all-error-p WMI)) 
     (setq SVR (VLAX-INVOKE WMI 'ConnectServer)) 
     (not (vl-catch-all-error-p SVR)) 
      ) 
    (progn 
      (setq v nil) 
      (vlax-for  n 
    (vlax-invoke SVR 'InstancesOf "Win32_VideoController") 
  (if (not v) 
    (setq v (vlax-get n 'Caption)) 
  ) 
      ) 
    ) 
  ) 
  v 
) 
(defun getSoundDevice (/ WMI svr v) 
          ;声卡 
  (if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator")) 
     (not (vl-catch-all-error-p WMI)) 
     (setq SVR (VLAX-INVOKE WMI 'ConnectServer)) 
     (not (vl-catch-all-error-p SVR)) 
      ) 
    (progn 
      (setq v nil) 
      (vlax-for  n (vlax-invoke SVR 'InstancesOf "Win32_SoundDevice") 
  (if (not v) 
    (setq v (vlax-get n 'ProductName)) 
  ) 
      ) 
    ) 
  ) 
  v 
) 
(defun getNetwork (/ WMI svr v) 
          ;网卡 
  (if (and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator")) 
     (not (vl-catch-all-error-p WMI)) 
     (setq SVR (VLAX-INVOKE WMI 'ConnectServer)) 
     (not (vl-catch-all-error-p SVR)) 
      ) 
    (progn 
      (setq v nil) 
      (vlax-for  obj (vlax-invoke 
          SVR 
          'InstancesOF 
          "Win32_NetworkAdapterConfiguration" 
        ) 
  (if (/= (vlax-get obj 'IPEnabled) 0) 
    (if (not v) 
      (setq v (vlax-get obj 'MacAddress)) 
    ) 
  ) 
      ) 
    ) 
  ) 
  v 
) 
(setq c-n (getenv "ComputerName"))  ;计算机名 
(setq u-n (geTVAR 'LOGINNAME))    ;登录名 
(setq biso (getbiso))      ;biso 
(setq cpuid (getcpuid2))    ;cpu 
(setq BaseBoardid (getBaseBoardid))  ;主板 
(setq VideoController (getVideoController)) ;显卡 
(setq SoundDevice (getSoundDevice))  ;声卡 
(setq Network (getNetwork))    ;网卡

/db_自贡黄明儒_ · 发表于 2021-2-18 14:04:45

我期待您举几个应用这些信息的例子

tanjurun · 发表于 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))
说语法错误呢

hh_lj007 · 发表于 2021-2-18 16:50:20

过2天上班了试一试

xujinhua · 发表于 2021-2-18 18:42:36

新年好，很实用，谢谢你

xk15c · 发表于 2021-2-19 07:34:44

新年快乐，牛年大吉

dcl1214 · 发表于 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

账号		自动登录	找回密码
密码			立即注册

[源码] 获取计算机信息

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

评分

点评