start.bas

考试分析系统 v0.6.0

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

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 Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long


'过程(函数)
Sub Main()
If Dir(App.Path & "\dbase\SdMis.mdb") = "" Then
    MsgBox "程序初始化数据库错误！", 16, "严重错误"
    Exit Sub
ElseIf App.PrevInstance = True Then
    MsgBox "已有当前程序在运行！", 16, "严重错误"
   Exit Sub
ElseIf Dir(App.Path & "\考试分析系统.ini") = "" Then
    Dim sF As String
    sF = App.Path & "\考试分析系统.ini"
    Open sF For Output As #1
    Print #1, "[注册信息]"
    Close #1
End If

    '应用初始化
    AppInitialize
    
    '登录
    Login
    
    '显示主窗口
    
  MDIForm1.Show
  assist.Show
  ShowAtStartup = GetSetting(App.EXEName, "Options", "在启动时显示提示", 1)
    If ShowAtStartup = 1 Then frmTip.Show
End Sub

'初始化
Private Sub AppInitialize()
    '显示splash窗口
    Splash.Show
    App.Title = "考试分析系统 V1.0.0"
    If Len(GetFromINI("注册信息", "学校名称", App.Path + "\考试分析系统.ini")) = 0 Then
    FrmSchool.Show vbModal, Splash
    ReleaseResource
    End
    Else
    App.Title = "考试分析系统 V1.0.0 " & Left(GetFromINI("注册信息", "学校名称", App.Path + "\考试分析系统.ini"), 15)
    Splash.Company.Caption = Left(GetFromINI("注册信息", "学校名称", App.Path + "\考试分析系统.ini"), 15)
    End If
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;Jet OLEDB:Database Password=13912265004Pass"
    Con.Open
    
       
    '显示登录窗口
    Dlglogin.Show vbModal, Splash
    
  If Permission = "" Then
        ReleaseResource
        End
  Else
    '销毁登录窗口
    Unload Dlglogin
    Set Dlglogin = Nothing
    
    '销毁splash窗口
    Unload Splash
    Set Splash = Nothing

End If
    
End Sub
'获取基础信息
Public Function GetFromINI(AppName As String, KeyName As String, FileName As String) As String
   Dim RetStr As String
   RetStr = String(255, Chr(0))
   GetFromINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), FileName))
End Function

'释放资源(除了发起窗体)
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