global.bas

收藏了太量的商品条形码库

Attribute VB_Name = "Global"
Option Explicit

Private ConnStr As String '数据库连接字符串
Private Const DbFile As String = "BarCode.Mdb"

Sub main()
If App.PrevInstance Then End '不能重复运行.

ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & DbFile & ";Persist Security Info=False;"

If FileExists(App.Path & "\" & DbFile) = False Then
    If CreateDB(DbFile) = False Then
        MsgBox "连接数据库失败！", 16, "错误"
        End
    Else
        Call Login
    End If
Else
    Call Login
End If
End Sub

Private Sub Login() '登陆
With FrmMain
    Call GetClassInfo(.TV1, .Caption)
    .TV1.Nodes.Item(1).Text = .Caption & "[" & GetList(.Lv1, "0") & "]"
    .Show
End With
End Sub

'加载目录树
Private Sub GetClassInfo(ByVal TreeView As TreeView, ByVal Title As String)
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    
    TreeView.Nodes.Clear
    TreeView.Nodes.Add , , "SkyGz_", Title, 1
    
    .Source = "Select * FROM [Board] ORDER BY ID"
    .Open
    If Not Rs.EOF Then
        .MoveFirst
        Do While Not .EOF
        TreeView.Nodes.Add "SkyGz_", 4, "Class_" & .Fields("ID").Value, .Fields("Class").Value & "[" & .Fields("Num").Value & "]", 2
        .MoveNext
        Loop
    End If
    .Close
    TreeView.Nodes.Item(1).Expanded = True
End With
Set Rs = Nothing
End Sub

'添加类别
Public Function AddClass(ByVal TreeView As TreeView, ByVal Class As String) As Boolean
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic
    
    .Source = "Select * FROM [Board] WHERE Class='" & ChkStr(Class) & "'"
    .Open
    If Not .EOF Then
        .Close
        AddClass = False
    Else
        .AddNew
        .Fields("Class") = ChkStr(Class)
        .UpdateBatch
        .Close
        
        .Source = "Select * FROM [Board] WHERE Class='" & ChkStr(Class) & "'"
        .Open
        TreeView.Nodes.Add "SkyGz_", 4, "Class_" & .Fields("ID").Value, .Fields("Class").Value & "[" & .Fields("Num").Value & "]", 2
        .Close
        
        AddClass = True
    End If
End With
Set Rs = Nothing
End Function

'修改类别
Public Function EditClass(ByVal TreeView As TreeView, ByVal OldClass As String, ByVal NewClass As String) As Boolean
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic
    
    .Source = "Select * FROM [Board] WHERE Class='" & ChkStr(OldClass) & "'"
    .Open
    If .EOF Or .BOF Then
        .Close
        EditClass = False
    Else
        TreeView.SelectedItem.Text = ChkStr(NewClass) & "[" & .Fields("Num").Value & "]"
        .Fields("Class").Value = ChkStr(NewClass)
        .UpdateBatch
        .Close
        
        EditClass = True
    End If
End With
Set Rs = Nothing
End Function
Public Function DelClass(ByVal TreeView As TreeView, ByVal Class As String) As Boolean
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic
    
    .Source = "Select * FROM [Board] WHERE Class='" & ChkStr(Class) & "'"
    .Open
    If Not .EOF Then
        Dim LngClass As Long
        LngClass = CLng(.Fields("ID").Value)
        .Delete
        .UpdateBatch
        .Close
        
        .Source = "Delete FROM [BarCodeStore] WHERE ClassID=" & LngClass
        .Open

        .Source = "Select * FROM [BarCodeStore]"
        .Open
        Dim TmpStr As String
        TmpStr = TreeView.Nodes.Item(1).Text
        TmpStr = Mid(TmpStr, 1, InStr(TmpStr, "[") - 1)
        TreeView.Nodes.Item(1).Text = TmpStr & "[" & .RecordCount & "]"
        .Close
        
        TreeView.Nodes.Remove TreeView.SelectedItem.Index
        DelClass = True
    Else
        .Close
        DelClass = False
    End If
End With
Set Rs = Nothing
End Function

'删除条码
Public Function DelCode(ByVal TreeView As TreeView, ByVal ListView As ListView, ByVal ID As Long) As Boolean
Dim LngClass As Long
Dim i As Long
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic
    
    .Source = "Select * FROM [BarCodeStore] WHERE ID=" & ID
    .Open
    
    If .EOF Then
        .Close
        DelCode = False
    Else
        LngClass = CLng(.Fields("ClassID").Value)
        .Delete
        .UpdateBatch
        .Close
    
        .Source = "Update [Board] Set Num=Num-1 WHERE ID=" & LngClass
        .Open
        
        .Source = "Select * FROM [Board] WHERE ID=" & LngClass
        .Open
        For i = 2 To TreeView.Nodes.Count
          If InStr(TreeView.Nodes(i).Key, "_") > 0 Then
            If CLng(Mid(TreeView.Nodes(i).Key, 7, Len(TreeView.Nodes(i).Key) - InStr(TreeView.Nodes(i).Key, "_"))) = CLng(.Fields("ID").Value) Then
                TreeView.Nodes(i).Text = .Fields("Class").Value & "[" & .Fields("Num").Value & "]"
                Exit For
            End If
          End If
        Next i
        .Close
        
        '更新记录总数
        Dim Str As String
        Dim TmpStr As String
        Dim TmpLng As Long
        Str = TreeView.Nodes.Item(1).Text
        TmpStr = Mid(Str, InStr(Str, "["), InStr(Str, "["))
        TmpLng = CLng(Mid(TmpStr, 2, InStr(TmpStr, "]") - 2))
        
        TreeView.Nodes.Item(1).Text = Mid(Str, 1, InStr(Str, "[") - 1) & "[" & TmpLng - 1 & "]"
        
        ListView.ListItems.Remove ListView.SelectedItem.Index
        DelCode = True
    End If
End With
Set Rs = Nothing
End Function
'取得信息到列表中
Public Function GetList(ByVal ListView As ListView, ByVal Class As String) As String
Dim List As Variant
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    
    ListView.ListItems.Clear
    If CLng(Class) = 0 Then
        .Source = "Select * FROM [BarCodeStore] ORDER BY DateAndTime DESC"
        .Open
        GetList = .RecordCount
    Else
        .Source = "Select * FROM [BarCodeStore] WHERE ClassID=" & CLng(ChkStr(Class)) & " ORDER BY DateAndTime DESC"
        .Open
    End If
    
    Do While Not .EOF
        Set List = ListView.ListItems.Add()
        List.Text = .Fields("ID").Value
        List.SubItems(1) = .Fields("BarCode").Value
        List.SubItems(2) = .Fields("Title").Value
        List.SubItems(3) = .Fields("Area").Value
        List.SubItems(4) = GetType(CLng(.Fields("ClassID").Value))
        Set List = Nothing
        .MoveNext
    Loop
End With
End Function

'搜索信息到列表中
Public Sub GetFindList(ByVal ListView As ListView, ByVal StrSql As String)
Dim List As Variant
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    
    ListView.ListItems.Clear
    .Source = StrSql
    Debug.Print .Source
    .Open
    
    Do While Not .EOF
        Set List = ListView.ListItems.Add()
        List.Text = .Fields("ID").Value
        List.SubItems(1) = .Fields("BarCode").Value
        List.SubItems(2) = .Fields("Title").Value
        List.SubItems(3) = .Fields("Area").Value
        List.SubItems(4) = GetType(CLng(.Fields("ClassID").Value))
        Set List = Nothing
        .MoveNext
    Loop
End With
End Sub

'取得类别
Public Function GetType(ByVal ClassID As Long) As String
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    
    .Source = "Select * FROM [Board] WHERE ID=" & ClassID
    .Open
    If Not .EOF Then
        GetType = .Fields("Class").Value
    End If
    .Close
End With
Set Rs = Nothing
End Function

'取得类别
Public Function GetTypeID(ByVal Class As String) As Long
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    
    .Source = "Select * FROM [Board] WHERE Class='" & Class & "'"
    .Open
    If Not .EOF Then
        GetTypeID = .Fields("ID").Value
    End If
    .Close
End With
Set Rs = Nothing
End Function

'取得当前类别，并选中当前类别