gdhedits.frm

齐鲁石化某分公司的数据采集管理系统

    Dim rowMax As Integer
    Dim colMax As Integer
    Dim adoCon As Adodb.Connection
    Dim adoRe As Adodb.Recordset
    Dim Query As String
    Dim tableName As String
    Dim DBFullPath As String
    Dim i As Integer, j As Integer
'    On Error GoTo ok
    
    If strDate_Time = "" Then
        MsgBox "时间不能为空，请确认"
        Exit Function
    End If
    
    rowMax = UserGrid1.GetGridRowNumber
    If rowMax = 0 Then
        MsgBox "无数据可保存"
        Exit Function
    End If
    
    '数据库名字，路径，表名
'    dbName = "gdhdata" + Mid(strDate_Time, 1, 4) + ".mdb"
    DBFullPath = dbPath + dbName + Mid(strDate_Time, 1, 4) + ".mdb"
    tableName = "gdh" '+ Mid(strDate_Time, 6, 2)
    
    '表头字段名
    Call UserGrid1.GetGridRowValues(tableTitle(), 0)
    
    '字段个数
    colMax = UBound(tableTitle)
    
    '连接数据库
    Set adoCon = New Adodb.Connection
    Set adoRe = New Adodb.Recordset
    adoCon.CursorLocation = adUseClient
    adoCon.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFullPath & ";Jet OLEDB:Database Password=dfrwgdh;"
    If adoCon.State = 0 Then
        MsgBox "连接超时"
        Exit Function
    End If
    
    '查询数据库
    Query = "select * from " & tableName & " where 日期时间='" & strDate_Time & "'"
'    Debug.Print Query
    adoRe.Open Query, adoCon, adOpenDynamic, adLockOptimistic
    
    '删除数据
    If Not adoRe.BOF And Not adoRe.EOF Then
        adoRe.MoveFirst
        Do While Not adoRe.EOF
            adoRe.Delete
            adoRe.MoveNext
        Loop
    End If
    
    '添加数据
    For i = 1 To rowMax
        Call UserGrid1.GetGridRowValues(LineContent(), i)
        adoRe.AddNew
        adoRe.Fields("序号") = i
        For j = 1 To colMax
            adoRe.Fields(Trim(tableTitle(j))) = Trim(LineContent(j))
        Next j
        adoRe.Fields("日期时间") = strDate_Time
'        adoRe.Fields("日期") = Mid(strDate_Time, 1, 10)
        adoRe.Fields("方向") = strDirection
        adoRe.Update
    Next i
    '关闭数据库
    adoRe.Close
    
    '修改索引
    Query = "select * from gdhindex where 日期时间='" & strDate_Time & "'"
    adoRe.Open Query, adoCon, adOpenDynamic, adLockOptimistic
    
    If Not adoRe.BOF And Not adoRe.EOF Then
    Else
        adoRe.AddNew
        adoRe.Fields("车数") = Trim(str(rowMax))
        adoRe.Fields("日期时间") = strDate_Time
        adoRe.Fields("方向") = strDirection
        adoRe.Update
    End If
    
    '关闭数据库
    adoRe.Close
    
    '删除临时表prin
    Set adoRe = adoCon.OpenSchema(adSchemaTables)
    Do Until adoRe.EOF
        If adoRe!table_Name = "prin" Then
              Query = "drop table prin"
              adoCon.Execute Query
              Exit Do
        End If
        adoRe.MoveNext
    Loop
    
    '将打印数据存储到临时区
    Query = "select 序号"
    For j = 1 To colMax
        Query = Query + "," + Trim(tableTitle(j))
    Next j
    Query = Query + " " + "into prin from " & tableName & ""
    Query = Query + " " + "where 日期时间='" & strDate_Time & "'"
    adoCon.Execute Query
    
    adoCon.Close
    
    Save_Data_to_gdhdata = True
    Exit Function
ok:
    Save_Data_to_gdhdata = False
    MsgBox Err.Number
End Function

Function Checking_Save() As Boolean
    On Error GoTo ok
    If Combo2.text <> "本厂车" And Combo2.text <> "外来车" Then
        MsgBox "请选择正确的数据源"
        Exit Function
    End If
    
    If Label2(0).Caption = "" Then
        MsgBox "无法保存数据，时间不能为空"
        Exit Function
    End If
    
    If UserGrid1.GetGridRowNumber = 0 Then
        MsgBox "无数据可保存"
        Exit Function
    End If
    
    Checking_Save = True
ok:
End Function

Function Save_Data_to_File(str_FilePath As String, strDate_Time As String, strDirection As String)
    Dim FileNo As Integer
    Dim strLine As String
    Dim Cell() As String
    Dim rowMax As Integer

    Dim i As Integer, j As Integer
    
    FileNo = FreeFile
    rowMax = UserGrid1.GetGridRowNumber
    
    Open str_FilePath For Output As #FileNo
    Print #FileNo, "GDHW"
    Print #FileNo, strDate_Time
    Print #FileNo, strDirection
    Print #FileNo, Trim(str(rowMax))
    
    For i = 0 To rowMax
        Call UserGrid1.GetGridRowValues(Cell(), i)
        strLine = ""
        For j = 0 To UBound(Cell)
            strLine = strLine + Trim(Cell(j)) + "|"
        Next j
        Print #FileNo, strLine
    Next i
    
    Close #FileNo
End Function

Function Save_Qing_Zhong_to_qingzhong(dbPath As String, strDate_Time As String, strDirection As String)
    Dim db As Adodb.Connection
    Dim rs As Adodb.Recordset
    Dim dbName As String
    Dim tableName As String
    Dim DBFullPath As String
    Dim Query As String
    Dim Cell() As String
'    Dim intCell(20) As Integer
    Dim rowMax As Integer
    Dim i As Integer, j As Integer
    
    If dbPath = "" Then Exit Function
    If dbPath = "" Then Exit Function
    
    
    rowMax = UserGrid1.GetGridRowNumber
    If rowMax < 1 Then Exit Function
    
    Set db = New Adodb.Connection
    Set rs = New Adodb.Recordset
    
    DBFullPath = dbPath + "qingzhong.mdb"
    
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFullPath & ";Jet OLEDB:Database Password=dfrwadmin;"
    
    Query = "delete from qingche where 日期时间='" & strDate_Time & "'"
    db.Execute Query
    Query = "delete from zhongche where 日期时间='" & strDate_Time & "'"
    db.Execute Query
    
    Call UserGrid1.GetGridRowValues(Cell(), 0)
    
    For i = 1 To rowMax
        Call UserGrid1.GetGridRowValues(Cell(), i)
        If UserGrid1.GetGridCellValue(i, "轻重车") = "√" Then
            Query = "delete from zhongche where 车号='" & Trim(Cell(intCell(2))) & "'"
            db.Execute Query
            
            Query = "insert into zhongche(序号,车型,车号,毛重,速度,方向,日期时间)" '(" & Int(Cell(intCell(0))) & "," & Trim(Cell(intCell(1))) & "," & Trim(Cell(intCell(2))) & "," & Trim(Cell(intCell(3))) & "," & Trim(Cell(intCell(8))) & "," & strDirection & "," & strDate_Time & ")"
            Query = Query + " Values(" & Int(Cell(intCell(0))) & ",'" & Trim(Cell(intCell(1))) & "','" & Trim(Cell(intCell(2))) & "','" & Trim(Cell(intCell(3))) & "','" & Trim(Cell(intCell(8))) & "','" & strDirection & "','" & strDate_Time & "')"
            db.Execute Query
            Query = "update zhongche set 提取标志='0' where 车号='" & Trim(Cell(intCell(2))) & "'"
            db.Execute Query
        Else
            Query = "delete from qingche where 车号='" & Trim(Cell(intCell(2))) & "'"
            db.Execute Query
            
            Query = "insert into qingche(序号,车型,车号,皮重,速度,方向,日期时间)" ' values(" & Int(Cell(intCell(0))) & "," & Trim(Cell(intCell(1))) & "," & Trim(Cell(intCell(2))) & "," & Trim(Cell(intCell(4))) & "," & Trim(Cell(intCell(8))) & "," & strDirection & "," & strDate_Time & ")"
            Query = Query + " values(" & Int(Val(Cell(intCell(0)))) & ",'" & Trim(Cell(intCell(1))) & "','" & Trim(Cell(intCell(2))) & "','" & Trim(Cell(intCell(4))) & "','" & Trim(Cell(intCell(8))) & "','" & strDirection & "','" & strDate_Time & "')"

            db.Execute Query
            Query = "update qingche set 提取标志='0' where 车号='" & Trim(Cell(intCell(2))) & "'"
            db.Execute Query
        End If
    Next i
    
    db.Close
End Function

Function FindField(strCell() As String, ByRef intC() As Integer)
    Dim j As Integer
    For j = 0 To UBound(strCell)
        Select Case Trim(strCell(j))
            Case "序号"
                intC(0) = j
            Case "车型"
                intC(1) = j
            Case "车号"
                intC(2) = j
            Case "毛重"
                intC(3) = j
            Case "皮重"
                intC(4) = j
            Case "净重"
                intC(5) = j
            Case "标重"
                intC(6) = j
            Case "超欠"
                intC(7) = j
            Case "速度"
                intC(8) = j
            Case "货名"
                intC(9) = j
            Case "发货单位"
                intC(10) = j
            Case "收货单位"
                intC(11) = j
            Case "结算单位"
                intC(12) = j
            Case "发站"
                intC(13) = j
            Case "到站"
                intC(14) = j
            Case "发货单号"
                intC(15) = j
            Case "订货单号"
                intC(16) = j
            Case "轻重车"
                intC(17) = j
            Case Else
            
        End Select
    Next j
End Function

Function get_WeightValue_From_qingzhong()   '2007-1-22 提取重量，是重车的则提皮重，轻车则提毛重
    Dim i As Integer, j As Integer
    Dim db As New Adodb.Connection
    Dim rs As New Adodb.Recordset
    Dim Query As String
    Dim Cell() As String
    Dim rowMax As Integer
    Dim cheHao As String
    Dim QZ As String
    Dim sMZ As String, sPZ As String, sJZ As String
    Dim strLine As String
    
    On Error GoTo ok
    
    List1.Clear
    
    rowMax = UserGrid1.GetGridRowNumber
    
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\qingzhong.mdb;Jet OLEDB:Database Password=dfrwadmin;"

    For i = 1 To rowMax
        QZ = UserGrid1.GetGridCellValue(i, "轻重车")
        cheHao = UserGrid1.GetGridCellValue(i, "车号")
        If QZ = "√" Then
            sMZ = UserGrid1.GetGridCellValue(i, "毛重")
            Query = "select * from qingche where 车号='" & cheHao & "' order by 日期时间 DESC"
            rs.Open Query, db, adOpenDynamic, adLockOptimistic
            If IsNull(rs.Fields("提取标志")) Or rs.Fields("提取标志") = 0 Then
            
                If Not rs.BOF And Not rs.EOF Then
                    rs.MoveFirst
                    sPZ = rs.Fields("皮重")
                    sJZ = Trim(str(Val(sMZ) - Val(sPZ)))
                    sJZ = Format(sJZ, gdh_Edit_Formats)
                    Query = "update qingche set 提取标志='1' where 车号='" & cheHao & "'"
                    db.Execute Query
                    Debug.Print rs.Fields("提取标志")
                    Call UserGrid1.EditGridCell(i, "皮重", "", sPZ)
                    Call UserGrid1.EditGridCell(i, "净重", "", sJZ)
                Else
                    strLine = "没有找到第" & i & "节车号为" + Chr(34) + cheHao + Chr(34) + "的皮重数据"
                    List1.AddItem strLine
                End If
            
            End If
            
            rs.Close
        Else
            sPZ = UserGrid1.GetGridCellValue(i, "皮重")
            Query = "select * from zhongche where 车号='" & cheHao & "' order by 日期时间 DESC"
            rs.Open Query, db, adOpenDynamic, adLockOptimistic
            If IsNull(rs.Fields("提取标志")) Or rs.Fields("提取标志") = 0 Then
                If Not rs.BOF And Not rs.EOF Then
                    rs.MoveFirst
                    sMZ = rs.Fields("毛重")
                    sJZ = Trim(str(Val(sMZ) - Val(sPZ)))
                    sJZ = Format(sJZ, gdh_Edit_Formats)
                    Query = "update zhongche set 提取标志='1' where 车号='" & cheHao & "'"
                    db.Execute Query
                    Call UserGrid1.EditGridCell(i, "毛重", "", sMZ)
                    Call UserGrid1.EditGridCell(i, "净重", "", sJZ)
                Else
                    strLine = "没有找到第" & i & "节车号为" + Chr(34) + cheHao + Chr(34) + "的毛重数据"
                    List1.AddItem strLine
                End If
                
            End If
            rs.Close
        End If
    Next i
    
    If List1.ListCount > 0 Then
        List1.Visible = True
        List1.ZOrder 0
    Else
        List1.Visible = False
    End If
    
    db.Close
    Exit Function
ok:
End Function

Function QuFenQingZhong()   '//2007-1-22 设置轻重车，加上标志
                            
    Dim rowMax As Integer
    Dim i As Integer, j As Integer
    Dim temp As String
    
    rowMax = UserGrid1.GetGridRowNumber
    For i = 1 To rowMax
        temp = Trim(UserGrid1.GetGridCellValue(i, "毛重"))
        If Val(temp) >= gdh_Edit_Ambit Then
            Call UserGrid1.EditGridCell(i, "轻重车", "", "√")
        Else
            Call UserGrid1.EditGridCell(i, "毛重", "", "")
            Call UserGrid1.EditGridCell(i, "皮重", "", temp)
            Call UserGrid1.EditGridCell(i, "轻重车", "", "")
        End If
    Next i
End Function

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    On Error GoTo ok
        If Button = 2 Then
            If AdminIF = True Then
                If ListView1.SelectedItem.Index > 0 Then
                    gdhEdits.PopupMenu cd3
                End If
            End If
        End If
ok:
End Sub

Function Delete_from_gdhdata(strDate_Time As String, dbPath As String, dbName As String)
    Dim db As Adodb.Connection
    
    On Error GoTo ok
    Dim tableName As String
    Dim DBFullPath As String
    Dim Query As String
    Dim Cell() As String
    
    If dbPath = "" Then Exit Function
    
    Set db = New Adodb.Connection
    DBFullPath = dbPath + dbName + Mid(strDate_Time, 1, 4) + ".mdb"
    tableName = "gdh"
    
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFullPath & ";Jet OLEDB:Database Password=dfrwgdh;"
    
    Query = "delete from gdh where 日期时间='" & strDate_Time & "'"
    db.Execute Query
    Query = "delete from gdhindex where 日期时间='" & strDate_Time & "'"
    db.Execute Query
    
    db.Close
    
    MsgBox "数据已删除"
ok:
End Function