如何在运行指定程序时（VB编写），禁止其他程序打开

这个可能性不太大，因为VB对底层的 *** 作比较差，不过你可以这样，用钩子拦截系统的信息流，判断，当系统的焦点要离开测验程序时（不要相信VB自己的那个窗体事件，在失去焦点这个事件上，VB根本判断不出来），测验程序记录入成绩并退出，再加上说明，这样就会让人无法离开测验程序后再回来了。当然，记录的成绩要保管好，最好用不同的加密算法加密后存到文件和注册表中各一份，每次启动测验程序后都要读出以前的两份成绩并对比，以保证没有被修改。

这样虽然严格了点，但应该可以对付一般的情况了，不过很可能对付不了那些游戏修改工具软件，还有VB生成的程序也有可能被破解，所以只能对付一般情况。

关键就是“某些键盘按钮失灵，点击以后让它没反应”这一点上，要想实现这一点，你就必须去拦截Windows的信息流，不让他得到“按键被按下”这个事件，而VB里的事件处理只是针对VB生成的程序本身的，你在VB里再怎么设置，顶多只是让VB生成的程序不对“按键被按下”这个事件有什么反应，Windows还是会得到这个事件，实际上Windows会在VB生成的程序前得到这个事件，所以，还是得用钩子，至于你说用钩子会变慢，那是一定的，就看慢多少了。

修改注册表

HKEY_CLASSES_ROOT\exefile\shell\open\command

修改它的默认值

记得处理传递过来的命令行

想要深度hook，只能用驱动技术实现了

或者用ring3 hook 也行

'窗体1

Option Explicit

Private Const vbGray = &H848284     '灰色

Private Const MLeft As Long = 180   '雷区距离左侧(按Twips计算)

Private Const MTop As Long = 825    '雷区距离上部

Private Const WAVE_DEFAULT = 432    '默认声音

Private Const WAVE_VICTORY = 433    '失败声音

Private Const WAVE_LOST = 434       '胜利声音

Private Const BMP_GRID_WIDTH = 16   '格子的宽

Private Const BMP_GRID_HEIGHT = 16  '格子的高

Private Const BMP_NUM_WIDTH = 13    '数字的宽

Private Const BMP_NUM_HEIGHT = 23   '数字的高

Private Const BMP_NUM_TOP = 16      '数字距离上边（菜单底）

Private Const BMP_NUM_MINE_LEFT = 17    '计数器距离左侧

Private Const BMP_NUM_TIME_RIGHT = BMP_NUM_WIDTH * 3 + 20   '计时器左侧距离窗体右侧

Private Const BMP_FACE_WIDTH = 24   '表情的宽

Private Const BMP_FACE_HEIGHT = 24  '表情的高

Private Const BMP_FACE_TOP = 16     '表情距离上边（菜单底）

Private CanPeeper As Boolean        '作弊啊

'初级9/9/10

'中级16/16/40

'高级30/16/99

'Private NoMine As Boolean

Private Sub InithDC()

    Dim I As Long

    Dim hBmp As StdPicture

    '从资源读取游戏图片

    For I = 0 To 2

        '不用PictureBox

        Set hBmp = LoadResPicture(IIf(MnuCheck(1).Checked, 410, 411) + I * 10, vbResBitmap)

        Let hBmpDC(I) = CreateCompatibleDC(Me.hdc)

        Call SelectObject(hBmpDC(I), hBmp.Handle)

        Set hBmp = Nothing

    Next

End Sub

'开始

Public Sub GameStart()

'    NoMine = False

    Let Me.Width = MLeft + (MWidth * 16 + 8 + GetMePixelWidth - Me.ScaleWidth) * Screen.TwipsPerPixelX '调整窗体宽度

    Let Me.Height = MTop + (MHeight * 16 + 8 + GetMePixelHeight - Me.ScaleHeight) * Screen.TwipsPerPixelY '调整窗体高度    270 OR 390'19/26'495/510

    Let IsFirstHit = False '没有埋雷'没有处理第一个雷

    Let IsGameWin = False '没有赢

    Let IsGameOver = False '没有输

    Let Timer1.Enabled = False '定时器，需要鼠标激活

    Let Time_Count = 0 '记时器清零

    Let NowFace = 4 '    Call CheckFace(4)

    ReDim N(MWidth - 1, MHeight - 1)

    Let Show_Count = MWidth * MHeight '倒计数字，剩余未揭开的格子

    Let Mine_Count = Mines '剩余未标记的地雷

    Call Form_Paint

    Call SetMines

End Sub

'Download by http://www.codefans.net

Private Sub SetMines() 'Optional ByVal X As Long, Optional ByVal Y As Long

    '初始化地雷

    Dim I As Long ', J As Long

    Dim A As Long, B As Long

    Dim K As Long, L As Long

    Call Math.Randomize '初始化随机数生成器。

    For I = 0 To Mines - 1

        Let A = Int(MWidth * Rnd) 'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

        Let B = Int(MHeight * Rnd)

        If Not N(A, B).IsMine Then  '不能重复，不能是按下的位置'Not (A = X And b = Y) And

'            If I = 1 Then

'                If NoMine = False Then

'                    Let A = X: b = Y  '第一个按下去总是雷 - -#

'                End If

'            End If

            Let N(A, B).IsMine = True

            '统计每个格子周围的地雷数目

            Addtion A, B, 1

        Else

            Let I = I - 1 '再来

        End If

    Next I

'    NoMine = False

    '显示每个格子 '作弊1

'    Dim J As Long

    '作弊2

'    For I = 0 To 8

'        For J = 0 To 8

'            If N(I, J).IsMine Then

'                N(I, J).State = 1

''                SetImage I, J, 15 - N(I, J).Number

'                'N(I, J).IsShow = True

'            End If

'        Next

'    Next

End Sub

Private Sub Addtion(ByVal X As Long, ByVal Y As Long, ByVal One As Long)

    Dim I As Long, J As Long

    For I = -1 To 1

        For J = -1 To 1

            If InRange(X + I, Y + J) And Not (I = 0 And J = 0) Then '在地图的范围内

                Let N(X + I, Y + J).Number = N(X + I, Y + J).Number + One

            End If

        Next

    Next

End Sub

'雷区

Private Sub SetImage(ByVal X As Long, ByVal Y As Long, Optional ByVal ImgID As Long)

'每个图片宽16，高16，ImgID=0~15

    Call BitBlt(Me.hdc, MLeft / Screen.TwipsPerPixelX + X * BMP_GRID_WIDTH, MTop / Screen.TwipsPerPixelY + Y * BMP_GRID_HEIGHT, BMP_GRID_WIDTH, BMP_GRID_HEIGHT, hBmpDC(0), 0, ImgID * BMP_GRID_HEIGHT, vbSrcCopy)

End Sub

'剩余地雷和时间

Private Sub SetNumber(ByVal X As Long, ByVal Y As Long, ByVal NumID As Long, Optional ByVal nWhat As Boolean = True)

    '每个数字宽13，高23，NumID=0~11

    Call BitBlt(Me.hdc, X * BMP_NUM_WIDTH + IIf(nWhat, BMP_NUM_MINE_LEFT, GetMePixelWidth - BMP_NUM_TIME_RIGHT), Y * BMP_NUM_HEIGHT + BMP_NUM_TOP, BMP_NUM_WIDTH, BMP_NUM_HEIGHT, hBmpDC(1), 0, BMP_NUM_HEIGHT * NumID, vbSrcCopy)

End Sub

'表情

Private Sub SetFace(Optional ByVal FaceID As Long = 4)

'每个笑脸宽24，高24，NumID=0~4

    Call BitBlt(Me.hdc, GetMePixelWidth / 2 - BMP_FACE_WIDTH / 2 - 1, BMP_FACE_TOP, BMP_FACE_WIDTH, BMP_FACE_HEIGHT, hBmpDC(2), 0, BMP_FACE_HEIGHT * FaceID, vbSrcCopy)

End Sub

这些只是主窗体部分代码，还有几个模块和窗体、相关文档，写不下你自己看附件

---