Attribute VB_Name = "Module1"
Public fMainForm As frmMain


'記錄使用的用戶
Public sUserName As String

'標志是添加記錄
Public Const ADD = 1
'標志是修改記錄
Public Const EDIT = 2
'標志是顯示記錄
Public Const VIEW = 3
'表示查詢
Public Const PRINTMODE = 2
'表示可寫
Public Const WRITEMODE = 1
'表示可讀
Public Const READMODE = 0
'標志RW權限錯誤
Public Const ERRORMODE = 3


Public gintPmode As Integer 'for Permission
Public gintUmode As Integer
    
Sub Main()
    Dim fLogin As New frmLogin
    fLogin.Show vbModal
    If Not fLogin.OK Then
        'Login Failed so exit app
        End
    End If
    Unload fLogin


    Set fMainForm = New frmMain
    fMainForm.Show
End Sub

Public Function ConnectString() _
   As String
'returns a DB ConnectString
   ConnectString = "FileDSN=NEWDATA.dsn;database=usermanage;UID=sa;PWD=sa"
End Function
Public Function ExecuteSQL(ByVal SQL _
   As String, MsgString As String) _
   As adodb.Recordset
'executes SQL and returns Recordset
   Dim cnn As adodb.Connection
   Dim rst As adodb.Recordset
   Dim sTokens() As String
   
   On Error GoTo ExecuteSQL_Error
   
   sTokens = Split(SQL)
   Set cnn = New adodb.Connection
   cnn.Open ConnectString
   If InStr("INSERT,DELETE,UPDATE,EXECUTE", _
      UCase$(sTokens(0))) Then
      cnn.Execute (SQL)
      MsgString = sTokens(0) & _
         " query successful"
   Else
      Set rst = New adodb.Recordset
      rst.Open Trim$(SQL), cnn, _
         adOpenKeyset, _
         adLockOptimistic
      'rst.MoveLast     'get RecordCount
      Set ExecuteSQL = rst
      MsgString = "查詢到" & rst.RecordCount & _
         " 條記錄 "
   End If
ExecuteSQL_Exit:
   Set rst = Nothing
   Set cnn = Nothing
   Exit Function
   
   
ExecuteSQL_Error:
   MsgString = "查詢錯誤: " & _
      Err.Description
   Resume ExecuteSQL_Exit
End Function
Public Sub EnterToTab(Keyasc As Integer)
    If Keyasc = 13 Then
        SendKeys "{TAB}"
    End If
End Sub
Public Function GetRkno() As String
    GetRkno = Format(Now, "yymmddhhmmss")
    Randomize
    GetRkno = GetRkno & Int((99 - 10 + 1) * Rnd + 10)
End Function
'當子窗體退出時設置MDI環境
Public Sub SetMdiEnv()
    With fMainForm
        '.tbToolBar.Buttons.Item("Find").Enabled = False
        .tbToolBar.Buttons.Item("Add").Enabled = False
        .tbToolBar.Buttons.Item("Edit").Enabled = False
        .tbToolBar.Buttons.Item("Delete").Enabled = False
        .tbToolBar.Buttons.Item("Refresh").Enabled = False
        .tbToolBar.Buttons.Item("Get").Enabled = False
        .tbToolBar.Buttons.Item("Offer").Enabled = False
        
        .tbToolBar.Buttons.Item("Print").Enabled = False
        .tbToolBar.Buttons.Item("Preview").Enabled = False
        .mnuWork.Visible = False
        
        .mnuPreview.Enabled = False
        .mnuPrint.Enabled = False
        
    End With
End Sub
Public Sub SetWorkRW(intRW As Integer)
    If intRW = READMODE Then
        With fMainForm
            .mnuWorkAdd.Visible = False
            .mnuWorkDelete.Visible = False
            .mnuWorkEdit.Visible = False
            .tbToolBar.Buttons.Item("Add").Enabled = False
            .tbToolBar.Buttons.Item("Delete").Enabled = False
            .tbToolBar.Buttons.Item("Edit").Enabled = False
            .mnuWork.Visible = True
            '.mnuSysClose.Enabled = True
          
            .tbToolBar.Buttons.Item("Refresh").Enabled = True
            
            '.tbToolBar.Buttons.Item("Print").Enabled = True
            '.tbToolBar.Buttons.Item("Preview").Enabled = True
            '.mnuPreview.Enabled = True
            '.mnuPrint.Enabled = True
            
        
        End With
    ElseIf intRW = WRITEMODE Then
        With fMainForm
            .mnuWorkAdd.Visible = True
            .mnuWorkDelete.Visible = True
            .mnuWorkEdit.Visible = True
            .tbToolBar.Buttons.Item("Add").Enabled = True
            .tbToolBar.Buttons.Item("Delete").Enabled = True
            .tbToolBar.Buttons.Item("Edit").Enabled = True
            .mnuWork.Visible = True
            '.mnuSysClose.Enabled = True
            '.tbToolBar.Buttons.Item("Find").Enabled = True
           
            .tbToolBar.Buttons.Item("Refresh").Enabled = True
            
            '.tbToolBar.Buttons.Item("Print").Enabled = True
            '.tbToolBar.Buttons.Item("Preview").Enabled = True
            '.mnuPreview.Enabled = True
            '.mnuPrint.Enabled = True
            
        End With
        
        With fMainForm
            .mnuWorkGet.Visible = False
            .mnuWorkOffer.Visible = False
            .tbToolBar.Buttons.Item("Get").Enabled = False
            .tbToolBar.Buttons.Item("Offer").Enabled = False
        End With
    ElseIf intRW = PRINTMODE Then
        With fMainForm
            .tbToolBar.Buttons.Item("Print").Enabled = True
            .tbToolBar.Buttons.Item("Preview").Enabled = True
            .mnuPreview.Enabled = True
            .mnuPrint.Enabled = True
        End With
    
    End If
End Sub

'------------------------------------------------------------
'這個子過程用它的 Err 碼顯示錯誤信息

'------------------------------------------------------------
Sub ShowError()
  Dim sTmp As String

  Screen.MousePointer = vbDefault
  
  sTmp = "發生了下面的錯誤：" & vbCrLf & vbCrLf
  
  Select Case Err.Number
    Case 7, 31001
        sTmp = sTmp & "內存溢出，需要更多的內存空間！"
    Case 28
        sTmp = sTmp & "堆棧空間溢出！"
    Case 61, 3026
        sTmp = sTmp & "磁盤已滿，系統不能創建臨時文件！"
    Case 76
        sTmp = sTmp & "系統需要的臨時文件路徑被破壞，" & vbCrLf & "請重新安裝本系統！"
    Case 298
        sTmp = sTmp & "不能加載系統 DLL！"
    Case 2446
        sTmp = sTmp & "應用程序沒有足夠的內存來完成計算！"
    Case 3006
        sTmp = sTmp & "數據庫被其它用戶以獨占方式使用，" & vbCrLf & "請等待該用戶退出！"
    Case 3027
        sTmp = sTmp & "不能更新數據，" & vbCrLf & "數據庫服務器錯誤！"
    Case 3036
        sTmp = sTmp & "數據庫服務器的存儲空間已達到最大容量，" & vbCrLf & "請系統管理員調整數據庫空間！"
    Case 3151, 3059
  
        '添加錯誤字符串
        sTmp = sTmp & "不能連接至指定的 ODBC 數據庫，" & vbCrLf & "請確認網絡是否連接正常！"
    Case 3218
        sTmp = sTmp & "所修改的數據正被其它用戶使用，" & vbCrLf & "不能被修改！"
    Case 3239
        sTmp = sTmp & "太多用戶同時使用數據系統，" & vbCrLf & "請等待一個或一個以上的用戶退出使用此系統，然后重試一次。"
    Case Else
        sTmp = "系統錯誤：" & vbCrLf & vbCrLf
        '添加錯誤字符串
        sTmp = sTmp & Err.Description & vbCrLf
        sTmp = sTmp & Err.Number
  End Select
  
  Beep
  '顯示錯誤
  MsgBox sTmp, vbOKOnly + vbCritical, "錯誤"

End Sub