frmlen1.frm

本系统实现了对实验室设备的增删改查等基本的功能

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmlen1 
   BackColor       =   &H00FFC0C0&
   Caption         =   "设备归还"
   ClientHeight    =   2175
   ClientLeft      =   4125
   ClientTop       =   2340
   ClientWidth     =   4140
   Icon            =   "frmlen1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2175
   ScaleWidth      =   4140
   StartUpPosition =   1  '所有者中心
   Begin MSComCtl2.DTPicker DTPic 
      Height          =   375
      Left            =   1320
      TabIndex        =   3
      Top             =   840
      Width           =   2655
      _ExtentX        =   4683
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Format          =   67043329
      CurrentDate     =   39029
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00FFC0C0&
      Caption         =   "确定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1560
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   1560
      Width           =   1215
   End
   Begin VB.TextBox TxtID 
      BackColor       =   &H00FFFFC0&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1320
      TabIndex        =   1
      Top             =   240
      Width           =   2655
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FFC0C0&
      Caption         =   "归还日期"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   840
      Width           =   975
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFC0C0&
      Caption         =   "设备编号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   1095
   End
End
Attribute VB_Name = "frmlen1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click() '设备归还操作
    Dim rs As New ADODB.Recordset   '定义记录集，用于打开设备信息表
    Dim rs1 As New ADODB.Recordset  '定义记录集，用于打开外借信息表
    Dim rs2 As New ADODB.Recordset
    '打开设备信息表，同时进行判断，并将外借状态改为“否”
    rs.Open " select * from Equip_Info where Equip_ID='" & Trim(txtid.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
       If rs.RecordCount <= 0 Then
          MsgBox "设备编号输入有误，不存在该编号的设备"
          txtid.Text = ""
          Exit Sub
       Else
          rs2.Open " select * from Lend_Info where Equip_ID='" & Trim(txtid.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
             If rs2.RecordCount <= 0 Then
                MsgBox "没有该设备的借出信息，请重输设备编号"
                Exit Sub
             Else
    ' 打开外借信息表，将归还日期添加到外借信息表中
                rs1.Open "select * from Lend_Info where Equip_ID='" & Trim(txtid.Text) & "' and Return_Date is null", DBCnn, adOpenStatic, adLockOptimistic
                   If rs1.RecordCount <= 0 Then
                      MsgBox "该设备已归还，操作不成功"
                      Exit Sub
                   End If
                   If rs1.Fields("Lend_Date") > DTPic.Value Then  '判断归还时间是否早于借出时间
                      MsgBox "归还时间早于借出时间，操作不成功"
                      Exit Sub
                   Else
                       rs1.Fields("Return_Date") = DTPic.Value
                       rs1.Update
                       rs.Fields("Equip_Lend") = "否"
                       rs.Update
                       rs1.Close
                       rs.Close
                       MsgBox "归还操作成功"
                       '完成事务日志的填写
                       rslog.Open "select * from Log_Info where 操作员=''", DBCnn, adOpenStatic, adLockOptimistic
                       rslog.AddNew
                       rslog.Fields("操作员") = frmlog.txtuser.Text
                       rslog.Fields("日期") = Date
                       rslog.Fields("操作时间") = Time
                       rslog.Fields("操作模块") = "设备借还管理界面"
                       rslog.Fields("操作") = "设备归还"
                       rslog.Fields("备注") = "设备编号：" & txtid.Text
                       rslog.Update
                       rslog.Close
                  End If
            End If
       End If
End Sub