frmworker.frm

VB写的通过串口与考勤机连接通讯的程序

         BOFAction       =   0
         EOFAction       =   0
         ConnectStringType=   1
         Appearance      =   1
         BackColor       =   -2147483643
         ForeColor       =   -2147483640
         Orientation     =   0
         Enabled         =   -1
         Connect         =   ""
         OLEDBString     =   ""
         OLEDBFile       =   ""
         DataSourceName  =   ""
         OtherAttributes =   ""
         UserName        =   ""
         Password        =   ""
         RecordSource    =   ""
         Caption         =   "Adodc1"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         _Version        =   393216
      End
      Begin MSDataGridLib.DataGrid Data 
         Bindings        =   "frmWorker.frx":0038
         Height          =   2295
         Left            =   120
         TabIndex        =   1
         Top             =   1260
         Width           =   7335
         _ExtentX        =   12938
         _ExtentY        =   4048
         _Version        =   393216
         AllowUpdate     =   0   'False
         BackColor       =   12648447
         HeadLines       =   1
         RowHeight       =   18
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "frmWorker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sID As String
Dim SName, sCard As String
Dim findSQL As String
Private Sub SetNew()
 Set adoRs = adoCon.Execute("select CardID from Card where CardID not in (select CardID from Worker) order by CardID")
  If adoRs.EOF Then
     cobCard.Text = ""
   MsgBox "磁卡已经没有，请增添新卡。", vbOKOnly, "系统提示"
 Else
    With cobCard
       .Clear
       Do While Not adoRs.EOF
          .AddItem adoRs!CardID
          adoRs.MoveNext
       Loop
        .ListIndex = 0
    End With
 End If

txtName.Text = ""
txtBuMen.Text = ""
cobBuMen.Clear
cobBuMen.AddItem ""
Set adoRs = adoCon.Execute("select * from BuMen")
If adoRs.EOF Then
   MsgBox "您的部门没有填写，请先填写部门！", vbOKOnly, "系统提示"
Else
 With ListBuMen
    .Clear
    Do While Not adoRs.EOF
     .AddItem adoRs!Name
     cobBuMen.AddItem adoRs("Name")
     adoRs.MoveNext
    Loop
 End With
End If
cobBuMen.ListIndex = 0
OptCard.Value = True

End Sub


Private Sub cmdBuMenAdd_Click()
If txtBuMen.Text = "" Then
   MsgBox "您没有填写部门!", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If
Set adoRs = adoCon.Execute("select count(*) from BuMen where Name='" & Trim(txtBuMen.Text) & "'")
If adoRs(0) > 0 Then
   MsgBox "您要添加的" & Trim(txtBuMen.Text) & "已经存在!", vbOKOnly + vbExclamation, "录入提示"
   Exit Sub
End If
adoCon.Execute ("insert into BuMen values('" & Trim(txtBuMen.Text) & "')")
Call SetNew
End Sub

Private Sub cmdBuMenDel_Click()
If ListBuMen.Text = "" Then
   MsgBox "您没有选定部门！", vbOKOnly, "删除提示"
   Exit Sub
Else
   If MsgBox("您是否真的要删除" & Trim(ListBuMen.Text) & "吗？", vbYesNo + vbDefaultButton1, "删除提示") = vbYes Then
      adoCon.Execute ("delete from BuMen where Name='" & ListBuMen.Text & "'")
   End If
End If
Call SetNew
End Sub




Private Sub cmdCancel_Click()
Call SetNew
End Sub

Private Sub cmdDelete_Click()
If MsgBox("您是否真的要删除姓名“" + txtName.Text + "”的记录吗？", vbYesNo, "删除提示") = vbYes Then
   adoCon.Execute ("delete from Worker where CardID ='" & sID & "'")
End If
Call SetNew
Call FindRef
End Sub
Public Sub FindRef()
Dim SQL As String
SQL = "select CardID as 卡号,"
SQL = SQL + "Name as 姓名,"
SQL = SQL + "BuMen as 部门 from Worker order by CardID"
AdoFind.ConnectionString = RtnStr
AdoFind.RecordSource = SQL
AdoFind.Refresh
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub cmdFind_Click()
Dim SQL As String
SQL = "select CardID as 卡号,"
SQL = SQL + "Name as 姓名,"
SQL = SQL + "BuMen as 部门 from Worker "
If OptCard.Value = True Then
   SQL = SQL + " order by CardID"
End If
If OptBuMen.Value = True Then
   SQL = SQL + " order by BuMen"
End If
If OptName.Value = True Then
   SQL = SQL + "order by Name"
End If

End Sub

Private Sub cmdModExit_Click()
Unload Me
End Sub

Private Sub cmdModfiy_Click()
SSTab1.Tab = 0
End Sub

Private Sub cmdOk_Click()
If txtName.Text = "" Then
   MsgBox "您没有填写姓名，请核实！", vbOKOnly + vbExclamation, "系统提示"
   txtName.Text = ""
   txtBuMen.Text = ""
   cobBuMen.Text = ""
   cobCard.Text = ""
   Exit Sub
End If

If cobCard.Text = "" Then
   MsgBox "您没有填写卡号，请核实！", vbOKCancel + vbExclamation, "系统提示"
   txtName.Text = ""
   txtBuMen.Text = ""
   cobBuMen.Text = ""
   cobCard.Text = ""
   Exit Sub

End If
Set adoRs = adoCon.Execute("select * from Worker where Name='" & Trim(txtName.Text) & "'")
If Not adoRs.EOF Then
   MsgBox "您填写的姓名已经存在，请核实！", vbOKOnly, "系统提示"
   txtName.Text = ""
   txtBuMen.Text = ""
   cobBuMen.Text = ""
   cobCard.Text = ""
   
   Exit Sub
End If
Set adoRs = adoCon.Execute("select * from Worker where CardID='" & Trim(cobCard.Text) & "'")
If Not adoRs.EOF Then
   MsgBox "您填写的卡号已经存在，请核实！", vbOKOnly, "系统提示"
   txtName.Text = ""
   txtBuMen.Text = ""
   cobBuMen.Text = ""
   cobCard.Text = ""
   Exit Sub
   
End If
Dim SQL As String
SQL = "insert into  Worker values "
SQL = SQL + "('" + Trim(cobCard.Text) + "','"
SQL = SQL + Trim(txtName.Text) + "','"
SQL = SQL + Trim(cobBuMen.Text) + "')"
adoCon.Execute (SQL)
Call SetNew
Call FindRef
End Sub

Private Sub cmdShowAll_Click()
Call FindRef
End Sub

Private Sub cmdUpdate_Click()
Dim SQL As String
If txtName.Text = "" Then
   MsgBox "您没有填写姓名，请核实！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If

If cobCard.Text = "" Then
   MsgBox "您没有填写卡号，请核实！", vbOKCancel + vbExclamation, "系统提示"
   Exit Sub

End If
If SName <> txtName.Text Then
    Set adoRs = adoCon.Execute("select * from Worker where Name='" & Trim(txtName.Text) & "'")
    If Not adoRs.EOF Then
       MsgBox "您填写的姓名已经存在，请核实！", vbOKOnly, "系统提示"
       Exit Sub
    End If
End If
If sCard <> cobCard.Text Then
    Set adoRs = adoCon.Execute("select * from Worker where CardID='" & Trim(cobCard.Text) & "'")
    If Not adoRs.EOF Then
       MsgBox "您填写的卡号已经存在，请核实！", vbOKOnly, "系统提示"
       Exit Sub
    End If
End If

SQL = "update Worker set CardID ='" + Trim(cobCard.Text) + "',"
SQL = SQL + "Name='" + Trim(txtName.Text) + "',"
SQL = SQL + "BuMen='" + Trim(cobBuMen.Text) + "'"
SQL = SQL + " where CardID='" & sID & "'"
adoCon.Execute (SQL)
Call SetNew
Call FindRef
End Sub

Private Sub DataGrid1_Click()
DataGrid1.Col = 0
If AdoFind.Recordset.EOF And AdoFind.Recordset.BOF Then

   MsgBox "没有记录选择!", vbOKOnly + vbExclamation, "修改提示"
   Exit Sub
End If
sID = DataGrid1.Text
Set adoRs = adoCon.Execute("select * from Worker where CardID ='" & sID & "'")
txtName.Text = adoRs!Name
cobCard.Text = adoRs!CardID
txtMiMa.Text = adoRs!Password
cobBuMen.Text = adoRs!BuMen
cobPermit.Text = adoRs!Permit
End Sub



Private Sub comQuit_Click()
Unload Me
End Sub

Private Sub Data_Click()
 On Error GoTo ErrMsg
  If AdoFind.Recordset.EOF And AdoFind.Recordset.BOF Then
     MsgBox "您没有选种记录！", vbOKOnly + vbExclamation, "修改提示"
     Exit Sub
  End If
  Data.Col = 0
  sID = Trim(Data.Text)
  Set adoRs = adoCon.Execute("select * from Worker where CardID='" & Trim(sID) & "'")
  cobCard.Text = adoRs!CardID
  txtName.Text = adoRs!Name
  sCard = adoRs!CardID
   cobBuMen.Text = adoRs!BuMen
  SName = adoRs!Name
ErrMsg:
  If Err.Number <> 0 Then
     Exit Sub
  End If
 End Sub


Private Sub Data_DblClick()
   Exit Sub
End Sub

Private Sub Form_Load()
  If lNum = 0 Then
    cmdModfiy.Enabled = False
    cmdOk.Enabled = False
    cmdBuMenAdd.Enabled = False
    cmdBuMenDel.Enabled = False
    cmdUpdate.Enabled = False
    cmdDelete.Enabled = False
    End If
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 1000
Call FindRef
Call SetNew
SSTab1.Tab = 0
End Sub

Private Sub OptBuMen_Click()
Dim SQL As String
SQL = "select CardID as 卡号,"
SQL = SQL + "Name as 姓名,"
SQL = SQL + "BuMen as 部门 from Worker "
AdoFind.ConnectionString = RtnStr
AdoFind.RecordSource = SQL + " order by BuMen"
AdoFind.Refresh
End Sub

Private Sub OptCard_Click()
Dim SQL As String
SQL = "select CardID as 卡号,"
SQL = SQL + "Name as 姓名,"
SQL = SQL + "BuMen as 部门 from Worker "
AdoFind.ConnectionString = RtnStr
AdoFind.RecordSource = SQL + " order by CardID"
AdoFind.Refresh
End Sub

Private Sub OptName_Click()
Dim SQL As String
SQL = "select CardID as 卡号,"
SQL = SQL + "Name as 姓名,"
SQL = SQL + "BuMen as 部门 from Worker "
AdoFind.ConnectionString = RtnStr
AdoFind.RecordSource = SQL + " order by Name"
AdoFind.Refresh
End Sub