form1.frm

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

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Form1"
   ClientHeight    =   1860
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4965
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   1860
   ScaleWidth      =   4965
   StartUpPosition =   3  '窗口缺省
   Begin MSCommLib.MSComm MSComm1 
      Left            =   1440
      Top             =   1200
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      BaudRate        =   1200
      InputMode       =   1
   End
   Begin VB.Timer Timer1 
      Interval        =   60000
      Left            =   4320
      Top             =   480
   End
   Begin VB.CommandButton CEnd 
      Caption         =   "&Close"
      Height          =   255
      Left            =   960
      TabIndex        =   2
      Top             =   480
      Width           =   1095
   End
   Begin VB.CommandButton CAdd 
      Caption         =   "&Add"
      Height          =   255
      Left            =   960
      TabIndex        =   1
      Top             =   120
      Width           =   1095
   End
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      Height          =   540
      Left            =   120
      Picture         =   "Form1.frx":0442
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   0
      Top             =   120
      Width           =   540
   End
   Begin VB.Menu mMani 
      Caption         =   "&Caption"
      Begin VB.Menu mItem 
         Caption         =   "自动录入"
         Index           =   0
      End
      Begin VB.Menu mItem1 
         Caption         =   "手动录入"
         Index           =   0
      End
      Begin VB.Menu mItem2 
         Caption         =   "退出"
         Index           =   0
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'------------------------ By 陈锐 ------------------------------------
'如果你要在Internet或BBS上转贴程序,请通知我本人知道
'请参观我的网址 http://www.nease.net/~blackcat
'我的EMail是[e-mail]或[e-mail]
'
'这是一个将图标添加到WIN95的TaskBar的程序，同其他用VB编写的程序不同，这个
'程序可以相应鼠标事件，（其它的很多程序只能将一个图标放在TaskBar上）
Dim ssNum As Long
Dim SendByte(1 To 2) As Byte
Dim Recchar() As Byte
Dim Year_Now, cMonth, cDay, cHour, cMinute, cSecond, cCardID, cType As String
Dim InIT As Integer
Dim LastDay As Date
Dim J, Number, Num As Integer
Dim UpHour, DownHour, UpMinute, DownMinute, JiaBanTime, KuangQinTime As Integer

Private Sub CAdd_Click()
  Dim l As Long
  
  If (Icon_Add(Form2.hwnd, Picture1.Picture)) Then
    xb = CMenu()      '添加弹出菜单
    CAdd.Enabled = False
    Form1.Hide
    '将DialogProc函数设置为Form2的窗口处理函数并且保存原来窗口处理函数句柄
    lproc = SetWindowLong(Form2.hwnd, GWL_WNDPROC, AddressOf DialogProc)
  End If
End Sub

Private Sub CEnd_Click()
  End
End Sub

Private Sub Form_Load()
 Dim l As Long
 Dim SendCount(1 To 2) As Byte
Dim Buf As String
Call setConnect
  If (Icon_Add(Form2.hwnd, Picture1.Picture)) Then
    xb = CMenu()      '添加弹出菜单
    CAdd.Enabled = False
    Form1.Hide
    '将DialogProc函数设置为Form2的窗口处理函数并且保存原来窗口处理函数句柄
    lproc = SetWindowLong(Form2.hwnd, GWL_WNDPROC, AddressOf DialogProc)
  End If
ssNum = 0
If MSComm1.PortOpen = True Then

   MSComm1.PortOpen = False
End If
MSComm1.PortOpen = True

Set adoRs = adoCon.Execute("select * from Time where Type='Nom' ")
UpHour = adoRs!UpHour
UpMinute = adoRs!UpMin
DownHour = adoRs!DownHour
DownMinute = adoRs!DownMin
Year_Now = Mid(Date$, 1, 4)
Set adoRs = adoCon.Execute("select * from Time where Type='JiaBan' ")

JiaBanTime = (DownHour + adoRs!UpHour) * 60 + (DownMinute + adoRs!UpMin)

Set adoRs = adoCon.Execute("select * from Time where Type='KuangQin' ")

KuangQinTime = adoRs!UpHour * 60 + adoRs!UpMin

Timer1.Enabled = True


End Sub

Private Sub mItem_Click(Index As Integer)
Timer1.Enabled = True
End Sub

Private Sub mItem1_Click(Index As Integer)
Timer1.Enabled = False
End Sub

Private Sub mItem2_Click(Index As Integer)
  Dim l As Long
  If MsgBox("是否要退出系统？", vbYesNo, "系统提示") = vbYes Then
     l = Icon_Del(hwnd)
     l = SetWindowLong(Form2.hwnd, GWL_WNDPROC, lproc)

     End
  End If
End Sub
Private Sub INput_rec()
Dim Time As Long

Number = 0
aa = MSComm1.Input

Time = GetTickCount
SendByte(1) = 250
SendByte(2) = 185
Do While Number < 9
   MSComm1.Output = SendByte
   T = GetTickCount
   Do
     DoEvents
   Loop Until GetTickCount - T > 60
   Recchar = MSComm1.Input
 
   If UBound(Recchar) < 0 Then
    Number = Number + 1
   Else
   
       cType = "正常"
       For I = LBound(Recchar) To UBound(Recchar)
          SS = Hex(Recchar(I))
           
           If Len(SS) = 1 Then
              SS = "0" + SS
           End If
           Select Case I
           Case 0
              cCardID = SS
           Case 1
              cCardID = cCardID + SS
           Case 2
              cMonth = SS
           Case 3
              cMonth = cMonth + SS
           Case 4
              cHour = SS
           Case 5
              cMinute = SS
           Case 6
              cSecond = SS
           Case 7
           End Select
         
        Next I
       cCardID = CStr(Val(cCardID))
       If Left(cMonth, 1) = "8" Then
          cMonth = Year_Now + "-0" + Mid(cMonth, 2, 1) + "-" + Right(cMonth, 2)
       Else
          cMonth = Year_Now + "-1" + Mid(cMonth, 2, 1) + "-" + Right(cMonth, 2)
       End If
     
    '是否有效数据
       If cHour = "07" And cMinute = "F9" And cSecond = "FF" Then
       Else
    
          If cHour < 12 Then '上午
            Set adoRs = adoCon.Execute("exec Hour_proc '" & Trim(cCardID) & "' ,'" & Trim(cMonth) & "'")
            If adoRs.EOF Then
              If (Val(cHour) > UpHour) Or (Val(cHour) = UpHour And Val(cMinute) > UpMinute) Then
                 cType = "迟到"
                 If (Val(cHour) * 60 - UpHour * 60 + Val(cMinute) - UpMinute) > KuangQinTime Then
                   cType = "旷勤半天"
                 End If
              Else
                 cType = "正常"
              End If
           adoCon.Execute ("exec InsertKS_proc  '" & cCardID & "','" & cMonth & "','" & cHour & "','" & cMinute & "','" & cSecond & "','" & cType & "'")
           End If
          Else  '下午
               '早退
               If (Val(cHour) < DownHour) Or (Val(cHour) = DownHour And Val(cMinute)) < DownMinute Then
                  cType = "早退"
                 If ((DownHour) * 60 - Val(cHour) * 60 + (DownMinute) - Val(cMinute)) > KuangQinTime Then
                   cType = "旷勤半天"
                 End If
               Else
                   cType = "正常"
               '加班
                 If (Val(cHour) * 60 + Val(cMinute)) > Val(JiaBanTime) Then
                   cType = "加班"
                 End If
               End If
               adoCon.Execute ("delete KaoQinsource where Hour>'12' and CardID='" & Trim(cCardID) & "' and Date='" & Trim(cMonth) & "'")
               adoCon.Execute ("exec InsertKS_proc  '" & cCardID & "','" & cMonth & "','" & cHour & "','" & cMinute & "','" & cSecond & "','" & cType & "'")
          End If
       

   End If
   End If
Loop

'缺勤查询、请假、公休日

Call InPutKaoQin
End Sub
Private Sub Timer1_Timer()
Call INput_rec

ssNum = ssNum + 1
If (ssNum Mod 120) = 0 Then
Call INput_rec
ssNum = 0
End If
End Sub