gdhedits.frm

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

Dim ObjSystem As Object
Dim gdh_Weight_Ambit As Single
Dim gdh_Edit_QingZhong_Mode As Integer
Dim gdh_Edit_dbPath As String
Dim gdh_Edit_saveFilePath As String
Dim gdh_Edit_HuiPi As Integer   '回皮方式(计规回皮或称重回皮)
Dim gdh_Edit_Ambit As Single

Dim intCell(20) As Integer

Private Type element    '铁路计规
    gdhCX As String
    gdhPZ As String
    gdhBZ As String
    gdhCHS As String
    gdhCHE As String
End Type
Dim gdhJG() As element

Dim constDBName As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long


Private Sub Combo1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Command2_Click
    End If
End Sub

Private Sub Command1_Click(Index As Integer)
    Dim dbName As String
    
    Select Case Index
        Case 0  '保存
            If Checking_Save = False Then Exit Sub
            If Combo2.text = "本厂车" Then
                If MsgBox("确实要保存数据到本厂车数据库吗？", vbYesNo + vbDefaultButton2) = vbNo Then
                    Exit Sub
                End If
                If Save_Data_to_gdhdata(Label2(0).Caption, Label2(1).Caption, gdh_Edit_dbPath, "gdhdatamy") = True Then
                MsgBox "保存完毕"
                Else
                    MsgBox "存储过程中发生错误"
                End If
            ElseIf Combo2.text = "外来车" Then
                If MsgBox("确实要保存数据到外来车数据库吗？", vbYesNo + vbDefaultButton2) = vbNo Then
                    Exit Sub
                End If
                If Save_Data_to_gdhdata(Label2(0).Caption, Label2(1).Caption, gdh_Edit_dbPath, "gdhdataother") = True Then
                MsgBox "保存完毕"
                Else
                    MsgBox "存储过程中发生错误"
                End If
            ElseIf Combo2.text = "" Then
                MsgBox "请选择数据来源"
            Else
                MsgBox "数据源错误！"
            End If
'            If MsgBox("确实要保存数据到数据库吗？", vbYesNo + vbDefaultButton2) = vbNo Then
'                Exit Sub
'            End If
'            If Save_Data_to_gdhdata(Label2(0).Caption, Label2(1).Caption, gdh_Edit_dbPath, constDBName) = True Then
'                MsgBox "保存完毕"
'            Else
'                MsgBox "存储过程中发生错误"
'            End If
        Case 1  '打印
            Call Save_Data_to_File(App.Path & "\print.tpr", Label2(0).Caption, Label2(1).Caption)
            gdhPrint.Show
        Case Else
        
    End Select
End Sub

Private Sub Command2_Click()
    Dim strDateS As String
    Dim strDateE As String
    On Error GoTo ok
    strDateS = Format_Date(Combo1(0).text, Combo1(1).text, Combo1(2).text, "S")
    strDateE = Format_Date(Combo1(0).text, Combo1(1).text, Combo1(2).text, "E")
    
'    Label2(0).Caption = ""
'    Label2(1).Caption = ""
'    constDBName = "gdhdatamy"
'    Call UserGrid1.MSHFGrid_Clear
'    Call ListView_Load(strDateS, strDateE, Combo1(0).text, gdh_Edit_dbPath, constDBName)
    If Combo2.text = "本厂车" Then
        Label2(0).Caption = ""
        Label2(1).Caption = ""
        constDBName = "gdhdatamy"
        Call UserGrid1.MSHFGrid_Clear
        Call ListView_Load(strDateS, strDateE, Combo1(0).text, gdh_Edit_dbPath, constDBName)
    ElseIf Combo2.text = "外来车" Then
        Label2(0).Caption = ""
        Label2(1).Caption = ""
        constDBName = "gdhdataother"
        Call UserGrid1.MSHFGrid_Clear
        Call ListView_Load(strDateS, strDateE, Combo1(0).text, gdh_Edit_dbPath, constDBName)
    ElseIf Combo2.text = "" Then
        MsgBox "请选择数据来源"
    Else
    End If
ok:
End Sub

Function Clear_()

End Function

Function CreatDB(strYear As String)
    Dim dbName As String
    Dim DBFullPath As String
    On Error GoTo ok
    
    If Len(strYear) <> 4 Then Exit Function
    
    dbName = "gdhdatamy" + strYear + ".mdb"
    DBFullPath = gdh_Edit_dbPath + dbName
    If ObjSystem.FileExists(DBFullPath) = False Then
        If ObjSystem.FileExists(App.Path + "\gdhdatamy.mdb") = True Then
            FileCopy App.Path + "\gdhdatamy.mdb", DBFullPath
        End If
    End If
    
    dbName = "gdhdataother" + strYear + ".mdb"
    DBFullPath = gdh_Edit_dbPath + dbName
    If ObjSystem.FileExists(DBFullPath) = False Then
        If ObjSystem.FileExists(App.Path + "\gdhdataother.mdb") = True Then
            FileCopy App.Path + "\gdhdataother.mdb", DBFullPath
        End If
    End If
    
    Exit Function
ok:
    
End Function

Private Sub Command4_Click(Index As Integer)
    Select Case Index
        Case 0  '存轻重车数据
            If gdh_Edit_HuiPi = 1 Then
                Call Save_Qing_Zhong_to_qingzhong(App.Path & "\", Label2(0).Caption, Label2(1).Caption)
                MsgBox "OK"
            End If
        Case 1  '提轻重车数据
            If gdh_Edit_HuiPi = 1 Then
                Call get_WeightValue_From_qingzhong
                
            End If
        Case Else
        
    End Select
        
End Sub

Private Sub deletedata_Click()
    If MsgBox("确实要删除数据吗？", vbYesNo + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If
    If Combo2.text <> "本厂车" And Combo2.text <> "外来车" Then
        MsgBox "请选择正确的数据源"
        Exit Sub
    End If
    If Combo2.text = "本厂车" Then
        constDBName = "gdhdatamy"
    Else
        constDBName = "gdhdataother"
    End If
    Call Delete_from_gdhdata(ListView1.SelectedItem.text, gdh_Edit_dbPath, constDBName)
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim aa() As String
    
    Combo2.AddItem "本厂车"
    Combo2.AddItem "外来车"

    Me.WindowState = 2
    Set ObjSystem = CreateObject("Scripting.FileSystemObject")
    
    Call UserGrid1.GetGridRowValues(aa, 0)
    Call FindField(aa, intCell())
    Call Initialize_Var
    
    If (ObjSystem.FileExists(App.Path & "\tempfile.tpr") = True) Then
        Call UserGrid1.Read_Data_from_File
        Label2(0).Caption = UserGrid1.gdh_V_Date_Time
        Label2(1).Caption = UserGrid1.gdh_V_Direction
        If gdh_Edit_HuiPi = 1 Then
            Call QuFenQingZhong
        End If
    End If
    
    Dim stru As String
    For i = 0 To 99 '...读入年分
        If Len(Trim(str(i))) = 1 Then
            stru = 0 & i
        Else
            stru = i
        End If
        stru = "20" & stru
        Combo1(0).AddItem stru
    Next i
    
    For i = 1 To 12 '...读入月份
        If Len(Trim(str(i))) = 1 Then
            stru = 0 & i
        Else
            stru = i
        End If
        Combo1(1).AddItem stru
        
    Next i
    For i = 1 To 31 '...读入日
        If Len(Trim(str(i))) = 1 Then
            stru = 0 & i
        Else
            stru = i
        End If
        Combo1(2).AddItem stru
    Next i
    
    Dim strYear As String, strMonth As String, strDay As String, strDateS As String, strDateE As String
    strYear = Format(Now, "yyyy-mm-dd")
    strDay = Mid(strYear, 9, 2): strMonth = Mid(strYear, 6, 2): strYear = Mid(strYear, 1, 4)
    Combo1(0).text = strYear: Combo1(1).text = strMonth: Combo1(2).text = strDay
'    strDateS = Format_Date(strYear, strMonth, strDay, "S")
'    strDateE = Format_Date(strYear, strMonth, strDay, "E")
''    Call ListView_Load(strDateS, strDateE, strYear, gdh_Edit_dbPath)

    Call CreatDB(strYear)
    
    If gdh_Edit_HuiPi = 1 Then
        Command4(0).Enabled = True
        Command4(1).Enabled = True
    Else
        Command4(0).Enabled = False
        Command4(1).Enabled = False
    End If
    Combo2.text = "本厂车"
End Sub

Private Sub Form_Resize()
    On Error GoTo ok:
'    UserGrid1.Top = 50
    ListView1.Left = 0
    UserGrid1.Left = ListView1.Left + ListView1.Width + 20
    UserGrid1.Width = ScaleWidth - 200 - ListView1.Width
    UserGrid1.Height = ScaleHeight - UserGrid1.Top - 200
    ListView1.Height = ScaleHeight - ListView1.Top - 350
ok:
    
End Sub


Private Sub List1_DblClick()
    List1.Visible = False
End Sub

Private Sub ListView1_DblClick()
    On Error GoTo ok
    Label2(0).Caption = Trim(ListView1.SelectedItem.text)
    Label2(1).Caption = Trim(ListView1.SelectedItem.SubItems(1))
    
    If Combo2.text <> "本厂车" And Combo2.text <> "外来车" Then
        MsgBox "请选择正确的数据源"
        Exit Sub
    End If
    If Combo2.text = "本厂车" Then
        constDBName = "gdhdatamy"
    Else
        constDBName = "gdhdataother"
    End If
    Call UserGrid1.Read_Data_From_gdhdata(Label2(0).Caption, gdh_Edit_dbPath, constDBName)
ok:
End Sub

Function GetKeyValue(str_FilePath As String, Section As String, key As String, secondValue As String) As String
    Dim Value As String
    Dim t As Long
    On Error GoTo ok
    
    Value = String(255, " ")
    t = GetPrivateProfileString(Section, key, secondValue, Value, 255, str_FilePath)
    Value = Trim(Value)
    GetKeyValue = Mid(Value, 1, Len(Value) - 1)
ok:
End Function

Function Initialize_Var()
    Dim stemp As String
    Dim str_FilePath As String
    
    str_FilePath = App.Path & "\" & "editconfig.ini"
    
    If ObjSystem.FileExists(str_FilePath) = False Then
        MsgBox "配置文件丢失,请与我们联系"
        Exit Function
    End If
    '数据库文件"gdhdata"存放路径
    stemp = GetKeyValue(str_FilePath, "path", "dbpath", App.Path)
    If stemp = "" Then
        stemp = App.Path
    End If
    If Right$(stemp, 1) <> "\" Then
        gdh_Edit_dbPath = stemp & "\"
    End If
    
    '文本文件存放路径
    stemp = GetKeyValue(str_FilePath, "path", "savefilepath", App.Path)
    If Right$(stemp, 1) <> "\" Then
        gdh_Edit_saveFilePath = stemp
    End If
    
    '重量数据格式
    stemp = GetKeyValue(str_FilePath, "format", "formats", "0.00")
    gdh_Edit_Formats = stemp
    
    '
    stemp = GetKeyValue(str_FilePath, "variable", "ambit", "50")
    If Val(stemp) >= 50 Then
        gdh_Edit_Ambit = Val(stemp)
    ElseIf Val(stemp) >= 40 Then
        gdh_Edit_Ambit = Val(stemp)
    Else
        gdh_Edit_Ambit = 50
    End If
    
    '是否回皮
    stemp = GetKeyValue(str_FilePath, "huipi", "huipi", "0")
    If stemp = "1" Then
        gdh_Edit_HuiPi = 1
    Else
        gdh_Edit_HuiPi = 0
    End If
    
End Function

Function ListView_Load(Date_Start As String, Date_End As String, strYear As String, dbPath As String, dbName As String)
'    Dim db As Database, rs As Recordset
    Dim temp As String, Query As String
    Dim FulldbPath As String
    Dim i As Integer
    Dim Adodb As New Adodb.Connection, Adors As New Adodb.Recordset
    On Error GoTo ok
    
    ListView1.ListItems.Clear
    FulldbPath = dbPath & dbName & strYear & ".mdb"
    
'    Set db = OpenDatabase(dbPath & dbName & strYear & ".mdb", False, False, ";pwd=1")
'
'    Query = "select  * from gdhindex where 日期时间>='" & Date_Start & "'and 日期时间<='" & Date_End & "'  order by 日期时间 ASC"
''    Query = "select  * from gdhindex where 日期时间 like '" & Mid(Date_Start, 1, 10) & "%'"
'    Set rs = db.OpenRecordset(Query)
'    If Not rs.BOF And Not rs.EOF Then
'        rs.MoveFirst
'        Do While Not rs.EOF
'            Call ListView_Add(Trim(rs.Fields("日期时间")), Trim(rs.Fields("方向")))
'            rs.MoveNext
'        Loop
'    End If
'    rs.Close
'    db.Close
'    Exit Function
    
    Adodb.CursorLocation = adUseClient
    Adodb.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & FulldbPath & ";Jet OLEDB:Database Password=dfrwgdh;"
    Query = "select  * from gdhindex where 日期时间>='" & Date_Start & "'and 日期时间<='" & Date_End & "'  order by 日期时间 ASC"
    Adors.Open Query, Adodb, adOpenDynamic, adLockOptimistic
    
    If Not Adors.BOF And Not Adors.EOF Then
        Adors.MoveFirst
        Do While Not Adors.EOF
            Call ListView_Add(Trim(Adors.Fields("日期时间")), Trim(Adors.Fields("方向")))
            Adors.MoveNext
        Loop
    End If
    
    Exit Function
ok:
    MsgBox Err.Number
    Adodb.Close
End Function

Function ListView_Add(RiQi As String, Direc As String)
    On Error GoTo ok
    Dim mListItem As ListItem
    Set mListItem = ListView1.ListItems.Add(, , "" & RiQi & "")
    mListItem.SubItems(1) = Direc
ok:
End Function

Function Format_Date(strYear As String, strMonth As String, strDay As String, SorE As String) As String
    Dim temp As String
    temp = strYear + "-" + Format("2006-" & strMonth, "mm")
    If SorE = "S" Then
        If strDay = "" Then
            temp = temp + "-" + "00"
        Else
            temp = temp + "-" + Format("2006-12-" & strDay, "dd")
        End If
        temp = temp + " 00:00:00"
    ElseIf SorE = "E" Then
        If strDay = "" Then
            temp = temp + "-" + "31"
        Else
            temp = temp + "-" + Format("2006-12-" & strDay, "dd")
        End If
        temp = temp + " 23:59:59"
    End If
    
    Format_Date = temp
End Function

Public Function Save_Data_to_gdhdata(strDate_Time As String, strDirection As String, dbPath As String, dbName As String) As Boolean
    Dim tableTitle() As String
    Dim LineContent() As String