您的位置:程序门 -> vb -> 基础类



怎么扫描获得正在运行的进程信息呢?(请高手帮吗)


[收藏此页] [打印本页]选择字色:背景色:字体:[][][]


怎么扫描获得正在运行的进程信息呢?(请高手帮吗)
发表于:2008-01-15 16:46:58 楼主
怎么用vb扫描出,正在运行的进程名和运行进程的路径
发表于:2008-01-15 16:50:251楼 得分:0
enumprocess
发表于:2008-01-15 17:11:432楼 得分:0
enumprocess   这个我还没有用过,可以写个代码例子吗?
发表于:2008-01-15 17:23:443楼 得分:0
创建进程快照
while   快照
    取进程句柄
    取进程路径
    编历下一个
loop
发表于:2008-01-15 18:16:084楼 得分:0
private   declare   function   enumprocesses   lib   "psapi.dll"   (byref   lpidprocess   as   long,   byval   cb   as   long,   byref   cbneeded   as   long)   as   long
'常规模式下的进程集合
public   lngprocarr()   as   long
'常规模式枚举进程
public   function   getprocesses()   as   long()
        dim   lngcbneeded   as   long
        dim   lngnumelements   as   long,   lngret   as   long
        redim   lngprocarr(1024)
        lngret   =   enumprocesses(lngprocarr(0),   4   *   1024,   lngcbneeded)
        lngnumelements   =   lngcbneeded   /   4
        redim   preserve   lngprocarr(lngnumelements   -   1)
        getprocesses   =   lngprocarr
end   function

看这篇文章
http://blog.csdn.net/chenhui530/archive/2007/10/09/1817052.aspx
或者我博客上去找有很多你需要的答案

发表于:2008-01-15 18:35:215楼 得分:0
贴在一个from上直接运行

vbscript code
option explicit private const max_path = 260 private type processentry32 dwsize as long cntusage as long th32processid as long th32defaultheapid as long th32moduleid as long cntthreads as long th32parentprocessid as long pcpriclassbase as long dwflags as long szexefile as string * max_path end type private declare function closehandle lib "kernel32" (byval hobject as long) as long private declare function createtoolhelp32snapshot lib "kernel32" (byval dwflags as long, byval th32processid as long) as long private declare function process32first lib "kernel32" (byval hsnapshot as long, lppe as any) as long private declare function process32next lib "kernel32" (byval hsnapshot as long, lppe as any) as long private const th32cs_snapheaplist = &h1 private const th32cs_snapprocess = &h2 private const th32cs_snapthread = &h4 private const th32cs_snapmodule = &h8 private const th32cs_snapall = (th32cs_snapheaplist + th32cs_snapprocess + th32cs_snapthread + th32cs_snapmodule) private const th32cs_inherit = &h80000000 private sub form_load() dim hsnapshot as long, lret as long, p as processentry32 p.dwsize = len(p) hsnapshot = createtoolhelp32snapshot(th32cs_snapall, byval 0) if hsnapshot then lret = process32first(hsnapshot, p) do while lret list1.additem left$(p.szexefile, instr(p.szexefile, chr$(0)) - 1) lret = process32next(hsnapshot, p) loop lret = closehandle(hsnapshot) end if end sub
发表于:2008-01-15 20:01:246楼 得分:0
还需要加一个list控件
发表于:2008-01-16 09:55:147楼 得分:0
caofusheng   怎么获得进程的路径呢?
发表于:2008-01-16 11:05:578楼 得分:0
高手在吗?我还想在补充问题,就是这么获得,开机启动的文件呢?
发表于:2008-01-16 11:08:099楼 得分:0

private   declare   function   module32first   lib   "kernel32"   (byval   hsnapshot   as   long,   lppe   as   moduleentry32)   as   long
private   declare   function   module32next   lib   "kernel32"   (byval   hsnapshot   as   long,   lppe   as   moduleentry32)   as   long
private   type   moduleentry32
        dwsize   as   long
        th32moduleid   as   long
        th32processid   as   long
        glblcntusage   as   long
        proccntusage   as   long
        modbaseaddr   as   byte
        modbasesize   as   long
        hmodule   as   long
        szmodule   as   string   *   256
        szexepath   as   string   *   1024
end   type

dim   mode   as   moduleentry32
dim   strpath   as   string

if   module32first(hsnapshot   ,   mode)     then

    strpath     =   mode.szexepath
end   if
发表于:2008-01-16 13:03:1810楼 得分:0
我执行一下,出来不来啊?
发表于:2008-01-16 13:04:4911楼 得分:0
我执行一下,出不来啊?
发表于:2008-01-17 11:34:5912楼 得分:0
算了,没人回答,我在一个问题,我就结贴了,这个问题就是:怎么获得开机的启动对象呢?
发表于:2008-01-18 11:49:3413楼 得分:0
怎么获得开机的启动对象呢?怎么没有人能回答呢?陈辉大哥在吗?
发表于:2008-01-18 11:52:4314楼 得分:0
查看注册表的run,runonce,runsevice等等。
发表于:2008-01-18 14:18:1215楼 得分:0
可以写段代码例子读run信息吗?
发表于:2008-01-18 15:37:1816楼 得分:0
使用注册表api即可
我给你个模块:
option   explicit

'---------------------------------------------------------------
'-   注册表   api   声明...
'---------------------------------------------------------------
private   declare   function   regclosekey   lib   "advapi32.dll"   (byval   hkey   as   long)   as   long
private   declare   function   regcreatekeyex   lib   "advapi32.dll"   alias   "regcreatekeyexa"   (byval   hkey   as   long,   byval   lpsubkey   as   string,   byval   reserved   as   long,   byval   lpclass   as   string,   byval   dwoptions   as   long,   byval   samdesired   as   long,   lpsecurityattributes   as   security_attributes,   phkresult   as   long,   lpdwdisposition   as   long)   as   long
private   declare   function   regdeletekey   lib   "advapi32.dll"   alias   "regdeletekeya"   (byval   hkey   as   long,   byval   lpsubkey   as   string)   as   long
private   declare   function   regdeletevalue   lib   "advapi32.dll"   alias   "regdeletevaluea"   (byval   hkey   as   long,   byval   lpvaluename   as   string)   as   long
private   declare   function   regopenkeyex   lib   "advapi32.dll"   alias   "regopenkeyexa"   (byval   hkey   as   long,   byval   lpsubkey   as   string,   byval   uloptions   as   long,   byval   samdesired   as   long,   phkresult   as   long)   as   long
private   declare   function   regqueryvalueex   lib   "advapi32.dll"   alias   "regqueryvalueexa"   (byval   hkey   as   long,   byval   lpvaluename   as   string,   byval   lpreserved   as   long,   lptype   as   long,   lpdata   as   any,   lpcbdata   as   long)   as   long
private   declare   function   regrestorekey   lib   "advapi32.dll"   alias   "regrestorekeya"   (byval   hkey   as   long,   byval   lpfile   as   string,   byval   dwflags   as   long)   as   long
private   declare   function   regsavekey   lib   "advapi32.dll"   alias   "regsavekeya"   (byval   hkey   as   long,   byval   lpfile   as   string,   lpsecurityattributes   as   security_attributes)   as   long
private   declare   function   regsetvalueex   lib   "advapi32.dll"   alias   "regsetvalueexa"   (byval   hkey   as   long,   byval   lpvaluename   as   string,   byval   reserved   as   long,   byval   dwtype   as   long,   lpdata   as   any,   byval   cbdata   as   long)   as   long
private   declare   function   regqueryinfokey   lib   "advapi32.dll"   alias   "regqueryinfokeya"   (byval   hkey   as   long,   byval   lpclass   as   string,   lpcbclass   as   long,   byval   lpreserved   as   long,   lpcsubkeys   as   long,   lpcbmaxsubkeylen   as   long,   lpcbmaxclasslen   as   long,   lpcvalues   as   long,   lpcbmaxvaluenamelen   as   long,   lpcbmaxvaluelen   as   long,   lpcbsecuritydescriptor   as   long,   lpftlastwritetime   as   filetime)   as   long
private   declare   function   regenumvalue   lib   "advapi32.dll"   alias   "regenumvaluea"   (byval   hkey   as   long,   byval   dwindex   as   long,   byval   lpvaluename   as   string,   lpcbvaluename   as   long,   byval   lpreserved   as   long,   lptype   as   long,   lpdata   as   byte,   lpcbdata   as   long)   as   long
private   declare   function   regenumkeyex   lib   "advapi32.dll"   alias   "regenumkeyexa"   (byval   hkey   as   long,   byval   dwindex   as   long,   byval   lpname   as   string,   lpcbname   as   long,   byval   lpreserved   as   long,   byval   lpclass   as   string,   lpcbclass   as   long,   lpftlastwritetime   as   filetime)   as   long
private   declare   function   regopenkey   lib   "advapi32.dll"   alias   "regopenkeya"   (byval   hkey   as   long,   byval   lpsubkey   as   string,   phkresult   as   long)   as   long
private   declare   function   regenumkey   lib   "advapi32.dll"   alias   "regenumkeya"   (byval   hkey   as   long,   byval   dwindex   as   long,   byval   lpname   as   string,   byval   cbname   as   long)   as   long

private   declare   function   adjusttokenprivileges   lib   "advapi32.dll"   (byval   tokenhandle   as   long,   byval   disableallpriv   as   long,   newstate   as   token_privileges,   byval   bufferlength   as   long,   previousstate   as   token_privileges,   returnlength   as   long)   as   long                                 'used   to   adjust   your   program's   security   privileges,   can't   restore   without   it!
private   declare   function   lookupprivilegevalue   lib   "advapi32.dll"   alias   "lookupprivilegevaluea"   (byval   lpsystemname   as   any,   byval   lpname   as   string,   lpluid   as   luid)   as   long                     'returns   a   valid   luid   which   is   important   when   making   security   changes   in   nt.
private   declare   function   openprocesstoken   lib   "advapi32.dll"   (byval   processhandle   as   long,   byval   desiredaccess   as   long,   tokenhandle   as   long)   as   long
private   declare   function   getcurrentprocess   lib   "kernel32"   ()   as   long


'---------------------------------------------------------------
'-   注册表   api   常数...
'---------------------------------------------------------------
'   注册表创建类型值...
const   reg_option_non_volatile   =   0                 '   当系统重新启动时,关键字被保留


'   注册表关键字安全选项...
const   read_control   =   &h20000
const   key_query_value   =   &h1
const   key_set_value   =   &h2
const   key_create_sub_key   =   &h4
const   key_enumerate_sub_keys   =   &h8
const   key_notify   =   &h10
const   key_create_link   =   &h20
const   key_read   =   key_query_value   +   key_enumerate_sub_keys   +   key_notify   +   read_control
const   key_write   =   key_set_value   +   key_create_sub_key   +   read_control
const   key_EXECute   =   key_read
const   key_all_access   =   key_query_value   +   key_set_value   +   key_create_sub_key   +   key_enumerate_sub_keys   +   key_notify   +   key_create_link   +   read_control
                                         
'   返回值...
const   error_none   =   0
const   error_badkey   =   2
const   error_access_denied   =   8
const   error_success   =   0


'   有关导入/导出的常量
const   reg_force_restore   as   long   =   8&
const   token_query   as   long   =   &h8&
const   token_adjust_privileges   as   long   =   &h20&
const   se_privilege_enabled   as   long   =   &h2
const   se_restore_name   =   "serestoreprivilege"
const   se_backup_name   =   "sebackupprivilege"


'---------------------------------------------------------------
'-   注册表类型...
'---------------------------------------------------------------
private   type   security_attributes
        nlength   as   long
        lpsecuritydescriptor   as   long
        binherithandle   as   boolean
end   type


private   type   filetime
        dwlowdatetime   as   long
        dwhighdatetime   as   long
end   type


private   type   luid
        lowpart   as   long
        highpart   as   long
end   type


private   type   luid_and_attributes
        pluid   as   luid
        attributes   as   long
end   type


private   type   token_privileges
        privilegecount   as   long
        privileges   as   luid_and_attributes
end   type


'---------------------------------------------------------------
'-   自定义枚举类型...
'---------------------------------------------------------------
'   注册表数据类型...
public   enum   valuetype
        reg_sz   =   1                                                   '   字符串值
        reg_expand_sz   =   2                                     '   可扩充字符串值
        reg_binary   =   3                                           '   二进制值
        reg_dword   =   4                                             '   dword值
        reg_multi_sz   =   7                                       '   多字符串值
end   enum


'   注册表关键字根类型...
public   enum   keyroot
        hkey_classes_root   =   &h80000000
        hkey_current_user   =   &h80000001
        hkey_local_machine   =   &h80000002
        hkey_users   =   &h80000003
        hkey_performance_data   =   &h80000004
        hkey_current_config   =   &h80000005
        hkey_dyn_data   =   &h80000006
end   enum


public   strstring   as   string
private   hkey   as   long                                       '   注册表打开项的句柄
private   i   as   long,   j   as   long                       '   循环变量
private   success   as   long                                 '   api函数的返回值,   判断函数调用是否成功


发表于:2008-01-18 15:38:3217楼 得分:0
'-------------------------------------------------------------------------------------------------------------
'-   新建注册表关键字并设置注册表关键字的值...
'-   如果   valuename   和   value   都缺省,   则只新建   keyname   空项,   无子键...
'-   如果只缺省   valuename   则将设置指定   keyname   的默认值
'-   参数说明:   keyroot--根类型,   keyname--子项名称,   valuename--值项名称,   value--值项数据,   valuetype--值项类型
'-------------------------------------------------------------------------------------------------------------
public   function   setkeyvalue(keyroot   as   keyroot,   keyname   as   string,   optional   valuename   as   string,   optional   value   as   variant   =   "",   optional   valuetype   as   valuetype   =   reg_sz)   as   boolean
        dim   lpattr   as   security_attributes                                       '   注册表安全类型
        lpattr.nlength   =   50                                                                   '   设置安全属性为缺省值...
        lpattr.lpsecuritydescriptor   =   0                                           '   ...
        lpattr.binherithandle   =   true                                                 '   ...
       
        '   新建注册表关键字...
        success   =   regcreatekeyex(keyroot,   keyname,   0,   valuetype,   reg_option_non_volatile,   key_all_access,   lpattr,   hkey,   0)
        if   success   <>   error_success   then   setkeyvalue   =   false:   regclosekey   hkey:   exit   function
       
        '   设置注册表关键字的值...
        if   ismissing(valuename)   =   false   then
                select   case   valuetype
                        case   reg_sz,   reg_expand_sz,   reg_multi_sz
                                success   =   regsetvalueex(hkey,   valuename,   0,   valuetype,   byval   cstr(value),   lenb(strconv(value,   vbfromunicode))   +   1)
                        case   reg_dword
                                if   cdbl(value)   <=   4294967295#   and   cdbl(value)   > =   0   then
                                        dim   svalue   as   string
                                        svalue   =   doubletohex(value)
                                        dim   dvalue(3)   as   byte
                                        dvalue(0)   =   format("&h"   &   mid(svalue,   7,   2))
                                        dvalue(1)   =   format("&h"   &   mid(svalue,   5,   2))
                                        dvalue(2)   =   format("&h"   &   mid(svalue,   3,   2))
                                        dvalue(3)   =   format("&h"   &   mid(svalue,   1,   2))
                                        success   =   regsetvalueex(hkey,   valuename,   0,   valuetype,   dvalue(0),   4)
                                else
                                        success   =   error_badkey
                                end   if
                        case   reg_binary
                                on   error   resume   next
                                success   =   1                                                           '   假设调用api不成功(成功返回0)
                                redim   tmpvalue(ubound(value))   as   byte
                                for   i   =   0   to   ubound(tmpvalue)
                                        tmpvalue(i)   =   value(i)
                                next   i
                                success   =   regsetvalueex(hkey,   valuename,   0,   valuetype,   tmpvalue(0),   ubound(value)   +   1)
                end   select
        end   if
        if   success   <>   error_success   then   setkeyvalue   =   false:   regclosekey   hkey:   exit   function
       
        '   关闭注册表关键字...
        regclosekey   hkey
        setkeyvalue   =   true                                                                               '   返回函数值
end   function


'-------------------------------------------------------------------------------------------------------------
'-   获得已存在的注册表关键字的值...
'-   如果   valuename=""   则返回   keyname   项的默认值...
'-   如果指定的注册表关键字不存在,   则返回空串...
'-   参数说明:   keyroot--根类型,   keyname--子项名称,   valuename--值项名称,   valuetype--值项类型
'-------------------------------------------------------------------------------------------------------------
public   function   getkeyvalue(byval   keyroot   as   keyroot,   byval   keyname   as   string,   byval   valuename   as   string,   optional   byval   valuetype   as   long)   as   string
        dim   tempvalue   as   string                                                           '   注册表关键字的临时值
        dim   value   as   string                                                                   '   注册表关键字的值
        dim   valuesize   as   long                                                               '   注册表关键字的值的实际长度
        tempvalue   =   space(1024)                                                           '   存储注册表关键字的临时值的缓冲区
        valuesize   =   1024                                                                         '   设置注册表关键字的值的默认长度

        '   打开一个已存在的注册表关键字...
        regopenkeyex   keyroot,   keyname,   0,   key_all_access,   hkey
        if   hkey   =   0   then
                getkeyvalue   =   "^_*_*_^"
                exit   function
        end   if
        dim   x   as   integer
        x   =   regqueryvalueex(hkey,   valuename,   0,   valuetype,   byval   tempvalue,   valuesize)
        '   获得已打开的注册表关键字的值...
        if   x   <>   0   then
                if   x   =   2   and   valuesize   =   1024   then
                        getkeyvalue   =   "^_*_*_^"
                        exit   function
                end   if
        end   if
        '   返回注册表关键字的的值...
        select   case   valuetype                                                                                                                 '   通过判断关键字的类型,   进行处理
                case   reg_sz,   reg_multi_sz,   reg_expand_sz
                        if   valuesize   >   0   then   tempvalue   =   left$(tempvalue,   valuesize   -   1)                                               '   去掉tempvalue尾部空格
                        value   =   tempvalue
                case   reg_dword
                        redim   dvalue(3)   as   byte
                        regqueryvalueex   hkey,   valuename,   0,   reg_dword,   dvalue(0),   valuesize
                        for   i   =   3   to   0   step   -1
                                value   =   value   +   string(2   -   len(hex(dvalue(i))),   "0")   +   hex(dvalue(i))       '   生成长度为8的十六进制字符串
                        next   i
                        if   cdbl("&h"   &   value)   <   0   then                                                                                             '   将十六进制的   value   转换为十进制
                                value   =   2   ^   32   +   cdbl("&h"   &   value)
                        else
                                value   =   cdbl("&h"   &   value)
                        end   if
                case   reg_binary
                        if   valuesize   >   0   then
                                redim   bvalue(valuesize   -   1)   as   byte                                                                           '   存储   reg_binary   值的临时数组
                                regqueryvalueex   hkey,   valuename,   0,   reg_binary,   bvalue(0),   valuesize
                                for   i   =   0   to   valuesize   -   1
                                        value   =   value   +   string(2   -   len(hex(bvalue(i))),   "0")   +   hex(bvalue(i))   +   "   "     '   将数组转换成字符串
                                next   i
                        end   if
        end   select
       
        '   关闭注册表关键字...
        regclosekey   hkey
        value   =   trim(value)
        if   instr(value,   chr(0))   then
                getkeyvalue   =   left(value,   instr(value,   chr(0))   -   1)                                                                               '   返回函数值
        else
                getkeyvalue   =   value
        end   if
end   function


public   function   regdeletekeyname(mhkey   as   keyroot,   subkey   as   string,   hkeyname   as   string)   as   boolean
        '删除子键数据
        'mhkey是指主键的名称,subkey是指路径,hkeyname是指键名
        dim   hkey   as   long,   ret   as   long
        ret   =   regopenkey(mhkey,   subkey,   hkey)
        regdeletekeyname   =   false
        if   ret   =   0   then
                if   regdeletevalue(hkey,   hkeyname)   =   0   then   regdeletekeyname   =   true
        end   if
        regclosekey   hkey   '删除打开的键值,释放内存
end   function

'-------------------------------------------------------------------------------------------------------------
'-   将   double   型(   限制在   0--2^32-1   )的数字转换为十六进制并在前面补零
'-   参数说明:   number--要转换的   double   型数字
'-------------------------------------------------------------------------------------------------------------
private   function   doubletohex(byval   number   as   double)   as   string
        dim   strhex   as   string
        strhex   =   space(8)
        for   i   =   1   to   8
                select   case   number   -   int(number   /   16)   *   16
                        case   10
                                mid(strhex,   9   -   i,   1)   =   "a"
                        case   11
                                mid(strhex,   9   -   i,   1)   =   "b"
                        case   12
                                mid(strhex,   9   -   i,   1)   =   "c"
                        case   13
                                mid(strhex,   9   -   i,   1)   =   "d"
                        case   14
                                mid(strhex,   9   -   i,   1)   =   "e"
                        case   15
                                mid(strhex,   9   -   i,   1)   =   "f"
                        case   else
                                mid(strhex,   9   -   i,   1)   =   cstr(number   -   int(number   /   16)   *   16)
                end   select
                number   =   int(number   /   16)
        next   i
        doubletohex   =   strhex
end   function
发表于:2008-01-18 15:39:3018楼 得分:0
public   function   getkeyvaluetype(byval   keyroot   as   keyroot,   byval   keyname   as   string,   byval   checkvaluename   as   string)   as   valuetype
        dim   f   as   filetime,   countkey   as   long,   countvalue   as   long,   maxlenkey   as   long,   maxlenvalue   as   long
        dim   l   as   long,   s   as   string,   strtmp   as   string,   inttmp   as   long,   valuename()   as   string,   valuetype()   as   valuetype
       
        '   打开一个已存在的注册表关键字...
        success   =   regopenkeyex(keyroot,   keyname,   0,   key_all_access,   hkey)
        if   success   <>   error_success   then   getkeyvaluetype   =   0:   regclosekey   hkey:   exit   function
       
        '   获得一个已打开的注册表关键字的信息...
        success   =   regqueryinfokey(hkey,   vbnullstring,   byval   0&,   byval   0&,   countkey,   maxlenkey,   byval   0&,   countvalue,   maxlenvalue,   byval   0&,   byval   0&,   f)
       
        if   success   <>   error_success   then   getkeyvaluetype   =   0:   regclosekey   hkey:   exit   function

        if   countvalue   <>   0   then
                redim   valuename(countvalue   -   1)   as   string                       '   重新定义数组,   使用数组大小与注册表关键字的子键数量匹配
                redim   valuetype(countvalue   -   1)   'as   long                           '   重新定义数组,   使用数组大小与注册表关键字的子键数量匹配
                for   i   =   0   to   countvalue   -   1
                        strtmp   =   string(255,   vbnullchar)   'space(255)
                        l   =   255
                        regenumvalue   hkey,   i,   byval   strtmp,   l,   0,   inttmp,   byval   0&,   byval   0&
                        valuetype(i)   =   inttmp
                        valuename(i)   =   left(strtmp,   l)
                        if   instr(valuename(i),   vbnullchar)   -   1   <>   -1   then
                                valuename(i)   =   left$(valuename(i),   instr(valuename(i),   vbnullchar)   -   1)
                        end   if
                        if   valuename(i)   =   checkvaluename   then
                                getkeyvaluetype   =   valuetype(i)
                                exit   function
                        end   if
                next   i
        end   if
       
        '   关闭注册表关键字...
        regclosekey   hkey
end   function

public   function   getkeyinfo(keyroot   as   keyroot,   keyname   as   string,   subkeyname()   as   string,   valuename()   as   string,   valuetype()   as   valuetype,   optional   countkey   as   long,   optional   countvalue   as   long,   optional   maxlenkey   as   long,   optional   maxlenvalue   as   long)   as   boolean
        dim   f   as   filetime
        dim   l   as   long,   s   as   string,   strtmp   as   string,   inttmp   as   long
       
        '   打开一个已存在的注册表关键字...
        success   =   regopenkeyex(keyroot,   keyname,   0,   key_all_access,   hkey)
        if   success   <>   error_success   then   getkeyinfo   =   false:   regclosekey   hkey:   exit   function
       
        '   获得一个已打开的注册表关键字的信息...
        success   =   regqueryinfokey(hkey,   vbnullstring,   byval   0&,   byval   0&,   countkey,   maxlenkey,   byval   0&,   countvalue,   maxlenvalue,   byval   0&,   byval   0&,   f)
       
        if   success   <>   error_success   then   getkeyinfo   =   false:   regclosekey   hkey:   exit   function
       
        if   countkey   <>   0   then
                redim   subkeyname(countkey   -   1)   as   string                         '   重新定义数组,   使用数组大小与注册表关键字的子项数量匹配
                for   i   =   0   to   countkey   -   1
                        strtmp   =   string(255,   vbnullchar)   'space(255)
                        l   =   255
                        regenumkeyex   hkey,   i,   byval   strtmp,   l,   0,   vbnullstring,   byval   0&,   f
                        subkeyname(i)   =   left(strtmp,   l)
                        if   instr(subkeyname(i),   vbnullchar)   -   1   <>   -1   then
                                subkeyname(i)   =   left$(subkeyname(i),   instr(subkeyname(i),   vbnullchar)   -   1)
                        end   if
                next   i
               
                '   下面的二重循环对字符串数组进行冒泡排序
                for   i   =   0   to   ubound(subkeyname)
                        for   j   =   i   +   1   to   ubound(subkeyname)
                                if   subkeyname(i)   >   subkeyname(j)   then
                                        s   =   subkeyname(i)
                                        subkeyname(i)   =   subkeyname(j)
                                        subkeyname(j)   =   s
                                end   if
                        next   j
                next   i
        end   if

        if   countvalue   <>   0   then
                redim   valuename(countvalue   -   1)   as   string                       '   重新定义数组,   使用数组大小与注册表关键字的子键数量匹配
                redim   valuetype(countvalue   -   1)   'as   long                           '   重新定义数组,   使用数组大小与注册表关键字的子键数量匹配
                for   i   =   0   to   countvalue   -   1
                        strtmp   =   string(255,   vbnullchar)   'space(255)
                       
                        l   =   255
                        regenumvalue   hkey,   i,   byval   strtmp,   l,   0,   inttmp,   byval   0&,   byval   0&
                        valuetype(i)   =   inttmp
                        valuename(i)   =   left(strtmp,   l)
                        if   instr(valuename(i),   vbnullchar)   -   1   <>   -1   then
                                valuename(i)   =   left$(valuename(i),   instr(valuename(i),   vbnullchar)   -   1)
                        end   if
                next   i
               
                '   下面的二重循环对字符串数组进行冒泡排序
                for   i   =   0   to   ubound(valuename)
                        for   j   =   i   +   1   to   ubound(valuename)
                                if   valuename(i)   >   valuename(j)   then
                                        s   =   valuename(i)
                                        valuename(i)   =   valuename(j)
                                        valuename(j)   =   s
                                end   if
                        next   j
                next   i
        end   if
       
        '   关闭注册表关键字...
        regclosekey   hkey
        getkeyinfo   =   true                                                                       '   返回函数值
end   function

public   function   regdeletesubkey(hkey   as   keyroot,   subkey   as   string)   as   boolean
        '删除目录
        'mhkey是指主键的名称,subkey是指路径
        dim   ret   as   long,   index   as   long,   hname   as   string
        dim   hsubkey   as   long
        ret   =   regopenkey(hkey,   subkey,   hsubkey)
        if   ret   <>   0   then
                regdeletesubkey   =   false
                exit   function
        end   if
        ret   =   regdeletekey(hsubkey,   "")
        if   ret   <>   0   then   '如果删除失败则认为是nt则用递归方法删除目录
                hname   =   string(256,   chr(0))
                while   regenumkey(hsubkey,   0,   hname,   len(hname))   =   0   and   _
                            regdeletesubkey(hsubkey,   hname)
                wend
                ret   =   regdeletekey(hsubkey,   "")
        end   if
        regdeletesubkey   =   (ret   =   0)
        regclosekey   hsubkey   '删除打开的键值,释放内存
end   function


快速检索

最新资讯
热门点击