frmselcdpath.frm

一个把自己的东西刻成光盘后自动查询和启动的原代码

VERSION 5.00
Begin VB.Form FrmSelCDPath 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "查询路径"
   ClientHeight    =   3180
   ClientLeft      =   3675
   ClientTop       =   3330
   ClientWidth     =   4965
   Icon            =   "FrmSelCDPath.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "FrmSelCDPath.frx":0442
   ScaleHeight     =   3180
   ScaleWidth      =   4965
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.DirListBox Dir1 
      Height          =   2340
      Left            =   120
      TabIndex        =   3
      Top             =   600
      Width           =   2775
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   2775
   End
   Begin VB.CommandButton CancelButton 
      BackColor       =   &H00C0FFC0&
      Caption         =   "返回(&R)"
      Height          =   375
      Left            =   3360
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   720
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      BackColor       =   &H00C0FFC0&
      Caption         =   "确定(&C)"
      Height          =   375
      Left            =   3360
      MaskColor       =   &H00FFFFFF&
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "FrmSelCDPath"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CancelButton_Click()
gIsPath = False
Unload Me
End Sub

Private Sub Drive1_Change()
On Error GoTo MyErr
Dir1.Path = Drive1.Drive
Exit Sub
MyErr:
 MsgBox Err.Description, vbExclamation, XTTS
 
End Sub

Private Sub OKButton_Click()
On Error GoTo errhandler
Dim strBasePath As String
gIsPath = False
strBasePath = Dir1.Path
If Mid(strBasePath, Len(strBasePath), 1) = "\" Then
    strBasePath = Left(strBasePath, Len(strBasePath) - 1)
End If

If Dir(strBasePath + "\data\diskdb.mdb") = "" Then
   MsgBox "当前的光盘不是系统可用光盘，请检查", vbOKOnly, "操作提示"
   
Else
   gIsPath = True
   gCDPath = strBasePath
   Unload Me
End If

Exit Sub
errhandler:
    MsgBox Err.Description, vbExclamation, XTTS
    gIsPath = False
End Sub