如何在LSP中提取计算机信息

CADghost · 发表于 2004-8-13 16:26:00

如何在LSP中用哪个变量可以提取计算机的信息。

比如操作系统的版本、CPU的主频、硬盘的大小、分区，内存信息等等！~

谢谢！~

龙龙仔 · 发表于 2004-8-13 17:25:00

(vlax-dump-object (vlax-create-object "Scripting.FileSystemObject") T)
; IFileSystem3: FileSystemObject
;性质值:
; Drives (RO) = #<VLA-OBJECT IDriveCollection 02bc8fb0>
;支援的方法:
; BuildPath (2)
; CopyFile (3)
; CopyFolder (3)
; CreateFolder (1)
; CreateTextFile (3)
; DeleteFile (2)
; DeleteFolder (2)
; DriveExists (1)
; FileExists (1)
; FolderExists (1)
; GetAbsolutePathName (1)
; GetBaseName (1)
; GetDrive (1)
; GetDriveName (1)
; GetExtensionName (1)
; GetFile (1)
; GetFileName (1)
; GetFileVersion (1)
; GetFolder (1)
; GetParentFolderName (1)
; GetSpecialFolder (1)
; GetStandardStream (2)
; GetTempName ()
; MoveFile (2)
; MoveFolder (2)
; OpenTextFile (4)
(vlax-dump-object (vlax-create-object "WScript.Shell") T)
; IWshShell2: Shell Object Interface
;无性质
;支援的方法:
; AppActivate (3)
; LogEvent (4)
; SendKeys (2) (setq WSHSHELL (vlax-create-object "WScript.Shell"))
(setq WSHSYSENV (vlax-get-property WSHSHELL 'ENVIRONMENT "Process"))
(vlax-get-property WSHSYSENV 'ITEM "HOMEDRIVE")
(vlax-get-property WSHSYSENV 'ITEM "TEMP")
(vlax-get-property WSHSYSENV 'ITEM "PATH")
(vlax-get-property WSHSYSENV 'ITEM "PROCESSOR_IDENTIFIER")
(vlax-get-property WSHSYSENV 'ITEM "PROCESSOR_ARCHITECTURE")
(vlax-get-property WSHSYSENV 'ITEM "PROCESSOR_REVISION")

CADghost · 发表于 2004-8-13 17:57:00

对不起，龙版，我比较笨，你可以再详细的说一下吗？

alin · 发表于 2004-8-13 22:14:00

本帖最后由作者于 2004-8-14 11:12:48 编辑

;;Author: Alin 13/8/04
;;
(defun getSysInfo (/ shell cpulv cpusp memory
driveinfo FSO drives drv drvtyp
tolsize freespace)
(vl-load-com)
(setq FSO (vlax-create-object "Scripting.FileSystemObject"))
(setq drives (vlax-get-property FSO "drives"))
(setq drv "A:")
(repeat 26
(if (= (vlax-invoke-method FSO 'DriveExists drv) :vlax-true)
(progn
(setq drvobj (vlax-get-property drives 'item drv))
(setq drvtyp (GetDrvType drvobj))
(setq tolsize (GetDrvSize drvobj 'TotalSize))
(setq freespace (GetDrvSize drvobj 'FreeSpace))
(setq driveInfo (cons (strcat drv
" 类型："
drvtyp
"\t总大小:"
(StrSize tolsize)
"\t可用空间:"
(StrSize freespace)
"\n")
driveInfo))
)
)
(setq drv (strcat (chr (1+ (ascii (substr drv 1 1)))) ":"))
)
(setq shell (vlax-create-object "Shell.Application"))
(setq cpulv (Getinfo "ProcessorLevel")
cpusp (Getinfo "ProcessorSpeed")
memory (Getinfo "PhysicalMemoryInstalled"))
(if (= (type cpulv) 'INT)
(cond ((< cpulv 6)
(setq cpulv (strcat "x" (itoa cpulv) "86")))
((= cpulv 6)
(setq cpulv "Prentium"))
(t "未知")
))
(if (= (type cpusp) 'INT)
(setq cpusp (strcat (itoa cpusp) " MHz")))
(if (= (type memory) 'REAL)
(setq memory (strsize memory)))
(princ "\n系统:\t")
(if dos_ver
(princ (dos_ver))
(princ (getvar "PLATFORM"))
)
(princ "\n处理器:\t")
(princ cpulv)
(princ "\n速度:\t")
(princ cpusp)
(princ "\n内存:\t")
(princ memory)
(terpri)
(princ "\n磁盘空间分布:\n")
(mapcar 'princ (reverse driveInfo))
(vlax-release-object FSO)
(vlax-release-object shell)
(princ)
)
;;;
(defun strsize (size)
(if (member (type size) (list 'INT 'REAL))
(strcat (rtos (/ size 1.0e6) 2 2) " MB")
size)
)
;;;-----
(defun GetInfo (sname / catchit)
(if (vl-catch-all-error-p
(setq catchit (vl-catch-all-apply
'vlax-invoke-method
(list shell 'GetSystemInformation sname))))
"未知"
catchit
)
)
;;---
(defun GetDrvSize (drvobj sname / catchit)
(if (vl-catch-all-error-p
(setq catchit (vl-catch-all-apply
'vlax-get-property
(list drvobj sname))))
"未知 "
(vlax-variant-value catchit)
)
)
;;
(defun GetDrvType (drvobj / dt)
(setq dt (vlax-get-property drvobj "Drivetype"))
(cond ((= dt 0)
"Unknown")
((= dt 1)
"Removable")
((= dt 2)
"Fixed")
((= dt 3)
"Network")
((= dt 4)
"CD-ROM")
((= dt 5)
"Ram Stick")
(t
"未知")
)
)

;;Author: Alin 13/8/04
;;
(defun getSysInfo   (/             shell  cpulv     cpusp         memory
           driveinfo FSO  drives     drv         drvtyp
           tolsize     freespace)
   (vl-load-com)
   (setq FSO (vlax-create-object "Scripting.FileSystemObject"))
   (setq drives (vlax-get-property FSO "drives"))
   (setq drv "A:")
   (repeat 26
       (if  (= (vlax-invoke-method FSO 'DriveExists drv) :vlax-true)
           (progn
  (setq drvobj (vlax-get-property drives 'item drv))
  (setq drvtyp (GetDrvType drvobj))
  (setq tolsize (GetDrvSize drvobj 'TotalSize))
  (setq freespace (GetDrvSize drvobj 'FreeSpace))
  (setq driveInfo  (cons (strcat drv
                   "   类型："
                   drvtyp
                   "\t总大小:"
                   (StrSize tolsize)
                   "\t可用空间:"
                   (StrSize freespace)
                   "\n")
                 driveInfo))
  )
           )
       (setq drv (strcat (chr (1+ (ascii (substr drv 1 1)))) ":"))
       )
   (setq shell (vlax-create-object "Shell.Application"))
   (setq  cpulv   (Getinfo "ProcessorLevel")
  cpusp   (Getinfo "ProcessorSpeed")
  memory (Getinfo "PhysicalMemoryInstalled"))
   (if (= (type cpulv) 'INT)
       (cond ((< cpulv 6)
       (setq cpulv (strcat "x" (itoa cpulv) "86")))
     ((= cpulv 6)
       (setq cpulv "Prentium"))
     (t "未知")
     ))
   (if (= (type cpusp) 'INT)
       (setq cpusp (strcat (itoa cpusp) " MHz")))
   (if (= (type memory) 'REAL)
       (setq memory (strsize memory)))
   (princ "\n系统:\t")
   (if dos_ver
       (princ (dos_ver))
       (princ (getvar "PLATFORM"))
     )
   (princ "\n处理器:\t")
   (princ cpulv)
   (princ "\n速度:\t")
   (princ cpusp)
   (princ "\n内存:\t")
   (princ memory)
   (terpri)
   (princ "\n磁盘空间分布:\n")
   (mapcar 'princ (reverse driveInfo))
   (vlax-release-object FSO)
   (vlax-release-object shell)
   (princ)
   )
;;;
(defun strsize  (size)
   (if (member (type size) (list 'INT 'REAL))
       (strcat (rtos (/ size 1.0e6) 2 2) " MB")
       size)
   )
;;;-----
(defun GetInfo  (sname / catchit)
   (if (vl-catch-all-error-p
  (setq catchit (vl-catch-all-apply
      'vlax-invoke-method
      (list shell 'GetSystemInformation sname))))
       "未知"
       catchit
       )
   )
;;---
(defun GetDrvSize   (drvobj sname / catchit)
   (if (vl-catch-all-error-p
  (setq catchit (vl-catch-all-apply
      'vlax-get-property
      (list drvobj sname))))
       "未知       "
       (vlax-variant-value catchit)
       )
   )
;;
(defun GetDrvType   (drvobj / dt)
   (setq dt (vlax-get-property drvobj "Drivetype"))
   (cond  ((= dt 0)
   "Unknown")
  ((= dt 1)
   "Removable")
  ((= dt 2)
   "Fixed")
  ((= dt 3)
   "Network")
  ((= dt 4)
   "CD-ROM")
  ((= dt 5)
   "Ram Stick")
  (t
   "未知")
  )
   )

CADghost · 发表于 2004-8-15 08:22:00

对不起，我还是看不太懂

龙龙仔 · 发表于 2004-8-16 08:20:00

alin发表于2004-8-13 22:14:00;;Author: Alin 13/8/04;;(defun getSysInfo (/ shell cpulv cpusp memory driveinfo FSO drives drv ...

(setq FSO (vlax-create-object "Scripting.FileSystemObject"))
(setq drives (vlax-get-property FSO "drives"))

;;drives collection已取得,就不用repeat 26次吧!

复制代码

BDYCAD · 发表于 2004-8-16 08:40:00

用4楼的程序 _$ 系统: Microsoft Windows NT Version 5.1 (x86)
处理器: 15
速度: 未知
内存: 536.33 MB 磁盘空间分布:
C:类型：Fixed 总大小:10466.73 MB 可用空间:3532.05 MB
D:类型：Fixed 总大小:20964.2 MB 可用空间:4946.44 MB
E:类型：Fixed 总大小:20964.2 MB 可用空间:929.27 MB
F:类型：Fixed 总大小:29506.09 MB 可用空间:7331.55 MB
G:类型：CD-ROM 总大小:未知可用空间:未知
_$

alin · 发表于 2004-8-16 10:15:00

Some methods for FSO object don't work for me, such as MoveFolder and Getdrive, why? Lucas, I cannot find a better way to retrieve the drive info from the drive collection Drives. The Drives collection has no methods.

citykunan · 发表于 2004-8-16 10:45:00

这个程序真的很不错。lucas和alin真不愧是高手啊。

龙龙仔 · 发表于 2004-8-16 12:40:00

alin发表于2004-8-16 10:15:00Some methods for FSO object don't work for me, such as MoveFolder and Getdrive, why? Lucas, I cannot find a better way to retrieve the drive info f...

参考下列 dispbbs.asp?BoardID=3&ID=11083&replyID=46333&skin=1 ;;By LUCAS(龙龙仔)
;;列出所有磁碟机
(defun LIST_DRIVE (/ SYS LIST_DRIVE ENT LST)
(setq SYS (vlax-create-object "Scripting.FileSystemObject"))
(setq LIST_DRIVE (vlax-get-property SYS 'DRIVES))
(vlax-for ENT LIST_DRIVE
(setq
LST (append
LST
(list (strcat (vlax-get-property ENT 'DRIVELETTER) ":"))
)
) )
(vlax-release-object LIST_DRIVE)
(vlax-release-object SYS)
LST
)

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

如何在LSP中提取计算机信息

评分