数据录入.frm

一个客车售票系统

      RecordSource    =   ""
      Top             =   4770
      Width           =   1815
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退   出"
      Height          =   345
      Left            =   7170
      TabIndex        =   4
      Top             =   2580
      Width           =   1185
   End
   Begin VB.CommandButton Command1 
      Caption         =   "返   回"
      Enabled         =   0   'False
      Height          =   345
      Left            =   5970
      TabIndex        =   3
      Top             =   2580
      Width           =   1185
   End
   Begin VB.TextBox Text3 
      DataField       =   "班组"
      DataSource      =   "Data1"
      Height          =   270
      Left            =   2250
      TabIndex        =   2
      Text            =   "Text3"
      Top             =   3690
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.TextBox Text2 
      DataField       =   "车次"
      DataSource      =   "Data1"
      Height          =   270
      Left            =   1380
      TabIndex        =   1
      Text            =   "Text2"
      Top             =   3690
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.TextBox Text1 
      DataField       =   "发车日期"
      DataSource      =   "Data1"
      Height          =   270
      Left            =   540
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   3690
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   720
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "日期车次"
      Top             =   4020
      Width           =   1815
   End
End
Attribute VB_Name = "数据录入"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ReceiveYModemDll Lib "C:\列车客票\PlatW95.dll" (ByVal s1$, ByVal s2$, ByVal s3$, ByVal s4%) As Long
Dim Ret As Integer, I As Integer, K As Integer, Num1 As Integer, Num2 As Integer
Dim B1(5000) As String, B2(5000) As String, B3(5000) As String, B4(5000) As String, B5(5000) As String
Dim T1 As String, T2 As String, T3 As String
Dim Result As Integer, Fname As String
Private Sub Form_Load()
    Open App.Path + "\" + "Date.txt" For Input As #1
       Input #1, T1
       Close #1
    Open App.Path + "\" + "Cc.txt" For Input As #1
       Input #1, T2
       Close #1
    Open App.Path + "\" + "Bz.txt" For Input As #1
       Input #1, T3
       Close #1
    K = 0
    Ret = 1
    Fname = Space$(15)
    Num1 = 0
    Flag = 0
    Command1.Enabled = False
End Sub
Private Sub Option1_Click()
    Num2 = 1: Storage (Num2)
End Sub
Private Sub Option2_Click()
    Num2 = 2: Storage (Num2)
End Sub
Private Sub Option3_Click()
    Num2 = 3: Storage (Num2)
End Sub
Private Sub Option4_Click()
    Num2 = 4: Storage (Num2)
End Sub
Private Sub Option5_Click()
    Num2 = 5: Storage (Num2)
End Sub
Private Sub Option6_Click()
    Num2 = 5: Storage (Num2)
End Sub
Private Sub Option7_Click()
    Num2 = 7: Storage (Num2)
End Sub
Private Sub Option8_Click()
    Num2 = 8: Storage (Num2)
End Sub
Private Sub Storage(ByVal Number As Integer)
    Select Case Number
        Case 1
          Option1.Enabled = False
        Case 2
          Option2.Enabled = False
        Case 3
          Option3.Enabled = False
        Case 4
          Option4.Enabled = False
        Case 5
          Option5.Enabled = False
        Case 6
          Option6.Enabled = False
        Case 7
          Option7.Enabled = False
        Case 8
          Option8.Enabled = False
    End Select
  Ret = ReceiveYModemDll("COM1:19200,n,8,1", App.Path + "\", Fname, 6)
    If Ret = 6 Then
    Result = MsgBox("    设备尚未准备好，请检查通讯接口与计算机的连接是否正确 ！    ", vbExclamation + vbRetryCancel, "提示信息")
         If Result = 4 Then
     Select Case Number
         Case 1
           Option1.Enabled = True
           Option1.Value = False
         Case 2
           Option2.Enabled = True
           Option2.Value = False
         Case 3
           Option3.Enabled = True
           Option3.Value = False
         Case 4
           Option4.Enabled = True
           Option4.Value = False
         Case 5
           Option5.Enabled = True
           Option5.Value = False
         Case 6
           Option6.Enabled = True
           Option6.Value = False
         Case 7
           Option7.Enabled = True
           Option7.Value = False
         Case 8
           Option8.Enabled = True
           Option8.Value = False
     End Select
           Exit Sub
          Else
           Unload Me
        End If
    End If
    If Ret = 0 Then
        Data3.DatabaseName = App.Path + "\"
        Data3.Refresh
        Do While Data3.Recordset.EOF = False
          K = K + 1
           B1(K) = Text10(1): B2(K) = Text10(2): B3(K) = Text10(3): B4(K) = Text10(4): B5(K) = Text10(5)
          Data3.Recordset.MoveNext
        Loop
        Data3.Recordset.Close
    End If
    Num1 = Num1 + 1
    If Num1 = 8 Then
     Command1.Enabled = True
    End If
End Sub
Private Sub Command1_Click()
Call Save_Data
Unload Me
End Sub
Private Sub Command2_Click()
    If Num1 = 0 Then
         Open App.Path + "\" + "Date.txt" For Output As #1
           Write #1, ""
           Close #1
        Open App.Path + "\" + "Cc.txt" For Output As #1
           Write #1, ""
           Close #1
        Open App.Path + "\" + "Bz.txt" For Output As #1
           Write #1, ""
           Close #1
        Unload Me
     Else
If Num1 < 8 Then
Result = MsgBox("您只读入了 " & CStr(Num1) & " 个数据采集器的数据，是否还要读入其他数据采集器的数据   ？   ", vbQuestion + vbYesNo, "提示信息")
If Result <> 6 Then
            Call Save_Data
            Unload Me
           End If
        End If
    End If
End Sub
Private Sub Save_Data()
 Data1.DatabaseName = App.Path + "\" + "原始记录.mdb"
 Data1.Refresh
        Data1.Recordset.AddNew
        Text1 = T1
        Text2 = T2
        Text3 = T3
        Data1.Recordset.AddNew
        Text1 = Format((CDate(T1) + 2), "yyyy年m月d日")
        Text2 = "237"
        Text3 = T3
    Data1.Recordset.Close
    Data2.DatabaseName = App.Path + "\原始记录.mdb"
'保存数据
Cxtj = "日期"
 Cxs = "[" + Cxtj + "]" + "=" + "'" + T1 + "'"
    Select Case T7
      Case "第一组"
       Data2.RecordSource = "Select * from  A1  where" & Cxs
      Case "第二组"
       Data2.RecordSource = "Select * from  A2  where" & Cxs
      Case "第三组"
       Data2.RecordSource = "Select * from  A3  where" & Cxs
      Case "第四组"
       Data2.RecordSource = "Select * from  A4  where" & Cxs
      Case "第五组"
       Data2.RecordSource = "Select * from  A5  where" & Cxs
      Case "第六组"
       Data2.RecordSource = "Select * from  A6  where" & Cxs
      Case "第七组"
       Data2.RecordSource = "Select * from  A7  where" & Cxs
      Case "第八组"
       Data2.RecordSource = "Select * from  A8  where" & Cxs
   End Select
 Data2.Refresh
 If Text4 = T1 Then
    Do While Data2.Recordset.EOF = False
        Data2.Recordset.Delete
        Data2.Recordset.MoveNext
    Loop
 End If
 T1 = Format((CDate(T1) + 2), "yyyy年m月d日")
  Cxs = "[" + Cxtj + "]" + "=" + "'" + T1 + "'"
    Select Case T7
      Case "第一组"
       Data2.RecordSource = "Select * from  A1  where" & Cxs
      Case "第二组"
       Data2.RecordSource = "Select * from  A2  where" & Cxs
      Case "第三组"
       Data2.RecordSource = "Select * from  A3  where" & Cxs
      Case "第四组"
       Data2.RecordSource = "Select * from  A4  where" & Cxs
      Case "第五组"
       Data2.RecordSource = "Select * from  A5  where" & Cxs
      Case "第六组"
       Data2.RecordSource = "Select * from  A6  where" & Cxs
      Case "第七组"
       Data2.RecordSource = "Select * from  A7  where" & Cxs
      Case "第八组"
       Data2.RecordSource = "Select * from  A8  where" & Cxs
   End Select
 Data2.Refresh
 If Text4 = T1 Then
    Do While Data2.Recordset.EOF = False
        Data2.Recordset.Delete
        Data2.Recordset.MoveNext
    Loop
 End If
    Select Case T3
      Case "第一组"
       Data2.RecordSource = "A1"
      Case "第二组"
       Data2.RecordSource = "A2"
      Case "第三组"
       Data2.RecordSource = "A3"
      Case "第四组"
       Data2.RecordSource = "A4"
      Case "第五组"
       Data2.RecordSource = "A5"
      Case "第六组"
       Data2.RecordSource = "A6"
      Case "第七组"
       Data2.RecordSource = "A7"
      Case "第八组"
       Data2.RecordSource = "A8"
     End Select
     Data2.Refresh
   For I = 1 To K
    Data2.Recordset.AddNew
    If B2(I) > B3(I) Then
     Text4 = Format((CDate(T1) + 2), "yyyy年m月d日")
     Else
     Text4 = T1
    End If
    Text5 = B1(I): Text6 = B2(I): Text7 = B3(I)
    Text8 = B4(I): Text9 = B5(I)
  Next I
End Sub