frmplan_ex.frm

用户MODBUS规约通信编程,起参考作用.

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{D959C709-8613-11D1-9840-002078110E7D}#1.0#0"; "as97Popup.ocx"
Object = "{C7AE747C-B9E4-11D7-B0E3-D8165009166E}#7.0#0"; "XPForm.ocx"
Begin VB.Form frmplan_ex 
   BackColor       =   &H00B9C4B9&
   BorderStyle     =   0  'None
   Caption         =   "按时间查询"
   ClientHeight    =   4500
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5940
   Icon            =   "frmplan_ex.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4500
   ScaleWidth      =   5940
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox Combo3 
      Height          =   300
      Left            =   1440
      TabIndex        =   9
      Text            =   "任何人"
      Top             =   2640
      Width           =   1335
   End
   Begin VB.ComboBox Combo2 
      Height          =   300
      Left            =   1440
      TabIndex        =   7
      Top             =   2040
      Width           =   1335
   End
   Begin MSComCtl2.DTPicker DTPicker2 
      Height          =   375
      Left            =   1440
      TabIndex        =   5
      Top             =   960
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   661
      _Version        =   393216
      Format          =   23658497
      CurrentDate     =   37879
   End
   Begin MSComCtl2.DTPicker DTPicker1 
      Height          =   375
      Left            =   1440
      TabIndex        =   4
      Top             =   480
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   661
      _Version        =   393216
      Format          =   23658497
      CurrentDate     =   37879
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   1440
      TabIndex        =   2
      Text            =   "全部"
      Top             =   1560
      Width           =   1335
   End
   Begin XP窗体控件.XPForm XPForm1 
      Height          =   1455
      Left            =   3480
      Top             =   120
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   2566
      Caption         =   "按时间查询"
      Icon            =   "frmplan_ex.frx":1272
      AlwaysOnTop     =   0   'False
      ShowFormSize    =   0   'False
   End
   Begin as97Popup.asPopup asPopup1 
      Height          =   375
      Left            =   600
      Top             =   3600
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      Caption         =   "查询"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   16761024
      ScaleWidth      =   73
      ScaleMode       =   0
      ScaleHeight     =   25
   End
   Begin as97Popup.asPopup asPopup2 
      Height          =   375
      Left            =   2040
      Top             =   3600
      Width           =   1215
      _ExtentX        =   2143
      _ExtentY        =   661
      Caption         =   "退出"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   16761024
      ScaleWidth      =   81
      ScaleMode       =   0
      ScaleHeight     =   25
   End
   Begin VB.Label Label2 
      Caption         =   "按人员"
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   2640
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "划分标准"
      Height          =   255
      Left            =   240
      TabIndex        =   6
      Top             =   2040
      Width           =   975
   End
   Begin VB.Label Label9 
      Caption         =   "分类查询"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   1560
      Width           =   975
   End
   Begin VB.Label Label8 
      BackColor       =   &H80000018&
      Caption         =   "结束时间"
      Height          =   255
      Left            =   360
      TabIndex        =   1
      Top             =   960
      Width           =   735
   End
   Begin VB.Label Label7 
      BackColor       =   &H80000018&
      Caption         =   "开始时间"
      Height          =   255
      Left            =   360
      TabIndex        =   0
      Top             =   480
      Width           =   855
   End
End
Attribute VB_Name = "frmplan_ex"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim conn  As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim connectstring As String
Dim sqltxt  As String
Dim rs_1 As New ADODB.Recordset
Dim rs_2 As New ADODB.Recordset
Dim date_find_begin, date_find_end As String
Dim find_time As String
Dim i As Integer
Dim conn1 As New ADODB.Connection
Dim Xj_date, Xj_type, Xj_lc, Xj_planper, Xj_trueper, Xj_plantime, Xj_truetime, Xj_all, Xj_result As String
Dim T_w As Integer
Dim totaltime As Integer
Dim Plan_time, true_time As String
Dim Allo_time As Integer
Dim year_time, mon_time, day_time As String
Dim begin_flag, end_flag As Integer
Dim Begin_date, End_date As Date
Dim biaozhun As Integer

Dim begin_Month, end_Month As Integer
Dim z_Bang, z_Loc, z_Time As String
Private Sub asPopup1_Click(Cancel As Boolean)
On Error Resume Next
asPopup1.Enabled = False

asPopup2.Enabled = False
frmdelay.Label1.MsgChar = "正在分析,请您稍等"
frmdelay.Show

Begin_date = DTPicker1
End_date = DTPicker2
connectstring = "provider=Microsoft.Jet.oledb.4.0;" & _
            "data source=" & App.path & "\jk.mdb"
 
conn.Open connectstring
conn.CursorLocation = adUseClient
'sqltxt = "select  * from 计划执行表"
sqltxt = "delete * from 计划执行表"
biaozhun = Combo2.Text

Set rs = conn.Execute(sqltxt)

Set rs = Nothing
Set conn = Nothing


year_time = Year(Begin_date)
If Len(year_time) = 2 Then
year_time = "20" & year_time
End If
mon_time = Month(Begin_date)
begin_Month = Month(Begin_date)
end_Month = Month(End_date)
If Len(mon_time) = 1 Then
mon_time = "0" & mon_time
End If
day_time = Day(Begin_date)
If Len(day_time) = 1 Then
day_time = "0" & day_time
End If
conn1.Open connectstring
begin_flag = Day(Begin_date)
end_flag = Day(End_date)

If Month(Begin_date) <> Month(End_date) Then


If begin_Month = 1 Or begin_Month = 3 Or begin_Month = 5 Or begin_Month = 7 Or begin_Month = 8 Or begin_Month = 10 Or begin_Month = 12 Then
end_flag = 31
End If

If begin_Month = 4 Or begin_Month = 6 Or begin_Month = 9 Or begin_Month = 11 Then
end_flag = 30
End If

 If begin_Month = 2 Then
 If Year(Begin_date) Mod 4 = 0 Then
 end_flag = 29
 Else
 end_flag = 28
 End If
 End If
 
 Do While begin_flag <= end_flag
If Len(begin_flag) = 1 Then
day_time = "0" & begin_flag
Else
day_time = begin_flag
End If

find_time = year_time & "/" & mon_time & "/" & day_time



sqltxt = "select * from 计划设置表 order by 巡检类型,地点,计划时间"
Set rs_1 = conn1.Execute(sqltxt)
sqltxt = "select * from 巡检结果表 where 巡检日期='" & find_time & " ' order by 采集器类型,地点, 巡检时间 "
Set rs_2 = conn1.Execute(sqltxt)
If rs_1.EOF And rs_1.BOF Then

Else
rs_1.MoveFirst
End If
If rs_2.EOF And rs_2.BOF Then

Else
rs_2.MoveFirst
End If

Do While rs_1.EOF <> True And rs_2.EOF <> True

 '看是否是任何人可以
 
If rs_1.Fields("巡检类型") = rs_2.Fields("采集器类型") And rs_1.Fields("地点") = rs_2.Fields("地点") Then '比较非漏
                          Plan_time = rs_1.Fields("计划时间")
                          true_time = rs_2.Fields("巡检时间")
                          Allo_time = rs_1.Fields("允许误差")
                          totaltime = DateDiff("n", CDate(Plan_time), CDate(true_time))
                          
                          zang_flag

If Abs(totaltime) <= Allo_time Then
Xj_result = "正点"
add
rs_1.MoveNext
rs_2.MoveNext
Else
    If Abs(totaltime) <= biaozhun Then
    
          If totaltime >= 0 Then
          Xj_result = "迟到"
          add
          rs_1.MoveNext
          rs_2.MoveNext
          Else
          Xj_result = "早到"
          add
          rs_1.MoveNext
          rs_2.MoveNext
         End If
         
  Else
    If totaltime > 0 Then
    add_1
    
      rs_1.MoveNext
    Else
       rs_2.MoveNext
    End If
    
 End If
 
End If


Else

If b_Next = True Then
rs_2.MoveNext
Else
add_1
rs_1.MoveNext
End If


End If


Loop




Do While rs_1.EOF <> True
Xj_result = "漏检"
Xj_date = find_time
Xj_type = rs_1.Fields("巡检类型")
Xj_lc = rs_1.Fields("地点")
Xj_planper = rs_1.Fields("人员")
Xj_plantime = rs_1.Fields("计划时间")
Xj_truetime = "未知"
Xj_trueper = "未知"
Xj_all = rs_1.Fields("允许误差")
If Combo1.Text = "全部" Or Combo1.Text = Xj_result Then
sqltxt = "insert into 计划执行表 values ('" & Xj_date & "','" & Xj_type & "','" & Xj_lc & "','" & Xj_planper & "','" & Xj_plantime & "' ,'" & Xj_trueper & "','" & Xj_truetime & "','" & Xj_all & " ','" & Xj_result & "')"
conn1.Execute (sqltxt)
End If
rs_1.MoveNext
Loop
Set rs_1 = Nothing
Set rs_2 = Nothing
TimeDelay 500
begin_flag = begin_flag + 1
Loop



'下一个月的

begin_flag = 1
end_flag = Day(End_date)
mon_time = Month(End_date)

If Len(mon_time) = 1 Then
mon_time = "0" & mon_time
End If


Do While begin_flag <= end_flag
If Len(begin_flag) = 1 Then
day_time = "0" & begin_flag
Else
day_time = begin_flag
End If

find_time = year_time & "/" & mon_time & "/" & day_time



sqltxt = "select * from 计划设置表 order by 巡检类型,地点,计划时间"
Set rs_1 = conn1.Execute(sqltxt)
sqltxt = "select * from 巡检结果表 where 巡检日期='" & find_time & " ' order by 采集器类型,地点, 巡检时间 "
Set rs_2 = conn1.Execute(sqltxt)
If rs_1.EOF And rs_1.BOF Then

Else
rs_1.MoveFirst
End If