frmaddcustom.frm

是关于SQL的一些程序 很好很经典的~大家又兴趣的可以学习下

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmAddCustom 
   Caption         =   "添加客户信息"
   ClientHeight    =   5550
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6915
   LinkTopic       =   "Form1"
   ScaleHeight     =   5550
   ScaleWidth      =   6915
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "上传复印件"
      Height          =   375
      Left            =   5040
      TabIndex        =   18
      Top             =   2160
      Width           =   1095
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   6120
      Top             =   2160
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSDataListLib.DataCombo cmbCardType 
      Bindings        =   "frmAddCustom.frx":0000
      Height          =   315
      Left            =   180
      TabIndex        =   17
      Top             =   1080
      Width           =   3075
      _ExtentX        =   5424
      _ExtentY        =   582
      _Version        =   393216
      ListField       =   "描述"
      Text            =   ""
      Object.DataMember      =   "CmdGetIDType"
   End
   Begin VB.PictureBox CardCopy 
      Height          =   2775
      Left            =   3720
      ScaleHeight     =   2715
      ScaleWidth      =   3015
      TabIndex        =   16
      Top             =   2700
      Width           =   3075
   End
   Begin VB.TextBox txtRemark 
      Height          =   1755
      Left            =   120
      TabIndex        =   14
      Top             =   3660
      Width           =   3135
   End
   Begin VB.TextBox txtContact 
      Height          =   555
      Left            =   120
      TabIndex        =   12
      Top             =   2640
      Width           =   3075
   End
   Begin VB.TextBox txtNative 
      Height          =   435
      Left            =   1260
      TabIndex        =   10
      Top             =   1740
      Width           =   1935
   End
   Begin VB.Frame Frame2 
      Caption         =   "性别"
      Height          =   615
      Left            =   3720
      TabIndex        =   6
      Top             =   1380
      Width           =   2655
      Begin VB.OptionButton optM 
         Caption         =   "男"
         Height          =   255
         Left            =   180
         TabIndex        =   8
         Top             =   240
         Value           =   -1  'True
         Width           =   615
      End
      Begin VB.OptionButton optF 
         Caption         =   "女"
         Height          =   255
         Left            =   1440
         TabIndex        =   7
         Top             =   240
         Width           =   675
      End
   End
   Begin VB.TextBox txtName 
      Height          =   375
      Left            =   4740
      TabIndex        =   5
      Text            =   "孙玲"
      Top             =   840
      Width           =   1575
   End
   Begin VB.CommandButton cmdAppend 
      Caption         =   "添加"
      Height          =   435
      Left            =   3660
      TabIndex        =   3
      Top             =   180
      Width           =   1035
   End
   Begin VB.TextBox txtCardID 
      Height          =   375
      Left            =   1260
      TabIndex        =   1
      Top             =   180
      Width           =   1995
   End
   Begin VB.Label Label7 
      Caption         =   "证件复印件:"
      Height          =   315
      Left            =   3720
      TabIndex        =   15
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Label Label6 
      Caption         =   "备注信息:"
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   3300
      Width           =   975
   End
   Begin VB.Label Label5 
      Caption         =   "联系方法:"
      Height          =   255
      Left            =   120
      TabIndex        =   11
      Top             =   2280
      Width           =   1035
   End
   Begin VB.Label Label4 
      Caption         =   "来源地区:"
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   1800
      Width           =   915
   End
   Begin VB.Label Label3 
      Caption         =   "姓名:"
      Height          =   315
      Left            =   3840
      TabIndex        =   4
      Top             =   900
      Width           =   555
   End
   Begin VB.Label Label2 
      Caption         =   "证件类型:"
      Height          =   255
      Left            =   180
      TabIndex        =   2
      Top             =   660
      Width           =   1035
   End
   Begin VB.Label Label1 
      Caption         =   "证件编号:"
      Height          =   255
      Left            =   180
      TabIndex        =   0
      Top             =   240
      Width           =   915
   End
End
Attribute VB_Name = "frmAddCustom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strCnn As String
Dim cnn As New Connection
Dim rss As ADODB.Recordset
Dim mstream As ADODB.Stream     ' 方便存取SQL Server中的BLOB字段
                                        ' 必须先引用ActiveX Data Objects (ADO) 2.5
Public CardId As String         ' 证件编号
Private strFileName As String       ' 证件复印图像文件


Private Sub cmdAppend_Click() '添加客户
        ' Validate()
        AppendCustom
        Reset
End Sub
' 初始界面数据
Private Sub InitForm()
        If CardId <> "" Then
                txtCardID.Text = CardId
        End If
End Sub

Private Sub AppendCustom() '添加客户子函数

        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset

        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_AddCustom"
        
        Set mstream = New ADODB.Stream
        mstream.Type = adTypeBinary
        mstream.Open
        mstream.LoadFromFile strFileName
                
        cmd.Parameters.Append cmd.CreateParameter("@id", adChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@cardDes", adVarChar, adParamInput, 100)
        cmd.Parameters.Append cmd.CreateParameter("@name", adVarChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@sex", adChar, adParamInput, 2)
        cmd.Parameters.Append cmd.CreateParameter("@native", adVarChar, adParamInput, 250)
        cmd.Parameters.Append cmd.CreateParameter("@address", adVarChar, adParamInput, 250)
        cmd.Parameters.Append cmd.CreateParameter("@cardCopy", adBinary, adParamInput, -1)
        cmd.Parameters.Append cmd.CreateParameter("@remark", adVarChar, adParamInput, 250)
        
        cmd.Parameters("@id").Value = txtCardID.Text
        cmd.Parameters("@cardDes").Value = CmbCardType.Text
        cmd.Parameters("@name").Value = txtName.Text
        If OptM.Value = True Then
                cmd.Parameters("@sex").Value = "男"
        Else
                cmd.Parameters("@sex").Value = "女"
        End If

        cmd.Parameters("@native").Value = txtNative.Text
        cmd.Parameters("@address").Value = txtContact.Text
        If strFileName <> "" Or strFileName <> Null Then
                cmd.Parameters("@cardCopy").Value = mstream.Read
        Else
                cmd.Parameters("@cardCopy").Value = Nothing
        End If

        cmd.Parameters("@remark").Value = txtRemark.Text
        cmd.Execute
        MsgBox "添加成功"
        Exit Sub
errHandle:
        MsgBox Err.Description

End Sub

Private Sub Command1_Click()  '上传复印件
        CommonDialog1.Filter = "位图图像(*.bmp)|*.bmp|其它图片(*.*)|*.*"
        CommonDialog1.ShowOpen
        strFileName = CommonDialog1.FileName
        CardCopy.Picture = LoadPicture(strFileName)

End Sub

Private Sub Form_Load()
        strCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;User ID=sa;Initial Catalog=酒店客房管理系统;Data Source=127.0.0.1"
        cnn.Open strCnn
        InitForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
        cnn.Close
        Set cnn = Nothing

End Sub


Private Sub Reset() '清空
        txtCardID.Text = ""
        CmbCardType.Text = ""
        txtName.Text = ""
        txtNative.Text = ""
        txtContact.Text = ""
        txtRemark.Text = ""
        CardCopy.Picture = Nothing

End Sub