start.bas

用vb做的别人做的

Attribute VB_Name = "Start"
Public UserName As String
Public Permission As String
Public Permission2 As String
Public Con As ADODB.Connection

'管理员密码（本程序版权保护）
Private Declare Function GetVolumeInformation Lib "kernel32" _
    Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
    lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long
Const FILE_VOLUME_IS_COMPRESSED = &H8000
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long



Public Sub GetVolInfo(ByVal path As String)
    Dim VolSeri As Long, compress As Long
    aa = GetVolumeInformation(path, VolName, 256, VolSeri, Maxlen, _
        Sysflag, fsysName, 256)
        Permission = Hex(VolSeri)
        Permission2 = Hex(VolSeri)
End Sub


'过程(函数)
Sub Main()
If Dir(App.path & "\dbase\SdMis.mdb") = "" Then
    MsgBox "程序初始化数据库错误！", 16, "严重错误"
    Exit Sub
ElseIf App.PrevInstance = True Then
    MsgBox "已有当前程序在运行！", 16, "严重错误"
   Exit Sub
Else
    '应用初始化
    AppInitialize
    
    '登录
    Call GetVolInfo("c:\")
    
    Login
    
    '显示主窗口
    FrmMain.Show
   
End If

End Sub

'初始化
Private Sub AppInitialize()
    App.Title = "教务管理系统 V1.0.0 (单机版)"
End Sub


'登录
Sub Login()
    '数据库连接通道
    Set Con = New ADODB.Connection
    Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.path & "\DBase\SdMis.mdb;Mode=ReadWrite;Persist Security Info=True"
    Con.Open
    
    '显示splash窗口
    Splash.Show
       
    '显示登录窗口
    dlgLogin.Show vbModal, Splash
    
  If UserName = "" Then   'if user cancel login then the app end
        ReleaseResource
        End
  Else                'login successfully, then record user info
    '销毁登录窗口
    Unload dlgLogin
    Set dlgLogin = Nothing
    
    '销毁splash窗口
    Unload Splash
    Set Splash = Nothing

End If
    
End Sub

'释放资源(除了发起窗体)
Sub ReleaseResource(Optional Sender As Object)
    
'卸载所有窗体
Dim i As Long
On Error Resume Next

For i = Forms.Count - 1 To 0 Step -1
   Unload Forms(i)
 If Not Force Then
    If Forms.Count > i Then
       Exit Sub
    End If
 End If
Next i

If Force Or (Forms.Count = 0) Then Close
If Force Or (Forms.Count > 0) Then End
Con.Close

End Sub