frmsystel.frm

VB税控的源代码 主要用于地方税务局的税控引用 有完整的控件和代码

VERSION 5.00
Begin VB.Form frmSystel 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "系统配置"
   ClientHeight    =   2790
   ClientLeft      =   45
   ClientTop       =   270
   ClientWidth     =   5625
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2790
   ScaleWidth      =   5625
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox txtBound 
      Height          =   300
      Left            =   1200
      MaxLength       =   25
      TabIndex        =   3
      ToolTipText     =   "4413932156"
      Top             =   930
      Width           =   4335
   End
   Begin VB.TextBox txtMail 
      Height          =   315
      Left            =   1200
      MaxLength       =   25
      TabIndex        =   8
      Top             =   2160
      Visible         =   0   'False
      Width           =   1815
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "退出(&C)"
      Height          =   405
      Left            =   4500
      TabIndex        =   10
      Top             =   2220
      Width           =   1065
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "更新(&O)"
      Default         =   -1  'True
      Height          =   405
      Left            =   3240
      TabIndex        =   9
      Top             =   2220
      Width           =   1065
   End
   Begin VB.TextBox txtFax 
      Height          =   315
      Left            =   4080
      MaxLength       =   25
      TabIndex        =   7
      Top             =   1740
      Width           =   1455
   End
   Begin VB.TextBox txtPhone 
      Height          =   315
      Left            =   1200
      MaxLength       =   25
      TabIndex        =   6
      Top             =   1740
      Width           =   1815
   End
   Begin VB.TextBox txtPower 
      Height          =   315
      Left            =   4080
      MaxLength       =   25
      TabIndex        =   5
      Top             =   1320
      Width           =   1455
   End
   Begin VB.TextBox txtCode 
      Height          =   315
      Left            =   1200
      MaxLength       =   25
      TabIndex        =   4
      Top             =   1320
      Width           =   1815
   End
   Begin VB.TextBox txtAddress 
      Height          =   315
      Left            =   1200
      MaxLength       =   50
      TabIndex        =   2
      Top             =   510
      Width           =   4335
   End
   Begin VB.TextBox txtName 
      Height          =   315
      Left            =   1200
      MaxLength       =   25
      TabIndex        =   1
      Top             =   120
      Width           =   4335
   End
   Begin VB.Label Label8 
      Caption         =   "税务登记号："
      Height          =   285
      Left            =   120
      TabIndex        =   17
      Top             =   960
      Width           =   1305
   End
   Begin VB.Label Label7 
      Caption         =   "企业编码："
      Height          =   345
      Left            =   120
      TabIndex        =   16
      Top             =   1380
      Width           =   1035
   End
   Begin VB.Label Label6 
      Caption         =   "电子邮箱："
      Height          =   255
      Left            =   120
      TabIndex        =   15
      Top             =   2250
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Label Label5 
      Caption         =   "传真："
      Height          =   225
      Left            =   3270
      TabIndex        =   14
      Top             =   1800
      Width           =   615
   End
   Begin VB.Label Label4 
      Caption         =   "电话号码："
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   1800
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "法人代表："
      Height          =   195
      Left            =   3120
      TabIndex        =   12
      Top             =   1380
      Width           =   915
   End
   Begin VB.Label Label2 
      Caption         =   "企业地址："
      Height          =   255
      Left            =   120
      TabIndex        =   11
      Top             =   570
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "企业名称："
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   180
      Width           =   975
   End
End
Attribute VB_Name = "frmSystel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private mbInsert As Boolean

Private Sub cmdCancel_Click()
    Unload Me
End Sub

'添加企业信息
Private Sub AddInfo()
    Dim StrSQL As String
    Dim recInfo As ADODB.Recordset
    
    Set recInfo = New ADODB.Recordset
    StrSQL = "select * from " + gsconTabel + "unitinfo"
    If recInfo.State = 1 Then recInfo.Close
    recInfo.CursorLocation = adUseClient
    recInfo.Open StrSQL, gConn, adOpenStatic, adLockOptimistic
    
    mbInsert = False
    If recInfo.RecordCount = 1 Then
        txtName.Text = IIf(IsNull(recInfo.Fields("unitname")), "", recInfo.Fields("unitname"))
        txtAddress.Text = IIf(IsNull(recInfo.Fields("unitaddress")), "", recInfo.Fields("unitaddress"))
        txtPower.Text = IIf(IsNull(recInfo.Fields("corporation")), "", recInfo.Fields("corporation"))
        txtCode.Text = IIf(IsNull(recInfo.Fields("unitcode")), "", recInfo.Fields("unitcode"))
        txtFax.Text = IIf(IsNull(recInfo.Fields("fax")), "", recInfo.Fields("fax"))
        txtMail.Text = IIf(IsNull(recInfo.Fields("mail")), "", recInfo.Fields("mail"))
        txtPhone.Text = IIf(IsNull(recInfo.Fields("unitphone")), "", recInfo.Fields("unitphone"))
        txtBound.Text = IIf(IsNull(recInfo.Fields("unitbound")), "", recInfo.Fields("unitbound"))
        
        txtName.Enabled = False
        txtName.BackColor = &H80000004
        txtCode.Enabled = False
        txtCode.BackColor = &H80000004
    Else
        mbInsert = True
    End If
    
End Sub

Private Sub cmdOK_Click()
On Error GoTo err
    Dim iNum As Integer
    Dim sMsg As String
    
    If bCheckData = False Then Exit Sub
    If mbInsert = True Then
        sMsg = "企业编码是企业的唯一的标识，您输入之后将不能更改，是否要进行系统初始化？"
    Else
        sMsg = "是否要对企业的信息进行更新?"
    End If
    
    If mbInsert = True Then
        If bSaveFileInfo("0") = False Then Exit Sub
    
    End If
    
    iNum = MsgBox(sMsg, vbYesNo + vbInformation, "提示信息")
    If iNum = 6 Then
        If bUpdateInfo = False Then
            Exit Sub
        End If
        SaveFileInfo                                   '''保存日期
        AddInfo
    End If
    
    MsgBox "已经成功更新了企业的信息,为了使用您的新信息请重新进入系统!", vbOKOnly + vbInformation, "提示信息"
    Exit Sub
err:
    MsgBox err.Description, vbOKOnly, "aaa"
End Sub

'保存日期
Private Function bSaveFileInfo(vsFileDate As String) As Boolean
    Dim oReg As CRigestry
    Dim sDate As String
    Dim oEncry As encrypt
    Dim sErr As String
    Dim bSave As Boolean
    
    Set oReg = New CRigestry
    Set oEncry = New encrypt
    
    bSaveFileInfo = False
    sDate = oEncry.encrypt_str("0", "12345678", sErr)
    If sErr <> "" Then Exit Function
    If oReg.SaveSetting("checkdate", "skey", sDate) = False Then Exit Function
    
    bSaveFileInfo = True
End Function

'检查数据的合法性
Private Function bCheckData() As Boolean
    bCheckData = False
    
    If Len(Trim(txtName.Text)) = 0 Then
        MsgBox "请先输入企业的名字！", vbOKOnly + vbInformation, "提示信息"
        txtName.SetFocus
        Exit Function
    End If
    
    If Len(Trim(txtCode.Text)) = 0 Then
        MsgBox "请先输入企业的编码！", vbOKOnly + vbInformation, "提示信息"
        txtCode.SetFocus
        Exit Function
    End If
    
    '''下面三个条件在通用发票中是不需要限制的
    If Len(Trim(txtAddress.Text)) = 0 Then
        MsgBox "请先输入企业的地址！", vbOKOnly + vbInformation, "提示信息"
        txtAddress.SetFocus
        Exit Function
    End If

    If Len(Trim(txtBound.Text)) = 0 Then
        MsgBox "请先输入企业的税务登记号！", vbOKOnly + vbInformation, "提示信息"
        txtBound.SetFocus
        Exit Function
    End If

    If Len(Trim(txtPhone.Text)) = 0 Then
        MsgBox "请先输入企业的电话号码！", vbOKOnly + vbInformation, "提示信息"
        txtPhone.SetFocus
        Exit Function
    End If

    bCheckData = True
End Function

'更新企业信息
Private Function bUpdateInfo() As Boolean
On Error GoTo err
    Dim StrSQL As String
    
    bUpdateInfo = False
    StrSQL = "delete from unitinfo"
    gConn.Execute (StrSQL)
    
    StrSQL = "insert into " + gsconTabel + "unitinfo (unitname,unitaddress,corporation,unitcode,fax,mail,unitphone,unitbound) " + _
                                      "values ('" + Trim(txtName.Text) + "'," + _
                                      "'" + Trim(txtAddress.Text) + "'," + _
                                      "'" + Trim(txtPower.Text) + "'," + _
                                      "'" + Trim(txtCode.Text) + "'," + _
                                      "'" + Trim(txtFax.Text) + "'," + _
                                      "'" + Trim(txtMail.Text) + "'," + _
                                      "'" + Trim(txtPhone.Text) + "'," + _
                                      "'" + Trim(txtBound.Text) + "')"
    gConn.Execute (StrSQL)
    
    bUpdateInfo = True
    Exit Function
err:

    MsgBox "更新企业信息失败,请确认!", vbOKOnly + vbInformation, "提示信息"
End Function

Private Sub Form_Load()
    AddInfo              '''添加企业信息
End Sub