frmadditem.frm

地方税务局税控开票系统

        
    Set recItem = New ADODB.Recordset
    StrSQL = "insert into " + gsconTabel + "estatecheque (estatecode,itemname,buildunit,workaddress, " + _
            "username,datestart,dateend,buildarea,totalvalue,buildnote,totalmoney,unitname,unitcode) values ('" + _
            Trim(txtEstate(0).Text) + "','" + Trim(txtEstate(1).Text) + "','" + _
            Trim(txtEstate(2).Text) + "','" + Trim(txtEstate(3).Text) + "','" + _
            Trim(txtEstate(4).Text) + "','" + Trim(txtEstate(5).Text) + _
            "','" + Trim(txtEstate(6).Text) + "','" + Trim(txtEstate(7).Text) + _
            "','" + Trim(txtEstate(8).Text) + "','" + Trim(txtEstate(9).Text) + _
            "','" + sEncry + "','" + gsUnitCode + "-" + gsUnitName + "','" + gsUnitCode + "')"
    
    gConn.Execute (StrSQL)
    Exit Sub
err:
    MsgBox "添加项目失败，再重新添加！", vbOKOnly + vbInformation, "提示信息"
End Sub

'更新不动产信息
Private Sub UpdateEstate()
On Error GoTo err
    Dim StrSQL As String
    
    Dim sWhere As String
    
    If gbAddItem = True Then
        sWhere = " itemname ='" + txtEstate(1).Text + _
                  "' and (estatecode is null or estatecode ='')"
    Else
        sWhere = " estatecode ='" + txtEstate(0).Text + "'"
     End If
    
    Set recItem = New ADODB.Recordset
    StrSQL = "update " + gsconTabel + "estatecheque set " + _
                                      "buildunit ='" + Trim(txtEstate(2).Text) + "'," + _
                                      "username = '" + Trim(txtEstate(4).Text) + "'," + _
                                      "workaddress ='" + Trim(txtEstate(3).Text) + "'," + _
                                      "datestart = '" + Trim(txtEstate(5).Text) + "'," + _
                                      "dateend ='" + Trim(txtEstate(6).Text) + "'," + _
                                      "buildarea ='" + Trim(txtEstate(7).Text) + "'," + _
                                      "totalvalue ='" + Trim(txtEstate(8).Text) + "'," + _
                                      "buildnote = '" + Trim(txtEstate(9).Text) + _
                                      "' where " + sWhere
    
    gConn.Execute (StrSQL)
    Exit Sub
err:

    MsgBox "修改项目失败，请确认！", vbOKOnly + vbInformation, "提示信息"
End Sub

'添加建筑项目信息
Private Sub AddBuildInfo()
    Dim iNum As Integer
    
    If Trim(txtName.Text) = "" Then
        MsgBox "请先输入项目名称！", vbOKOnly + vbInformation, "提示信息"
        txtName.SetFocus
        Exit Sub
    End If
    
    
    
    If gsEditStatus = "A" Then
        If bCheckName = False Then Exit Sub         '''检查是否有相同的项目名称
        
        iNum = MsgBox("是否要建立项目'" + Trim(txtName.Text) + "'？", vbYesNo + vbInformation, "提示信息")
        If iNum = vbNo Then Exit Sub
        
        SaveItem                                    '''保存新添加的项目
        
        MsgBox "您的项目信息已经建立，请确认", vbOKOnly + vbInformation, "提示信息"
    Else
        iNum = MsgBox("是否要修改项目'" + Trim(txtName.Text) + "'的信息？", vbYesNo + vbInformation, "提示信息")
        If iNum = vbNo Then Exit Sub
        UpdateItem
        
        MsgBox "您的项目信息已经修改成功，请确认", vbOKOnly + vbInformation, "提示信息"
    End If
    
    mbChangeFlag = False
    mbUpdate = True
    
End Sub

'获取0的加密字符串
Private Function sGetEncry() As String
    Dim oEncry As encrypt
    Dim sStr As String
    Dim sErr As String
    
    Set oEncry = New encrypt
    sStr = oEncry.encrypt_str("0", "12345678", sErr)
    If sErr <> "" Then Exit Function
    
    sGetEncry = sStr
End Function

'保存新添加的项目
Private Sub SaveItem()
On Error GoTo err
    Dim StrSQL As String
    Dim sEncry As String
    Dim sMsg As String
    Dim sItemCode As String
    
    sMsg = "添加项目失败，再重新添加！"
    sEncry = sGetEncry                                      '''获取0的加密字符串
    If sEncry = "" Then
        MsgBox sMsg, vbOKOnly + vbInformation, "提示信息"
        Exit Sub
    End If
    
    sItemCode = Trim(txtName.Text) + Format(Now, "yyyymmddhhmmss")
    
    Set recItem = New ADODB.Recordset
    StrSQL = "insert into " + gsconTabel + "buildcheque (itemcode,itemname,buildunit,undertake, " + _
            "workaddress,datestart,dateend,buildarea,totalvalue,buildnote,totalmoney,unitname,unitcode) values ('" + _
            sItemCode + "','" + Trim(txtName.Text) + "','" + txtBuild.Text + "','" + _
            txtUndertake.Text + "','" + txtAddress.Text + "','" + txtDateStart.Text + _
            "','" + txtDateEnd.Text + "','" + txtArea.Text + "','" + txtValue.Text + "','" + _
            txtNote.Text + "','" + sEncry + "','" + gsUnitCode + "-" + gsUnitName + "','" + gsUnitCode + "')"
    
    gConn.Execute (StrSQL)
    Exit Sub
err:
    MsgBox sMsg, vbOKOnly + vbInformation, "提示信息"
End Sub

'修改项目
Private Sub UpdateItem()
On Error GoTo err
    Dim StrSQL As String
    
    Set recItem = New ADODB.Recordset
    StrSQL = "update " + gsconTabel + "buildcheque set " + _
                                      "itemname ='" + Trim(txtName.Text) + "'," + _
                                      "buildunit ='" + Trim(txtBuild.Text) + "'," + _
                                      "undertake = '" + Trim(txtUndertake.Text) + "'," + _
                                      "workaddress ='" + Trim(txtAddress.Text) + "'," + _
                                      "datestart = '" + Trim(txtDateStart.Text) + "'," + _
                                      "dateend ='" + Trim(txtDateEnd.Text) + "'," + _
                                      "buildarea ='" + Trim(txtArea.Text) + "'," + _
                                      "totalvalue ='" + Trim(txtValue.Text) + "'," + _
                                      "buildnote = '" + Trim(txtNote.Text) + _
                                      "' where itemcode ='" + gsCode + "'"
    
    gConn.Execute (StrSQL)
    Exit Sub
err:

    MsgBox "修改项目失败，请确认！", vbOKOnly + vbInformation, "提示信息"
End Sub


'检查是否有相同的项目名称
Private Function bCheckName() As Boolean
On Error GoTo err
    Dim StrSQL As String
    Dim recCheck As ADODB.Recordset
    
    bCheckName = False
    Set recCheck = New ADODB.Recordset
    StrSQL = "select * from " + gsconTabel + "buildcheque where itemname ='" + Trim(txtName.Text) + "'"
    If recCheck.State = 1 Then recCheck.Close
    recCheck.CursorLocation = adUseClient
    recCheck.Open StrSQL, gConn, adOpenStatic, adLockBatchOptimistic
    
    If recCheck.RecordCount = 1 Then
        MsgBox "所要添加的项目名称已存在，请确认", vbOKOnly + vbInformation, "提示信息"
        Exit Function
    End If
    
    bCheckName = True
    Exit Function
err:
    MsgBox "不能添加的项目代码，请确认", vbOKOnly + vbInformation, "提示信息"
End Function


'初始化窗体
Private Sub Form_Load()
    
    If gsChequeType = "B" Then
        fra1.Visible = False
        fra3.Visible = False
        If gsEditStatus = "E" Then
            frmAddItem.Caption = "修改信息"
            
            EditItem                            '''修改项目时
'            txtName.Enabled = False
'            txtName.BackColor = &H80000004
            mbChangeFlag = False
        Else
            txtUndertake.Text = gsUnitName
        End If
        
'        txtUndertake.Text = gsUnitName
'        txtUndertake.BackColor = &H80000004
    ElseIf gsChequeType = "E" Then
        fra2.Visible = False
        fra3.Visible = False
        
        If gsEditStatus = "E" Then
            frmAddItem.Caption = "修改信息"
            txtEstate(0).Enabled = False
            txtEstate(0).BackColor = &H80000004
            txtEstate(1).Enabled = False
            txtEstate(1).BackColor = &H80000004
            
            EditEstate
        End If
        
        If gbAddItem = True Then
            txtEstate(0).Enabled = False
            txtEstate(0).BackColor = &H80000004
        ElseIf gbAddItem = False And gsEditStatus = "A" Then
            EditEstate                            '''在不动产中添加用户信息时，获取不动产的项目信息
            txtEstate(1).Enabled = False
            txtEstate(1).BackColor = &H80000004
        End If
        
        txtEstate(2).Text = gsUnitName
       
    Else
        fra1.Visible = False
        fra2.Visible = False
        fra3.Visible = True
        
        frmAddItem.Caption = "添加信息"
        If gsEditStatus = "E" Then
            frmAddItem.Caption = "修改信息"
            txtCommon(0).Enabled = False
            txtCommon(0).BackColor = &H80000004
            
            EditCommon
        End If
        
        If gbAddItem = True Then
            txtCommon(1).Enabled = False
            txtCommon(1).BackColor = &H80000004
            txtCommon(2).Enabled = False
            txtCommon(2).BackColor = &H80000004
            txtCommon(3).Enabled = False
            txtCommon(3).BackColor = &H80000004
        ElseIf gbAddItem = False And gsEditStatus = "A" Then
            txtCommon(0).Enabled = False
            txtCommon(0).BackColor = &H80000004
'            txtCommon(2).Enabled = False
'            txtCommon(2).BackColor = &H80000004
            EditCommon              '''在不动产中添加用户信息时，获取不动产的项目信息
        End If
        
    End If
    
End Sub

'修改不动产信息时
Private Sub EditCommon()
    Dim StrSQL As String
    Dim recEdit As ADODB.Recordset
    
    Set recEdit = New ADODB.Recordset
    If gsEditStatus = "E" And gbAddItem = False Then
        StrSQL = "select * from " + gsconTabel + "commoncheque where itemname ='" + gsCode + "'"
    Else
        StrSQL = "select * from " + gsconTabel + "commoncheque where receiveunit ='" + gsCode + "'"
    End If
    
    If recEdit.State = 1 Then recEdit.Close
    recEdit.CursorLocation = adUseClient
    recEdit.Open StrSQL, gConn, adOpenStatic, adLockBatchOptimistic
    
    If recEdit.RecordCount < 1 Then Exit Sub
    txtCommon(0).Text = IIf(IsNull(recEdit.Fields("receiveunit")), "", recEdit.Fields("receiveunit"))
    txtCommon(1).Text = IIf(IsNull(recEdit.Fields("outunit")), "", recEdit.Fields("outunit"))
    txtCommon(2).Text = IIf(IsNull(recEdit.Fields("itemname")), "", recEdit.Fields("itemname"))
    txtCommon(3).Text = IIf(IsNull(recEdit.Fields("workaddress")), "", recEdit.Fields("workaddress"))
    
End Sub

'初始化界面
Private Sub Init()
    If gbAddItem = True Then
            
    Else
        
    End If
End Sub

'修改不动产信息时
Private Sub EditEstate()
    Dim StrSQL As String
    Dim recEdit As ADODB.Recordset
    
    Set recEdit = New ADODB.Recordset
    
    If gbAddItem = True Or gsEditStatus = "A" Then
        StrSQL = "select * from " + gsconTabel + "estatecheque where itemname ='" + gsCode + "' and (estatecode is null or estatecode ='')"
    Else
        StrSQL = "select * from " + gsconTabel + "estatecheque where estatecode ='" + gsCode + "'"
    End If

    If recEdit.State = 1 Then recEdit.Close
    recEdit.CursorLocation = adUseClient
    recEdit.Open StrSQL, gConn, adOpenStatic, adLockBatchOptimistic
    
    If recEdit.RecordCount < 1 Then Exit Sub
    txtEstate(0).Text = IIf(IsNull(recEdit.Fields("estatecode")), "", recEdit.Fields("estatecode"))
    txtEstate(1).Text = IIf(IsNull(recEdit.Fields("itemname")), "", recEdit.Fields("itemname"))
    txtEstate(2).Text = IIf(IsNull(recEdit.Fields("buildunit")), "", recEdit.Fields("buildunit"))
    txtEstate(3).Text = IIf(IsNull(recEdit.Fields("workaddress")), "", recEdit.Fields("workaddress"))
    txtEstate(4).Text = IIf(IsNull(recEdit.Fields("username")), "", recEdit.Fields("username"))
    txtEstate(5).Text = IIf(IsNull(recEdit.Fields("datestart")), "", recEdit.Fields("datestart"))
    txtEstate(6).Text = IIf(IsNull(recEdit.Fields("dateend")), "", recEdit.Fields("dateend"))
    txtEstate(7).Text = IIf(IsNull(recEdit.Fields("buildarea")), "", recEdit.Fields("buildarea"))
    txtEstate(8).Text = IIf(IsNull(recEdit.Fields("totalvalue")), "", recEdit.Fields("totalvalue"))
    txtEstate(9).Text = IIf(IsNull(recEdit.Fields("buildnote")), "", recEdit.Fields("buildnote"))

End Sub

'修改项目时
Private Sub EditItem()
    Dim StrSQL As String
    Dim recEdit As ADODB.Recordset
    
    Set recEdit = New ADODB.Recordset
    StrSQL = "select * from " + gsconTabel + "buildcheque where itemcode ='" + gsCode + "'"
    If recEdit.State = 1 Then recEdit.Close
    recEdit.CursorLocation = adUseClient
    recEdit.Open StrSQL, gConn, adOpenStatic, adLockBatchOptimistic
    
    If recEdit.RecordCount < 1 Then Exit Sub
'    txtCode.Text = IIf(IsNull(recEdit.Fields("itemcode")), "", recEdit.Fields("itemcode"))
    txtName.Text = IIf(IsNull(recEdit.Fields("itemname")), "", recEdit.Fields("itemname"))
    txtBuild.Text = IIf(IsNull(recEdit.Fields("buildunit")), "", recEdit.Fields("buildunit"))
    txtAddress.Text = IIf(IsNull(recEdit.Fields("workaddress")), "", recEdit.Fields("workaddress"))
    txtUndertake.Text = IIf(IsNull(recEdit.Fields("undertake")), "", recEdit.Fields("undertake"))
    txtDateStart.Text = IIf(IsNull(recEdit.Fields("datestart")), "", recEdit.Fields("datestart"))
    txtDateEnd.Text = IIf(IsNull(recEdit.Fields("dateend")), "", recEdit.Fields("dateend"))
    txtArea.Text = IIf(IsNull(recEdit.Fields("buildarea")), "", recEdit.Fields("buildarea"))
    txtValue.Text = IIf(IsNull(recEdit.Fields("totalvalue")), "", recEdit.Fields("totalvalue"))
    txtNote.Text = IIf(IsNull(recEdit.Fields("buildnote")), "", recEdit.Fields("buildnote"))
    
'    txtName.Enabled = False
'    txtCode.Enabled = False
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim iNum As Integer
    
    If gsEditStatus = "E" And mbChangeFlag = True Then
        iNum = MsgBox("您已经更改了数据，是否要退出？", _
                          vbYesNo + vbQuestion, "提示信息")
        If iNum = "7" Then
            Cancel = -1
        End If
    End If
End Sub


Private Sub txtAddress_Change()
    mbChangeFlag = True
End Sub

Private Sub txtArea_Change()
    mbChangeFlag = True
End Sub
    
Private Sub txtBuild_Change()
    mbChangeFlag = True
End Sub

Private Sub txtCode_Change()
    mbChangeFlag = True
End Sub

Private Sub txtDateEnd_Change()
    mbChangeFlag = True
End Sub

Private Sub txtDateStart_Change()
    mbChangeFlag = True
End Sub



Private Sub txtName_Change()
    mbChangeFlag = True
End Sub

Private Sub txtNote_Change()
    mbChangeFlag = True
End Sub

Private Sub txtUndertake_Change()
    mbChangeFlag = True
End Sub

Private Sub txtValue_Change()
    mbChangeFlag = True
End Sub