frmdevicein.frm

网路设备资产管理系统

Private WithEvents mMSFlexGrid1 As cFlexGridBinder
Attribute mMSFlexGrid1.VB_VarHelpID = -1


Private Sub Form_Load()

ymdDjrq.Enabled = False

If mode = "add" Then

  ymdDjrq.FormatDate = CStr(Year(Now())) & "-" & CStr(Month(Now())) & "-" & CStr(Day(Now()))

  
  
ElseIf mode = "view" Then
  Toolbar1.Buttons(1).Enabled = False
  
  txtNetcenterId.Enabled = False
  txtPropertyId.Enabled = False
  txtSN.Enabled = False
  txtApplicant.Enabled = False
  txtTransactor.Enabled = False
  
  Set mrc = ExecuteSQL("select * from tbl_devicein where devicein_id = " & devicein_id, MsgText, HasError)
    
  If mrc.EOF = False Then
        txtNetcenterId = mrc.Fields("netcenter_id")
        txtPropertyId = mrc.Fields("property_id")
        txtModel = mrc.Fields("model_name")
        txtManufacturer = mrc.Fields("manufacturer_name")
        txtType = mrc.Fields("type_name")
        txtSN = mrc.Fields("sn")
        txtApplicant = mrc.Fields("applicant")
        txtTransactor = mrc.Fields("transactor")
        ymdDjrq.FormatDate = mrc.Fields("djrq")
  End If
  
End If



End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

    Select Case Button.key
        Case "保存"

If Trim(txtNetcenterId.Text) = "" Then
         MsgBox "必须输入中心编号!", vbOKOnly + vbExclamation, "警告"
        txtNetcenterId.SetFocus
        Exit Sub
End If

If Trim(txtModel.Text) = "" Or Trim(txtType.Text) = "" Or Trim(txtManufacturer.Text) = "" Then
         MsgBox "您输入的中心编号错误,或者该号不存在!", vbOKOnly + vbExclamation, "警告"
        txtSN.SetFocus
        Exit Sub
End If

If Trim(txtPropertyId.Text) = "" Then
         MsgBox "必须输入固定资产号!", vbOKOnly + vbExclamation, "警告"
        txtPropertyId.SetFocus
        Exit Sub
End If



If Trim(txtSN.Text) = "" Then
         MsgBox "必须输入SN号!", vbOKOnly + vbExclamation, "警告"
        txtSN.SetFocus
        Exit Sub
End If

If Trim(txtApplicant.Text) = "" Then
         MsgBox "必须输入申请人", vbOKOnly + vbExclamation, "警告"
        txtApplicant.SetFocus
        Exit Sub
End If

If Trim(txtTransactor.Text) = "" Then
         MsgBox "必须输入经办人", vbOKOnly + vbExclamation, "警告"
        txtTransactor.SetFocus
        Exit Sub
End If


'''''''''''''''''''''''''''''
  '下面开始保存记录
  On Error GoTo ErrorHandler
  BeginTrans
   
   '1 保存入库单
    Set mrc = ExecuteSQL("select top 1 devicein_id from tbl_devicein order by devicein_id desc", MsgText, HasError)
    
    If mrc.EOF = False Then
         oldid = Val(mrc.Fields("devicein_id"))
         oldid = oldid + 1
         snewid = Trim(str(oldid))
         If Len(snewid) = 1 Then snewid = "0000000" & snewid
         If Len(snewid) = 2 Then snewid = "000000" & snewid
         If Len(snewid) = 3 Then snewid = "00000" & snewid
         If Len(snewid) = 4 Then snewid = "0000" & snewid
         If Len(snewid) = 5 Then snewid = "000" & snewid
         If Len(snewid) = 6 Then snewid = "00" & snewid
         If Len(snewid) = 7 Then snewid = "0" & snewid
        newdevicein_id = snewid
    Else
        newdevicein_id = "00000001"
    End If
    
    txtSQL = "insert into tbl_devicein values('"
   txtSQL = txtSQL & newdevicein_id & "','"
   txtSQL = txtSQL & Trim(txtNetcenterId) & "','"
   txtSQL = txtSQL & Trim(txtPropertyId) & "','"
   txtSQL = txtSQL & Trim(txtModelId) & "','"
   txtSQL = txtSQL & Trim(txtManufacturerId) & "','"
   txtSQL = txtSQL & Trim(txtTypeId) & "','"
   txtSQL = txtSQL & Trim(txtSN) & "','"
   txtSQL = txtSQL & Trim(txtApplicant) & "','"
   txtSQL = txtSQL & Trim(txtTransactor) & "','"
   txtSQL = txtSQL & Trim(ymdDjrq.FormatDate) & "'"
   txtSQL = txtSQL & ")"
    
    Set mrc = ExecuteSQL(txtSQL, MsgText, HasError)
   
   '2 保存设备
   
    Set mrc = ExecuteSQL("select top 1 device_id from tbl_device order by device_id desc", MsgText, HasError)
    
    If mrc.EOF = False Then
        newdevice_id = mrc.Fields("device_id") + 1
    Else
        newdevice_id = 1
    End If
    
    txtSQL = "insert into tbl_device values('"
   txtSQL = txtSQL & newdevice_id & "','"
   txtSQL = txtSQL & Trim(txtNetcenterId) & "','"
   txtSQL = txtSQL & Trim(txtPropertyId) & "','"
   txtSQL = txtSQL & Trim(txtModelId) & "','"
   txtSQL = txtSQL & Trim(txtManufacturerId) & "','"
   txtSQL = txtSQL & Trim(txtTypeId) & "','"
   txtSQL = txtSQL & Trim(txtSN) & "','"
   txtSQL = txtSQL & "','','','"
   txtSQL = txtSQL & Trim("在库") & "'"
   txtSQL = txtSQL & ")"
    
    Set mrc = ExecuteSQL(txtSQL, MsgText, HasError)
    

   '3 保存设备日志
    Set mrc = ExecuteSQL("select top 1 log_id from tbl_device_log order by log_id desc", MsgText, HasError)
    
    If mrc.EOF = False Then
        newlog_id = mrc.Fields("log_id") + 1
    Else
        newlog_id = 1
    End If
    
    txtSQL = "insert into tbl_device_log values('"
   txtSQL = txtSQL & newlog_id & "','"
   txtSQL = txtSQL & Trim(newdevice_id) & "','"
   txtSQL = txtSQL & Trim("登记入库") & "','"
   txtSQL = txtSQL & Trim(txtApplicant) & "','"
   txtSQL = txtSQL & Trim(txtTransactor) & "','"
   txtSQL = txtSQL & Trim(ymdDjrq.FormatDate) & "'"
   txtSQL = txtSQL & ")"
    
    Set mrc = ExecuteSQL(txtSQL, MsgText, HasError)

  
  CommitTrans

ErrorHandler:

'Handle Error
If Err.Number <> 0 Or HasError Then
  RollbackTrans
  If vbOK = MsgBox("保存过程中发生错误，您是否要查看错误的详细信息？", vbOKCancel + vbExclamation + vbDefaultButton2, "警告") Then
     FrmError.error = Err.Description
     FrmError.sql = txtSQL
     FrmError.msg = MsgText
     FrmError.Show
  End If
Else
  
  FrmDeviceInList.Grid_Fill
  
  Unload Me
  
End If
'''''''''''''''''''''''''''''''''''''''
            
        Case "关闭"
          Unload Me
          
    End Select
    
End Sub

Private Sub txtNetcenterId_Change()

If mode = "view" Then
  Exit Sub
End If

  If Len(txtNetcenterId.Text) > 9 Then
    MsgBox "中心编码不能超过9位!", vbOKOnly + vbExclamation, "警告"
    Exit Sub
  ElseIf Len(txtNetcenterId.Text) < 9 Then
    Exit Sub
  End If
  
  
  
    Set mrc = ExecuteSQL("select * from tbl_device where netcenter_id = '" & Trim(txtNetcenterId.Text) & "'", MsgText, HasError)
    
    If mrc.EOF = False Then
        MsgBox "该中心编码的设备已经存在了!", vbOKOnly + vbExclamation, "警告"
        txtNetcenterId.Text = ""
        Exit Sub
    End If
    
    '到此为止中心编号经认证，还未入库，下面首先自动调出其厂商等属性
    txtTypeId = Mid$(txtNetcenterId, 1, 1)
    txtManufacturerId = Mid$(txtNetcenterId, 2, 2)
    txtModelId = Mid$(txtNetcenterId, 4, 2)
    
 
   For i = LBound(manufacturers, 2) To UBound(manufacturers, 2)
    If manufacturers(0, i) = txtManufacturerId Then
      txtManufacturer.Text = manufacturers(1, i)
      Exit For
    End If
   Next
   
   For i = LBound(models, 2) To UBound(models, 2)
    If models(0, i) = txtModelId Then
      txtModel.Text = models(1, i)
      Exit For
    End If
   Next
   
   For i = LBound(devicetypes, 2) To UBound(devicetypes, 2)
    If devicetypes(0, i) = txtTypeId Then
      txtType.Text = devicetypes(1, i)
      Exit For
    End If
   Next
    
    


  
End Sub

Private Sub txtNetcenterId_LostFocus()
  If Len(txtNetcenterId.Text) < 9 Then
    MsgBox "中心编码必须为9位!", vbOKOnly + vbExclamation, "警告"
    txtNetcenterId.Text = ""
    txtNetcenterId.SetFocus
    Exit Sub
  End If
End Sub