formopen.frm

教你如何实现键盘开机

VERSION 5.00
Begin VB.Form FormOpen 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "运行程序"
   ClientHeight    =   2265
   ClientLeft      =   45
   ClientTop       =   270
   ClientWidth     =   6000
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2265
   ScaleWidth      =   6000
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "属性"
      Height          =   495
      Left            =   4560
      TabIndex        =   7
      Top             =   1680
      Width           =   1215
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   840
      TabIndex        =   5
      Top             =   720
      Width           =   1695
   End
   Begin VB.CommandButton Command2 
      Caption         =   "浏览"
      Height          =   375
      Left            =   4920
      TabIndex        =   4
      Top             =   720
      Width           =   855
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   1200
      Width           =   5775
   End
   Begin VB.CommandButton Command1 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   495
      Index           =   1
      Left            =   2400
      TabIndex        =   2
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   495
      Index           =   0
      Left            =   240
      TabIndex        =   1
      Top             =   1680
      Width           =   1215
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "参数："
      Height          =   240
      Left            =   120
      TabIndex        =   6
      Top             =   840
      Width           =   720
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "请在下面的长文本框中输入要启动的程序或要浏览的文件夹，若你启动程序时需加参数，请在短文本框中输入参数"
      Height          =   600
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   6000
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "FormOpen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Foldername$
Private Sub Command1_Click(Index As Integer)
On Error Resume Next
If Index Then
    Hide
Else
    Dim TmpPara$, TmpErr&
    Foldername = Trim(Text1)
    TmpPara = Trim(Text2)
    If Foldername = "kzmb" Then
        TmpPara = CpCs(Trim(Text2))
        If TmpPara = "Error Canshu" Then
            TmpPara = vbNullString
            Foldername = "control.exe"
        Else
            Foldername = "Rundll32.exe"
        End If
    ElseIf WenJianPan Then
        TmpPara = vbNullString
    End If
        Hide
        TmpErr = ShellExecute(MainHwnd, "open", Foldername, TmpPara, vbNullString, SW_NORMAL)
    If TmpErr <= 31 Then
        ErrorMsg TmpErr, Foldername
    End If
End If
End Sub

Private Sub Command2_Click()
'FormLiu.Show 1
Dim sHbrows As BROWSEINFO, RetureVal As String * 256, Rt As String * 256
With sHbrows
    .hwnd = hwnd
    .pszDisplayName = RetureVal
    .lpszTitle = "浏览文件夹"
    .ulFlags = &H40 Or &H4000
End With
        If SHGetPathFromIDList(SHBrowseForFolder(sHbrows), Rt) Then Text1 = Trim(Rt)
End Sub
Private Function WenJianPan() As Long
Dim Tm&
On Error GoTo Errhh
    Foldername = Trim(LCase(Foldername))
    If Foldername = "ks" Then
        Foldername = Windir & "\Start Menu": Tm = 1
    ElseIf Foldername = "cx" Then
        Foldername = Windir & "\Start Menu\Programs": Tm = 1
    ElseIf Foldername = "." Then
        Foldername = "C:\": Tm = 1
    ElseIf Foldername = ".." Then
        Foldername = Windir: Tm = 1
    ElseIf Foldername = "zm" Then
        Foldername = Windir & "\Desktop": Tm = 1
    End If
WenJianPan = Tm
Exit Function
Errhh:
WenJianPan = 0
End Function

Private Function CpCs(ByVal CS As String) As String
    Select Case CS
        Case "xs"
            CpCs = "shell32.dll,Control_RunDLL desk.cpl,,0"
        Case "zt"
            CpCs = "shell32.dll,Control_RunDLL main.cpl @3"
        Case "ts"
            CpCs = "shell32.dll,Control_RunDLL appwiz.cpl,,1"
        Case "wl"
            CpCs = "shell32.dll,Control_RunDLL netcpl.cpl"
        Case "sy"
            CpCs = "shell32.dll,Control_RunDLL mmsys.cpl @1"
        Case "dmt"
            CpCs = "shell32.dll,Control_RunDLL mmsys.cpl,,0"
        Case "rqhsj"
            CpCs = "shell32.dll,Control_RunDLL timedate.cpl"
        Case "tjxyj"
            CpCs = "shell32.dll,Control_RunDLL sysdm.cpl @1"
        Case "qysz"
            CpCs = "shell32.dll,Control_RunDLL intl.cpl,,0"
        Case "xt"
            CpCs = "shell32.dll,Control_RunDLL sysdm.cpl,,0"
        Case "sb"
            CpCs = "shell32.dll,Control_RunDLL main.cpl @0"
        Case "jp"
            CpCs = "shell32.dll,Control_RunDLL main.cpl @1"
        Case "tzjtq"
            CpCs = "shell32.dll,Control_RunDLL modem.cpl"
        Case "dyj"
            CpCs = "shell32.dll,Control_RunDLL main.cpl @2"
        Case Else
            CpCs = "Error Canshu"
    End Select
End Function

Private Sub Command3_Click()
ShowProperties Trim(Text1), 0
End Sub

Private Sub Form_Load()
Left = 0
Top = 500
End Sub