global.bas

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

Public Sub ComPareType(ByVal CbType As ComboBox, ByVal Class As String)
Dim i As Long
CbType.ListIndex = 0
For i = 0 To CbType.ListCount - 1
    If CbType.List(i) = Class Then
        CbType.ListIndex = i
        Exit For
    End If
Next i
End Sub

'显示编辑条码窗口
Public Function ShowEditCode(ByVal ListView As ListView, ByVal TxtTitle As TextBox, ByVal TxtArea As TextBox, ByVal TxtBarCode As TextBox) As Boolean
Dim Rs As ADODB.Recordset

If ListView.SelectedItem.Text = "" Then
    ShowEditCode = False
    Exit Function
End If

Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    
    .Source = "Select * FROM [BarCodeStore] WHERE ID=" & CLng(ChkStr(ListView.SelectedItem.Text))
    .Open
    If .EOF Then
        .Close
        ShowEditCode = False
    Else
        TxtTitle.Text = .Fields("Title").Value
        TxtArea.Text = .Fields("Area").Value
        TxtBarCode.Text = .Fields("BarCode").Value
        .Close
        ShowEditCode = True
    End If
End With
Set Rs = Nothing
End Function

'显示条码
Public Function ShowCode(ByVal ListView As ListView, ByVal Title As Label, ByVal Area As Label, ByVal BarCode As BarCodeCtrl) As Boolean
Dim Rs As ADODB.Recordset

If ListView.SelectedItem.Text = "" Then
    ShowCode = False
    Exit Function
End If

Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    
    .Source = "Select * FROM [BarCodeStore] WHERE ID=" & CLng(ChkStr(ListView.SelectedItem.Text))
    .Open
    If .EOF Then
        .Close
        ShowCode = False
    Else
        Title.Caption = "名称：" & .Fields("Title").Value
        Title.ToolTipText = Title.Caption
        Area.Caption = "产地：" & .Fields("Area").Value
        Area.ToolTipText = Area.Caption
        BarCode.Value = .Fields("BarCode").Value
        .Close
        ShowCode = True
    End If
End With
Set Rs = Nothing
End Function

'添加条码
Public Function AddCode(ByVal TreeView As TreeView, ByVal CbType As String, ByVal TxtTitle As String, ByVal TxtArea As String, ByVal TxtBarCode As String) 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 [Board] WHERE Class='" & ChkStr(CbType) & "'"
    .Open
    If Not .EOF Then
        LngClass = CLng(.Fields("ID").Value) '取得当前的ID
        .Close
    Else
        .Close '没找到类别，退出添加
        AddCode = False
        Set Rs = Nothing
        Exit Function
    End If
    
    .Source = "Select * FROM [BarCodeStore] WHERE Title='" & ChkStr(TxtTitle) & "' OR BarCode='" & ChkStr(TxtBarCode) & "'"
    .Open
    If Not .EOF Then
        .Close
        AddCode = False
    Else
        .AddNew
        .Fields("ClassID").Value = LngClass
        .Fields("Title").Value = ChkStr(TxtTitle)
        .Fields("Area").Value = ChkStr(TxtArea)
        .Fields("BarCode").Value = ChkStr(TxtBarCode)
        .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, "_"))) = LngClass Then
                    TreeView.Nodes(i).Text = .Fields("Class").Value & "[" & .Fields("Num").Value & "]"
                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 & "]"
        AddCode = True
    End If
End With
Set Rs = Nothing
End Function

'修改条码
Public Function EditCode(ByVal TreeView As TreeView, ByVal ID As Long, ByVal CbType As String, ByVal TxtTitle As String, ByVal TxtArea As String, ByVal TxtBarCode As String) As Boolean
Dim OldClassID As Long
Dim NewClassID 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 [Board] WHERE Class='" & ChkStr(CbType) & "'"
    .Open
    If Not .EOF Then
        NewClassID = CLng(.Fields("ID").Value)
    End If
    .Close
    
    .Source = "Select * FROM [BarCodeStore] WHERE ID=" & ID
    .Open
    If .EOF Then
        .Close
        EditCode = False
    Else
        OldClassID = .Fields("ClassID").Value
        .Fields("ClassID").Value = NewClassID
        .Fields("Title").Value = ChkStr(TxtTitle)
        .Fields("Area").Value = ChkStr(TxtArea)
        .Fields("BarCode").Value = ChkStr(TxtBarCode)
        .UpdateBatch
        .Close
        
        If OldClassID <> NewClassID Then
            .Source = "Update [Board] Set Num=Num-1 WHERE ID=" & OldClassID
            .Open
            
            .Source = "Update [Board] Set Num=Num+1 WHERE iD=" & NewClassID
            .Open
        
            .Source = "Select * FROM [Board] WHERE ID=" & OldClassID
            .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, "_"))) = OldClassID Then
                        TreeView.Nodes(i).Text = .Fields("Class").Value & "[" & .Fields("Num").Value & "]"
                    End If
                End If
            Next i
            .Close

            .Source = "Select * FROM [Board] WHERE ID=" & NewClassID
            .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, "_"))) = NewClassID Then
                        TreeView.Nodes(i).Text = .Fields("Class").Value & "[" & .Fields("Num").Value & "]"
                    End If
                End If
            Next i
            .Close
        End If
        
        EditCode = True
    End If
End With
Set Rs = Nothing
End Function

'加载类别到Combo
Public Sub LoadType(ByVal CbType As ComboBox)
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
With Rs
    .ActiveConnection = ConnStr
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    
        .Source = "Select * FROM [Board] ORDER BY ID"
        .Open
        If Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                CbType.AddItem .Fields("Class").Value
            .MoveNext
            Loop
        End If
        .Close
End With
Set Rs = Nothing
End Sub

 '文件是否存在
Public Function FileExists(ByVal FileName As String) As Boolean
On Error Resume Next
If Dir(FileName) = "" Then
    FileExists = False
Else
    FileExists = True
End If
End Function

'过滤SQL非法字符
Public Function ChkStr(ByVal Str As String) As String
    If Str = "" Then
        ChkStr = ""
        Exit Function
    End If
    ChkStr = Replace(Trim(Str), "'", "")
End Function

Private Function CreateDB(ByVal DbFile As String) As Boolean  '创建数据库
On Error GoTo ErrDB
Dim ADOX As Variant

    Set ADOX = CreateObject("ADOX.Catalog")
    ADOX.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & DbFile
    Set ADOX = Nothing

    
    If CreateTable = True Then
        CreateDB = True
    Else
        CreateDB = False
        Kill DbFile
    End If
Exit Function
ErrDB:
    CreateDB = False
End Function

'创建表
Private Function CreateTable() As Boolean
On Error GoTo ErrCr
Dim Str As String
Dim Rs As New ADODB.Recordset
With Rs
      .ActiveConnection = ConnStr
      .CursorLocation = adUseClient
      .CursorType = adOpenStatic
      .LockType = adLockBatchOptimistic
      '"[ID] AutoIncrement ," 自动编号

      Str = "CREATE TABLE [Board] (" & _
            "[ID] Counter CONSTRAINT [ID] PRIMARY KEY," & _
            "[Class] Text(50) NOT NULL," & _
            "[Num] Long DEFAULT 0 NOT NULL)"
      .Source = Str '创建分类表
      .Open
      
      Str = "CREATE TABLE [BarCodeStore] (" & _
            "[ID] Counter CONSTRAINT [ID] PRIMARY KEY," & _
            "[ClassID] Long DEFAULT 0 NOT NULL ," & _
            "[Title] Text(50) NOT NULL ," & _
            "[BarCode] Text(13) NOT NULL ," & _
            "[Area] Memo NOT NULL ," & _
            "[DateAndTime] DateTime DEFAULT Now() NOT NULL)"
      .Source = Str '创建资料表
      .Open
      
End With
Set Rs = Nothing
CreateTable = True
Exit Function
ErrCr:
    Set Rs = Nothing
    CreateTable = False
End Function