学步园

好久没有写东西了，这两天晚上抽空又熟悉了一下 TlHelp32 中几个 api 函数，有点收获，也要感谢 yrt888，如果没有他提出这个问题，我也不会研究这几个 api 的用法。下面是这个工具的 prg 版本（不知道如何上传文件到这个博客，换成 prg 版本可是花了点时间的），由于主要是研究 api 函数的用法，所以没有去实现一个工具应有的一些功能，例如点题头排序，右键菜单，自动刷新等，其实要自动刷新很容易，加个计时器，定时调用刷新按钮的 click 即可。

用法：也没什么用法的问题啦，直接运行即可看到结果，隐藏没有提示的操作只有双击 grid 字符列时会弹出模块窗口，双击数值列则弹出线程窗口。 

*!* =============================================================================
*!* 主程序
*!* 作者: dkfdtf
*!* 目的: 熟悉 TlHelp32 中提供的列举系统进程/模块/线程 api 的使用
*!* 历史: 2008.07.03 - 第一版
*!* 　　  2008.07.04 - 第二版, 增加进程树表单视图
*!* 　　  2008.07.05 - 第三版, 可以查看系统进程(如 winlogon.exe)的模块了
*!* 　　  2008.07.06 - 第四版, 应 yrt888 要求加了存储器使用情况显示，更正一个 bug
*!* =============================================================================
IF ( VERSION(5) < 700 )
  MESSAGEBOX( '需要 vfp7 以上版本', 16, '错误' )
  RETURN
ENDIF
IF ( INT(VAL(OS(3))) < 5 )
  MESSAGEBOX( '仅适用于 Win2000 以上操作系统', 16, '错误' )
  RETURN
ENDIF

CLEAR ALL
CLOSE DATABASES
SET TALK OFF
SET SAFETY OFF

m.goProcMgr = NEWOBJECT( 'ProcMgr' )
IF m.goProcMgr.GetProcess()
  m.oFrmProcess = NEWOBJECT( 'frmProcess' )
  m.oFrmProcess.Show
  READ EVENTS
ENDIF

CLOSE DATABASES
RETURN

*!* ================================================================
*!* 类定义
*!* ================================================================
DEFINE CLASS MyGrid AS Grid
  AllowCellSelection = .F.
  DeleteMark = .F.
  RecordMark = .F.
  SplitBar = .F.
  GridLines = 0
  HeaderHeight = 22

  PROCEDURE Init
    This.SetAll( 'Alignment', 2, 'Header' )
    This.SetAll( 'FontName', 'Tahoma' )
    This.SetAll( 'FontSize', 8, 'Column' )
    This.SetAll( 'DynamicBackColor', ;
      'iif(recn()%2==0,rgb(240,250,255),rgb(255,255,255))' )
  ENDPROC
ENDDEFINE

*!* ----------------------------------------------------------------
*!* 进程浏览表单(主表单)
*!* ----------------------------------------------------------------
DEFINE CLASS frmProcess AS Form
  Height = 265
  Width = 370
  ShowWindow = 2
  DoCreate = .T.
  Caption = '系统进程信息查看器'
  AllowOutput = .F.
  Name = 'frmProcess'

  ADD OBJECT grd AS MyGrid WITH ;
    Name = 'grd'

  ADD OBJECT cmdModules AS commandbutton WITH ;
    Top = 228, ;
    Left = 12, ;
    Height = 27, ;
    Width = 72, ;
    Anchor = 6, ;
    Caption = '显示模块', ;
    Name = 'cmdModules'

  ADD OBJECT cmdThreads AS commandbutton WITH ;
    Top = 228, ;
    Left = 91, ;
    Height = 27, ;
    Width = 72, ;
    Anchor = 6, ;
    Caption = '显示线程', ;
    Name = 'cmdThreads'

  ADD OBJECT cmdProcTreeview AS commandbutton WITH ;
    Top = 228, ;
    Left = 170, ;
    Height = 27, ;
    Width = 72, ;
    Anchor = 6, ;
    Caption = '进程树', ;
    Name = 'cmdProcTreeview'

  ADD OBJECT cmdRefresh AS commandbutton WITH ;
    Top = 228, ;
    Left = 312, ;
    Height = 27, ;
    Width = 48, ;
    Anchor = 12, ;
    Caption = '刷新', ;
    Name = 'cmdRefresh'
  
  PROCEDURE Init
    This.Move( ;
      INT( SYSMETRIC(1)*0.2 ), ;
      INT( SYSMETRIC(2)*0.2 ), ;
      INT( SYSMETRIC(1)*0.6 ), ;
      INT( SYSMETRIC(2)*0.6 ) )

    WITH This.grd
      .RecordSource = 'listprocs'

      .ColumnCount = 6
      WITH .Column1
        .ControlSource   = '[ ]+listprocs.imgname'
        .Header1.Caption = '映像名'
        .Width = 100
        .Alignment = 0
      ENDWITH
      WITH .Column2
        .ControlSource   = 'listprocs.pid'
        .Header1.Caption = 'PID'
        .Width = 50
        .Alignment = 2
      ENDWITH
      WITH .Column3
        .ControlSource   = 'listprocs.threads'
        .Header1.Caption = '线程数'
        .Width = 45
        .Alignment = 2
      ENDWITH
      WITH .Column4
        .ControlSource   = 'listprocs.worksize'
        .Header1.Caption = '物理内存'
        .Width = 60
        .Format = 'T'
        .Alignment = 1
      ENDWITH
      WITH .Column5
        .ControlSource   = 'listprocs.pagesize'
        .Header1.Caption = '虚拟内存'
        .Width = 60
        .Format = 'T'
        .Alignment = 1
      ENDWITH
      WITH .Column6
        .ControlSource   = 'listprocs.exefile'
        .Header1.Caption = '映像路径'
        .Width = 1000
        .Alignment = 0
      ENDWITH

      .Init()
      This.SetAll( 'DynamicBackColor', ;
        'iif(recn()%2==0,rgb(255,250,240),rgb(255,255,255))' )

      .Move( 0, 0, This.Width, ;
        This.Height - This.cmdRefresh.Height - 20 )
      .Anchor = 15
    ENDWITH

    GOTO TOP IN listprocs
  ENDPROC

  PROCEDURE Unload
    CLEAR EVENTS
  ENDPROC
  
  PROCEDURE grd.DblClick
    IF ( 'C' == VARTYPE( This.Value ))
      Thisform.cmdModules.Click()
    ELSE
      Thisform.cmdThreads.Click()
    ENDIF
  ENDPROC

  PROCEDURE cmdModules.Click
    IF m.goProcMgr.GetModules( listprocs.pid, listprocs.imgname )
      m.oFrmModules = NEWOBJECT( 'frmModules' )
      WITH m.oFrmModules
        .Caption = ALLTRIM( listprocs.imgname ) ;
          + '(PID=' + TRANSFORM( listprocs.pid ) + ') ' + .Caption
        .Move( Thisform.Left, Thisform.Top )
        .Show(1)
      ENDWITH
    ENDIF
  ENDPROC

  PROCEDURE cmdThreads.Click
    IF m.goProcMgr.GetThreads( listprocs.pid )
      m.oFrmThreads = NEWOBJECT( 'frmThreads' )
      WITH m.oFrmThreads
        .Caption = ALLTRIM( listprocs.imgname ) + ' ' + .Caption
        .Move( Thisform.Left, Thisform.Top )
        .Show(1)
      ENDWITH
    ENDIF
  ENDPROC

  PROCEDURE cmdProcTreeview.Click
    m.oFrmProcTvw = NEWOBJECT( 'frmProcTreeView' )
    WITH m.oFrmProcTvw
      .Move( Thisform.Left, Thisform.Top )
      .Show(1)
    ENDWITH
  ENDPROC

  PROCEDURE cmdRefresh.Click
    LOCAL iOldRec

    m.iOldRec = RECNO( 'listprocs' )
    m.goProcMgr.GetProcess()
    
    TRY
      GOTO ( m.iOldRec ) IN listprocs
    CATCH
      GOTO TOP IN listprocs
    ENDTRY
    Thisform.grd.Refresh()
  ENDPROC
ENDDEFINE

*!* ----------------------------------------------------------------
*!* 模块浏览表单
*!* ----------------------------------------------------------------
DEFINE CLASS frmModules AS form
  Height = 287
  Width = 552
  Desktop = .T.
  ShowWindow = 1
  DoCreate = .T.
  Caption = '模块'
  Name = 'frmModules'

  PROCEDURE Init
    This.NewObject( 'grd', 'MyGrid' )

    WITH This.grd
      .Move( 0, 0, This.Width, This.Height )
      .Anchor = 15

      .RecordSourceType = 1
      .RecordSource = 'listmods'
      .ColumnCount = 4

      WITH .Column1
        .ControlSource = '[ ]+listmods.imgname'
        .Header1.Caption = '映像名'
        .Alignment = 0
        .Width = 100
      ENDWITH
      WITH .Column2
        .ControlSource = 'ltrim(ltrim(trans(listmods.addr,[@0]),[0x]),[0])'
        .Header1.Caption = '加载基址'
        .Alignment = 1
        .Width = 80
      ENDWITH
      WITH .Column3
        .ControlSource = 'listmods.size'
        .Header1.Caption = '大小'
        .Alignment = 1
        .Width = 80
      ENDWITH
      WITH .Column4
        .ControlSource = '[ ]+listmods.exefile'
        .Header1.Caption = '映像路径'
        .Width = 1000
      ENDWITH

      .Init()
      .Visible = .T.
    ENDWITH

    GOTO TOP IN listmods
  ENDPROC
ENDDEFINE

*!* ----------------------------------------------------------------
*!* 线程浏览表单
*!* ----------------------------------------------------------------
DEFINE CLASS frmThreads AS form
  Height = 250
  Width = 216
  Desktop = .T.
  ShowWindow = 1
  DoCreate = .T.
  BorderStyle = 1
  Caption = '线程'
  MaxButton = .F.
  MinButton = .F.
  Name = 'frmThreads'

  PROCEDURE Init
    This.NewObject( 'grd', 'MyGrid' )

    WITH This.grd
      .Move( 0, 0, This.Width, This.Height )
      .Anchor = 15

      .RecordSourceType = 1
      .RecordSource = 'listtrds'
      .ColumnCount = 2

      WITH .Column1
        .ControlSource = 'listtrds.tid'
        .Header1.Caption = '线程 ID'
        .Alignment = 2
        .Width = 70
      ENDWITH
      WITH .Column2
        .ControlSource = 'listtrds.priority'
        .Header1.Caption = '优先级'
        .Alignment = 2
        .Width = 122
      ENDWITH

      .Init()
      .Visible = .T.
    ENDWITH
    
    GOTO TOP IN listtrds
  ENDPROC
ENDDEFINE

*!* ----------------------------------------------------------------
*!* 进程树浏览表单
*!* ----------------------------------------------------------------
DEFINE CLASS frmProcTreeview AS Form
  Height = 382
  Width = 354
  Desktop = .T.
  ShowWindow = 1
  DoCreate = .T.
  Caption = '当前进程树'
  AllowOutput = .F.
  Name = 'frmProcTreeview'

  PROCEDURE Init
    LOCAL cCurKey, oNode

    This.AddObject( 'tvw', 'OleControl', 'COMCTL.TreeCtrl.1' )
    This.AddNodes()

    m.cCurKey = 'p_' +  TRANSFORM( listprocs.pid )
    WITH This.tvw AS COMCTL.TreeCtrl
      .Move( 1, 1, This.Width-2, This.Height-2 )
      WITH .Font
        .Name = 'Tahoma'
        .Size = 9
      ENDWITH
      .Appearance = 0
      .Indentation = 15
      .LineStyle = 1
      .Style = 7

      FOR EACH m.oNode IN .Nodes
        IF ( m.oNode.Key == m.cCurKey )
          m.oNode.EnsureVisible()
          m.oNode.Selected = .T.
        ENDIF
      ENDFOR

      .Anchor = 15
      .Visible = .T.
    ENDWITH
  ENDPROC
  
  HIDDEN PROCEDURE AddNodes
    LOCAL iOldArea, cNodeKey, oNode
    m.iOldArea = SELECT(0)

    SELECT pid, parent, imgname FROM listprocs ;
      WHERE ( 0 == parent ) ;
       OR ( parent NOT IN ( SELECT pid FROM listprocs )) ;
      INTO CURSOR curParent NOFILTER
    SELECT pid, parent, imgname FROM listprocs ;
      WHERE pid NOT IN ( SELECT pid FROM curParent ) ;
      INTO CURSOR curSubProc

    SELECT curParent
    SCAN ALL
      m.cNodeKey = 'p_' + TRANSFORM(pid)
      m.oNode = This.tvw.Nodes.Add( , 1, m.cNodeKey, ;
        ALLTRIM( imgname ) + ' (' +TRANSFORM(pid)+')' )
      This.AddSubNodes( pid, m.cNodeKey )
      m.oNode.Expanded = .T.
    ENDSCAN

    USE IN ( SELECT( 'curParent' ))
    USE IN ( SELECT( 'curSubProc' ))
    SELECT ( m.iOldArea )
  ENDPROC

  HIDDEN PROCEDURE AddSubNodes
    LPARAMETERS tiParentId, tcParentKey

    LOCAL cNodeKey, iOldRec, oNode

    SELECT curSubProc
    m.iOldRec = RECNO()
    SCAN ALL FOR ( parent == m.tiParentId )
      m.cNodeKey = 'p_' + TRANSFORM(pid)
      m.oNode = This.tvw.Nodes.Add( m.tcParentKey, 4, m.cNodeKey, ;
        ALLTRIM( imgname ) + ' (' +TRANSFORM(pid)+')' )
      This.AddSubNodes( pid, m.cNodeKey )
      m.oNode.Expanded = .T.
    ENDSCAN

    GOTO ( m.iOldRec ) IN curSubProc
  ENDPROC
ENDDEFINE


*!* ----------------------------------------------------------------
*!* 进程管理类
*!* ----------------------------------------------------------------
DEFINE CLASS ProcMgr AS Custom
  Name = 'ProcMgr'

  PROCEDURE Init
    DECLARE Long GetLastError IN WIN32API
    DECLARE Long FormatMessage IN WIN32API ;
      Long dwFlags, Long lpSource, Long dwMessageId, Long dwLanguageId, ;
      String @ lpBuffer, Long nSize, Long Arguments
    DECLARE Long CloseHandle IN WIN32API Long hObject

    DECLARE Long GetCurrentProcess IN WIN32API
    DECLARE Long OpenProcess IN WIN32API ;
      Long dwDesiredAccess, Long bInheritHandle, Long dwProcessId
    DECLARE Long OpenThread IN WIN32API ;
      Long dwDesiredAccess, Long bInheritHandle, Long dwThreadId
    DECLARE Long GetThreadPriority IN WIN32API Long hThread
    DECLARE Long OpenProcessToken IN WIN32API ;
      Long ProcessHandle, Long DesiredAccess, Long @ TokenHandle
    DECLARE Long LookupPrivilegeValue IN WIN32API ;
      String pSystemName, String lpName, String @ lpLuid
    DECLARE Long AdjustTokenPrivileges IN WIN32API ;
      Long TokenHandle, Long DisableAllPrivileges, ;
      String @ NewState, Long BufferLength, ;
      String @ PreviousState, Long @ ReturnLength

    DECLARE Long CreateToolhelp32Snapshot IN WIN32API ;
      Long dwFlags, Long th32ProcessID
    DECLARE Long Process32First IN WIN32API Long hSnapshot, String @ lppe
    DECLARE Long Process32Next  IN WIN32API Long hSnapshot, String @ lppe
    DECLARE Long Module32First  IN WIN32API Long hSnapshot, String @ lpme
    DECLARE Long Module32Next   IN WIN32API Long hSnapshot, String @ lpme
    DECLARE Long Thread32First  IN WIN32API Long hSnapshot, String @ lpte
    DECLARE Long Thread32Next   IN WIN32API Long hSnapshot, String @ lpte

    DECLARE Long EnumProcessModules IN PsApi ;
      Long hProcess, String @lphModule, Long cb, Long @ lpcbNeeded
    DECLARE Long GetModuleFileNameEx IN PsApi ;
      Long hProcess, Long hModule, String @ lpExename, Long dwSize
    DECLARE Long GetProcessMemoryInfo IN PsApi ;
      Long hProcess, String @ ppsmemCounters, Long cb

    This.SetPrivileges()
  ENDPROC

  HIDDEN PROCEDURE GetImgFile
    LPARAMETERS tiPid, thModule

    #define PROCESS_VM_READ             0x0010
    #define PROCESS_QUERY_INFORMATION   0x0400
    #define PROCESS_ALL_ACCESS          0x001FFFFF

    IF ( 0 == m.tiPid )
      RETURN ''
    ENDIF

    LOCAL hProc, cFile, iSize

    m.hProc = OpenProcess( ;
      PROCESS_VM_READ + PROCESS_QUERY_INFORMATION, 0, m.tiPid )
    IF ( 0 == m.hProc )
      m.cFile = This.Win32Message( GetLastError())
    ELSE
      m.iSize = 260
      m.cFile = REPLICATE( CHR(0), m.iSize )
      m.iSize = GetModuleFileNameEx( m.hProc, m.thModule, @ m.cFile, m.iSize )
      CloseHandle( m.hProc )
      m.cFile = LEFTC( m.cFile, m.iSize )
    ENDIF
    RETURN This.TransFileName( m.cFile )
  ENDPROC

  HIDDEN PROCEDURE AsciiZString
    LPARAMETERS tcString
    
    RETURN LEFT( m.tcString, AT( CHR(0), m.tcString )-1 )
  ENDPROC

  HIDDEN PROCEDURE Win32Message
    LPARAMETERS tiErrNo

    #define FORMAT_MESSAGE_FROM_SYSTEM    0x1000
    #define FORMAT_MESSAGE_IGNORE_INSERTS 0x0200
    #define FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF
    #define LANG_USER_DEFAULT             0x0804

    LOCAL cBuffer, iLen

    m.cBuffer = REPLICATE( CHR(0), 256+1 )
    m.iLen = FormatMessage( ;
        FORMAT_MESSAGE_FROM_SYSTEM ;
      + FORMAT_MESSAGE_MAX_WIDTH_MASK ;
      + FORMAT_MESSAGE_IGNORE_INSERTS, ;
      0, m.tiErrNo, LANG_USER_DEFAULT, @ m.cBuffer, 256, 0 )

    RETURN LEFT( m.cBuffer, m.iLen )
  ENDPROC
  
  HIDDEN PROCEDURE GetProcMemInfo
    LPARAMETERS tiPid, tcWorkSize, tcPageSize
    
    #define PROCESS_VM_READ             0x0010
    #define PROCESS_QUERY_INFORMATION   0x0400
    
    LOCAL hProc, cBuff
    
    m.hProc = OpenProcess( ;
      PROCESS_VM_READ + PROCESS_QUERY_INFORMATION, 0, m.tiPid )
    IF ( 0 == m.hProc )
      STORE '??? K' TO m.tcWorkSize, m.tcPageSize
*!*	      This.ErrMsgBox( '获取存储器信息失败！' )
    ELSE
      m.cBuff = BINTOC( 44, 'rs' ) + REPLICATE( CHR(0), 40 )
      IF ( 0 == GetProcessMemoryInfo( m.hProc, @ m.cbuff, LEN( m.cBuff )))
        STORE '??? K' TO m.tcWorkSize, m.tcPageSize
      ELSE
        m.tcWorkSize = This.ToKbMemory( SUBSTR( m.cbuff, 13, 4 ))
        m.tcPageSize = This.ToKbMemory( SUBSTR( m.cbuff, 33, 4 ))
      ENDIF
      CloseHandle( m.hProc )
    ENDIF
  ENDPROC
  
  HIDDEN PROCEDURE ToKbMemory
    LPARAMETERS tcSize
    LOCAL cKilo
    
    m.cKilo = TRANSFORM( CTOBIN( m.tcSize, 'rs' ) / 1024 )
    RETURN IIF( '.' $ m.cKilo, RTRIM( m.cKilo, '0' ), m.cKilo ) + ' K'
  ENDPROC
  
  PROCEDURE GetProcess
    #define TH32CS_SNAPPROCESS      0x00000002
    #define ERROR_NO_MORE_FILES     18

    LOCAL hSS, iSize, cBuff, iPid, tcMem1, tcMem2

    m.hSS = CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 )
    IF ( -1 == m.hSS )
      This.ErrMsgBox( '创建进程快照失败！' )
      RETURN .F.
    ENDIF

    m.iSize = 8*4+260
    m.cBuff = BINTOC( 4+m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize )
    IF ( 0 == Process32First( m.hSS, @ m.cBuff ))
      CloseHandle( m.hSS )
      This.ErrMsgBox( '获取进程信息失败！' )
      RETURN .F.
    ENDIF

    IF USED( 'listprocs' )
      ZAP IN listprocs
    ELSE
      CREATE CURSOR listprocs ( ;
      pid I, parent I, threads I, imgname C(250), exefile C(250), ;
      	worksize C(12), pagesize C(12) )
    ENDIF

    DO WHILE .T.
      m.iPid = CTOBIN( SUBSTR( m.cBuff, 9, 4 ), 'rs' )
      STORE '' TO m.tcMem1, m.tcMem2
      This.GetProcMemInfo( m.iPid, @ m.tcMem1, @ m.tcMem2 )
      INSERT INTO listprocs ;
        ( pid, parent, threads, imgname, exefile, worksize, pagesize ) ;
      VALUES ( m.iPid, ;
        CTOBIN( SUBSTR( m.cBuff, 25, 4 ), 'rs' ), ;
        CTOBIN( SUBSTR( m.cBuff, 21, 4 ), 'rs' ), ;
        IIF( 0 == m.iPid, '系统空闲进程', ;
          This.AsciiZString( SUBSTR( m.cBuff, 37, 260 ))), ;
        This.GetImgFile( m.iPid, 0 ), ;
        m.tcMem1, m.tcMem2 )
      
      m.cBuff = BINTOC( 4+m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize )
      IF ( 0 == Process32Next( m.hSS, @ m.cBuff )) ;
        OR ( ERROR_NO_MORE_FILES == GetLastError())
        EXIT
      ENDIF
    ENDDO
    CloseHandle( m.hSS )
  ENDPROC

  PROCEDURE GetModules
    LPARAMETERS tiPid, tcProcName

    #define TH32CS_SNAPMODULE       0x00000008
    #define ERROR_NO_MORE_FILES     18

    LOCAL hSS, iSize, cBuff, cImgName

    m.tcProcName = LOWER( ALLTRIM( m.tcProcName ))

    m.hSS = CreateToolhelp32Snapshot( TH32CS_SNAPMODULE, m.tiPid )
    IF ( -1 == m.hSS )
      This.ErrMsgBox( '创建模块快照失败！' )
      RETURN .F.
    ENDIF

    m.iSize = 8*4+256+260
    m.cBuff = BINTOC( 4+m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize )
    IF ( 0 == Module32First( m.hSS, @ m.cBuff ))
      CloseHandle( m.hSS )
      This.ErrMsgBox( '获取模块信息失败！' )
      RETURN .F.
    ENDIF

    IF USED( 'listmods' )
      ZAP IN listmods
    ELSE
      CREATE CURSOR listmods ( ;
        addr I, size I, imgname C(250), exefile C(250) )
    ENDIF

    DO WHILE .T.
      m.cImgName = This.AsciiZString( SUBSTR( m.cBuff, 33, 260 ))
      IF ( LOWER( m.cImgName ) == m.tcProcName )
        m.cImgName = '* ' + m.cImgName
      ENDIF
      
      INSERT INTO listmods ( addr, size, imgname, exefile ) ;
      VALUES ( ;
        CTOBIN( SUBSTR( m.cBuff, 21, 4 ), 'rs' ), ;
        CTOBIN( SUBSTR( m.cBuff, 25, 4 ), 'rs' ), ;
        m.cImgName, ;
        This.TransFileName( This.AsciiZString( SUBSTR( m.cBuff, 289, 260 ))))
      
      m.cBuff = BINTOC( 4+m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize )
      IF ( 0 == Module32Next( m.hSS, @ m.cBuff )) ;
        OR ( ERROR_NO_MORE_FILES == GetLastError())
        EXIT
      ENDIF
    ENDDO
    CloseHandle( m.hSS )
  ENDPROC

  PROCEDURE GetThreads
    LPARAMETERS tiPid

    #define TH32CS_SNAPTHREAD       0x00000004
    #define ERROR_NO_MORE_FILES     18

    LOCAL hSS, iSize, cBuff, Pid, Tid

    m.hSS = CreateToolhelp32Snapshot( TH32CS_SNAPTHREAD, 0 )
    IF ( -1 == m.hSS )
      This.ErrMsgBox( '创建线程快照失败！' )
      RETURN .F.
    ENDIF

    m.iSize = 6*4
    m.cBuff = BINTOC( 4+m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize )
    IF ( 0 == Thread32First( m.hSS, @ m.cBuff ))
      CloseHandle( m.hSS )
      This.ErrMsgBox( '获取线程信息失败！' )
      RETURN .F.
    ENDIF

    IF USED( 'listtrds' )
      ZAP IN listtrds
    ELSE
      CREATE CURSOR listtrds ( tid I, priority C(15) )
    ENDIF

    DO WHILE .T.
      m.Pid = CTOBIN( SUBSTR( m.cBuff, 13, 4 ), 'rs' )
      IF ( m.Pid == m.tiPid )
        m.Tid = CTOBIN( SUBSTR( m.cBuff, 9, 4 ), 'rs' )
        INSERT INTO listtrds ( tid, priority ) ;
          VALUES ( m.Tid, This.GetThreadPri( m.Tid ))
      ENDIF
      
      m.cBuff = BINTOC( 4+m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize )
      IF ( 0 == Thread32Next( m.hSS, @ m.cBuff )) ;
        OR ( ERROR_NO_MORE_FILES == GetLastError())
        EXIT
      ENDIF
    ENDDO
    CloseHandle( m.hSS )
  ENDPROC

  HIDDEN PROCEDURE SetPrivileges
    #define PROCESS_QUERY_INFORMATION   0x0400
    #define TOKEN_QUERY                 0x0008
    #define TOKEN_ADJUST_PRIVILEGES     0x0020

    #define SE_PRIVILEGE_ENABLED        0x00000002
    #define SE_PRIVILEGE_REMOVED        0X00000004

    LOCAL hToken, cLuid, cState

    m.hToken = 0
    IF ( 0 == OpenProcessToken( GetCurrentProcess(), ;
      TOKEN_QUERY + TOKEN_ADJUST_PRIVILEGES, @ m.hToken ))
      This.ErrMsgBox( '获取进程令牌时发生错误！' )
    ELSE
      m.cLuid = SPACE(8)
      IF ( 0 == LookupPrivilegeValue( NULL, 'SeDebugPrivilege', @ m.cLuid ))
        This.ErrMsgBox( '获取进程权限提升标识时发生错误！' )
      ELSE
        m.cState = BINTOC( 1, 'rs' ) + m.cLuid + BINTOC( SE_PRIVILEGE_ENABLED, 'rs' )
        IF ( 0 == AdjustTokenPrivileges( ;
          m.hToken, 0, @ m.cState, 0, NULL, 0 ))
          This.ErrMsgBox( '提升进程权限时发生错误！' )
        ENDIF
      ENDIF
      CloseHandle( m.hToken )
    ENDIF
  ENDPROC

  HIDDEN PROCEDURE GetThreadPri
    LPARAMETERS tid

    #define THREAD_ALL_ACCESS      0x001F03FFF

    LOCAL hId, iPri, cPri

    m.hId = OpenThread( THREAD_ALL_ACCESS, 0, m.tid )
    IF ( 0 == m.hId )
      This.ErrMsgBox( '获取线程优先级失败！' )
      RETURN '未知'
    ELSE
      m.iPri = GetThreadPriority( m.hId )
      DO CASE
      CASE ( 0 == m.iPri )
        m.cPri = '正常'
      CASE ( 15 == m.iPri )
        m.cPri = '实时'
      CASE ( -15 == m.iPri )
        m.cPri = '空闲'
      CASE ( m.iPri < 0 )
        m.cPri = '低于正常'
      OTHERWISE
        m.cPri = '高于正常'
      ENDCASE
      CloseHandle( m.hId )
      RETURN '(' + TRANSFORM(m.iPri) + ')' + m.cPri
    ENDIF
  ENDPROC

  HIDDEN PROCEDURE ErrMsgBox
    LPARAMETERS tcTitle

    Messagebox( m.tcTitle + 0h0d0a0d0a ;
    + '错误信息: ' + This.Win32Message( GetLastError ()), ;
    16, '错误' )
  ENDPROC

  HIDDEN PROCEDURE TransFilename
    LPARAMETERS tcFileName

    LOCAL cDummy, cTrueName

    IF ( LEN( m.tcFileName ) > 2 ) AND !( ':' == SUBSTR( m.tcFileName, 2, 1 ))
      m.tcFileName = LTRIM( m.tcFileName, '/??/' )
      IF ( '/' == LEFT( m.tcFileName, 1 ))
        m.cDummy = STREXTRACT( m.tcFileName, '/', '/', 1, 6 )
        m.cTrueName = ADDBS( GETENV( ALLTRIM( m.cDummy, '/' )))
        IF !EMPTY( m.cTrueName )
          m.tcFileName = STRTRAN( m.tcFileName, m.cDummy, m.cTrueName )
        ENDIF
      ENDIF
    ENDIF

    RETURN m.tcFileName
  ENDPROC
ENDDEFINE