module1.bas

计算机CAD图纸管理和预览

Attribute VB_Name = "ModuleMain"
Option Explicit
Public UserType As Boolean '如果是true那么是超级用户
Public cn As New ADODB.Connection '公共连接对象
Public searchSQL As String
Public IsAdmin As Boolean '判断是否为系统管理员登陆
Public loginuser As String '登录的用户名
Public cat As New ADOX.Catalog

Public tableoption As Integer    'OLD 表格的选择型式
Public savetablename As String   '导入EXCEL存储机型名称

Public rctOperatorList As New ADODB.Recordset '定义一个记录集,表示登录的用户名表
Public modelrs As New ADODB.Recordset   '定义一个记录集,表示机型登记表
Public rsselect As New ADODB.Recordset  '定义一个记录集,表示机种构成表
Public partrs As New ADODB.Recordset  '定义一个记录集,表示部品表
'Public dwgrs As New ADODB.Recordset   '定义一个记录集，表示图纸表
Public friendrs As New ADODB.Recordset   '定义一个记录集，表示供应商表

Public strEmpFirstFieldValue As String  '定义一个记录集中当前指向的记录的第一个字段的值
Public strEmpsecondFieldValue As String  '定义一个记录集中当前指向的记录的第二个字段的值

Public strpartFirstFieldValue As String  '定义一个记录集中当前指向的记录的第一个字段的值
Public strpartsecondFieldValue As String  '定义一个记录集中当前指向的记录的第二个字段的值

Public xlsfile As String
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Function MakeConnection() As String
    On Error GoTo connecterr
    With cn
        '.CursorLocation = adUseClient
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                           "Persist Security Info=False;" & _
                           "Data Source=" & App.path & "\DataBase" & "\技术项目管理.mdb"
 
       .open
    
    End With
    MakeConnection = "OK"
    cat.ActiveConnection = cn.ConnectionString
    Exit Function
connecterr:
    Dim i As Integer
    Dim sError As String
    If cn.Errors.Count > 0 Then
        For i = 0 To cn.Errors.Count - 1
            sError = sError & cn.Errors(i).Number & ":" & cn.Errors(i).Description & vbCrLf
        Next i
    End If
    MakeConnection = sError
    Exit Function
End Function

Public Sub MakeCenter(frm As Form) '使窗口显示在屏幕中央
    Dim intx2 As Integer, inty2 As Integer
    intx2 = (Screen.Width - frm.Width) / 2
    inty2 = (Screen.Height - frm.Height) / 2
    frm.Left = intx2
    frm.Top = inty2
End Sub

Public Function CheckPath(path As String) As String '检测数据库路径是否以"\"结束
    If Right$(path, 1) = "\" Then
        CheckPath = path
    Else
        CheckPath = path & "\"
    End If
End Function

Private Function SavetoRecords(ByVal rctSave As ADODB.Recordset, ByVal firstField_value As String, ByVal secondField_value As String, ByVal thirdField_value As String) As Boolean
    On Error GoTo Save_Error
        rctSave.Fields(0).Value = firstField_value
        rctSave.Fields(1).Value = secondField_value
        rctSave.Fields(2).Value = thirdField_value
        rctSave.Update
        SavetoRecords = True
        Exit Function
Save_Error:
        If Err.Number <> 0 Then
            rctSave.CancelUpdate
            SavetoRecords = False
            MsgBox "错误代码:" & Err.Number & vbCrLf & _
                    "错误描述:" & Err.Description, vbCritical + vbOKOnly, "保存记录失败"
        Else
            SavetoRecords = True
        End If
            
End Function


Public Function RecordDelete(ByVal rstDelete As ADODB.Recordset, ByVal strOption As Long) As Boolean
    If (rstDelete.EOF = True) Or (rstDelete.BOF = True) Then
        RecordDelete = False
        Exit Function
    End If
    On Error GoTo Delete_error
        rstDelete.delete strOption
        rstDelete.Update
        RecordDelete = True
        rstDelete.Update
Delete_error:
        If Err.Number <> 0 Then
        rstDelete.CancelUpdate
        RecordDelete = False
        MsgBox "错误代码:" & Err.Number & vbCrLf & _
                "错误描述:" & Err.Description, vbCritical + vbOKOnly, "删除错误"
        Else
          RecordDelete = True
          rstDelete.Update
        End If
    
End Function
'*********************************************************
'* 名称：TableExists
'* 功能：判断表是否存在(表名)
'* 用法：TableExists(表名) adoCN是一个access的连接
'*********************************************************
Public Function TableExists(findTable As String, adocn As ADODB.Connection) As Boolean
    Dim rstSchema As New ADODB.Recordset
    Set rstSchema = adocn.OpenSchema(adSchemaTables)
    rstSchema.find "TABLE_NAME='" & findTable & "'"
    If rstSchema.EOF Then
      TableExists = False
    Else
      TableExists = True
    End If
    rstSchema.Close
End Function



'程序入口
Sub Main()
    UserType = False
    IsAdmin = False
    Load frmSplash
    frmSplash.Show
    'Load DlgLogin '载入flash框
    'DlgLogin.Show
End Sub