employee.frm

数据库sql200和vb在一起的数据库查询代码呵工程

      End
      Begin VB.Label Label9 
         Alignment       =   1  'Right Justify
         Caption         =   "City:"
         Height          =   255
         Left            =   0
         TabIndex        =   11
         Top             =   675
         Width           =   1335
      End
      Begin VB.Label Label14 
         Caption         =   "Region:"
         Height          =   255
         Left            =   3360
         TabIndex        =   10
         Top             =   675
         Width           =   855
      End
   End
   Begin MSComctlLib.TabStrip TabStrip1 
      Height          =   3735
      Left            =   120
      TabIndex        =   34
      Top             =   600
      Width           =   6495
      _ExtentX        =   11456
      _ExtentY        =   6588
      MultiRow        =   -1  'True
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   2
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Company Info"
            Object.ToolTipText     =   "Company Information"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Personal Info"
            Object.ToolTipText     =   "Personal Information"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.Label lblName 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1628
      TabIndex        =   40
      Top             =   120
      Width           =   3495
   End
End
Attribute VB_Name = "Employee"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Employee Code Sample
' Microsoft Corporation
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Private Sub Form_Load()
    On Error GoTo ErrHandler:
    
    Dim UserName As String
    Dim Password As String
    Dim ServerName As String
    Dim DBName As String
    
    UserName = ""
    Password = ""
    ServerName = ""
    DBName = "Northwind"
    
    ' Set connection properties.
    cn.ConnectionTimeout = 25                                       ' Set the time out.
    cn.Provider = "sqloledb"                                        ' Specify the OLE DB provider.
    cn.Properties("Data Source").Value = ServerName                 ' Set SQLOLEDB connection properties.
    cn.Properties("Initial Catalog").Value = DBName                 ' Set SQLOLEDB connection properties.
    cn.Properties("Integrated Security").Value = "SSPI"             ' Set SQLOLEDB connection properties.
    
    ' Change mousepointer while trying to open database.
    Screen.MousePointer = vbHourglass
    
    ' Open the database.
    cn.Open
                      
    ' Open the Recordset.
    Set rs = New ADODB.Recordset
    rs.Open "select * from Employees", cn, adOpenKeyset, adLockPessimistic
    
    ' Move to the first record and display the data.
    rs.MoveFirst
    FillDataFields
    
    ' Change mousepointer back to the default after open.
    Screen.MousePointer = vbDefault
    
    Exit Sub
   
ErrHandler:
    ' Change mousepointer back to the default after open.
    Screen.MousePointer = vbDefault
    
    ' Display the error message.
    MsgBox Err.Description, , "Error "
    
    ' End the program.
    End
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If rs.State = adStateOpen Then
        rs.Close
    End If
    
    If cn.State = adStateOpen Then
      cn.Close
    End If
    End
End Sub


Private Function FillDataFields()
    On Error GoTo ErrHandler:
    
    Dim fld As ADODB.Field
    Dim byteChunk() As Byte
    Dim strNote As String
    Dim Offset As Long
    Dim Totalsize As Long
    Dim Remainder As Long
    Dim NumOfChuncks As Long
    Dim CurrentRecPos As Long
    Dim FieldSize As Long
    Dim FileNumber As Integer
    Const HeaderSize As Long = 78
    Const ChunkSize As Long = 100
    Const TempFile As String = "tempfile.tmp"
                    
    ' Initialize fields.
    txtEID.Text = ""
    txtLastName.Text = ""
    txtFirstName.Text = ""
    txtTitle.Text = ""
    txtCTitle.Text = ""
    txtBirthDate.Text = ""
    txtHireDate.Text = ""
    txtAddress.Text = ""
    txtCity.Text = ""
    txtRegion.Text = ""
    txtZipCode.Text = ""
    txtCountry.Text = ""
    txtHomePhone.Text = ""
    txtExtension.Text = ""
    txtNotes.Text = ""
    txtReportsTo.Text = ""
    Image1.Picture = Nothing
    
    ' Initialize employee name and record position.
    lblName.Caption = ""
    txtRecCnt = ""
              
    Set Flds = rs.Fields
    
    ' Display record position.
    txtRecCnt = Str(rs.AbsolutePosition) + " of " + Str(rs.RecordCount)
      
    ' Assign the CurrentRecPos value.
    CurrentRecPos = rs.AbsolutePosition
                     
    ' Display the employee data.
    For Each fld In Flds
        FieldSize = fld.ActualSize
        If FieldSize > 0 Then                                 ' Rule out the none possibility.
            Select Case fld.Name
                Case "EmployeeID"
                    txtEID.Text = Str(fld.Value)
                Case "LastName"
                    txtLastName.Text = fld.Value
                Case "FirstName"
                    txtFirstName.Text = fld.Value
                Case "Title"
                    txtTitle.Text = fld.Value
                Case "TitleOfCourtesy"
                    txtCTitle.Text = fld.Value
                Case "BirthDate"
                    txtBirthDate.Text = Str(fld.Value)
                Case "HireDate"
                    txtHireDate.Text = Str(fld.Value)
                Case "Address"
                    txtAddress.Text = fld.Value
                Case "City"
                    txtCity.Text = fld.Value
                Case "Region"
                    txtRegion.Text = fld.Value
                Case "PostalCode"
                    txtZipCode.Text = fld.Value
                Case "Country"
                    txtCountry.Text = fld.Value
                Case "HomePhone"
                    txtHomePhone.Text = fld.Value
                Case "Extension"
                    txtExtension.Text = fld.Value
                Case "Photo"
                    FileNumber = FreeFile
                    Open TempFile For Binary Access Write As FileNumber
                    Totalsize = FieldSize - HeaderSize          ' Substract it from the total size.
                    byteChunk() = fld.GetChunk(HeaderSize)      ' Get rid of the header.
                    NumOfChuncks = Totalsize \ ChunkSize
                    Remainder = Totalsize Mod ChunkSize
                    If Remainder > 0 Then
                        byteChunk() = fld.GetChunk(Remainder)
                        Put FileNumber, , byteChunk()
                    End If
                    Offset = Remainder
                    Do While Offset < Totalsize
                        byteChunk() = fld.GetChunk(ChunkSize)
                        Put FileNumber, , byteChunk()
                        Offset = Offset + ChunkSize
                    Loop
                    Close FileNumber
                    Image1.Picture = LoadPicture(TempFile)
                    Kill (TempFile)
                Case "Notes"
                    Totalsize = FieldSize / 2                   ' Becuase of being WChar
                    NumOfChuncks = Totalsize \ ChunkSize
                    Remainder = Totalsize Mod ChunkSize
                    If Remainder > 0 Then
                        strNote = fld.GetChunk(Remainder)
                    End If
                    Offset = Remainder
                    Do While Offset < Totalsize
                        strNote = strNote + fld.GetChunk(ChunkSize)
                        Offset = Offset + ChunkSize
                    Loop
                    txtNotes.Text = strNote
                Case "ReportsTo"
                    Dim FindString As String
                    FindString = "EmployeeID = " + Str(fld.Value)
                    rs.MoveFirst                                    ' Move to the first record to ensure a search for the whole records.
                    rs.Find FindString, 1, adSearchForward          ' Search for the whole records.
                    If rs.EOF = False Then                          ' Did find the match.
                        txtReportsTo.Text = rs!firstname + " " + rs!LastName
                    End If
                    rs.Move (CurrentRecPos - rs.AbsolutePosition)   ' Move back to the record before the search.
            End Select
        End If
    Next
    
    ' Display employee name.
    lblName.Caption = txtFirstName.Text + "  " + txtLastName.Text
    
    Exit Function
    
ErrHandler:
    MsgBox Err.Description, , "Error "
    
End Function


Private Sub TabStrip1_Click()
    Picture1(TabStrip1.SelectedItem.Index - 1).ZOrder 0
End Sub


Private Sub btnFirst_Click()
    If rs.BOF = False Then
        rs.MoveFirst
    End If
    If rs.BOF = False Then
        FillDataFields
    End If
End Sub

Private Sub btnPrevious_Click()
    If rs.BOF = False Then
        If rs.EOF = True Then
             rs.MoveLast
        End If
        rs.MovePrevious
    End If
    If rs.BOF = False Then
        FillDataFields
    End If
End Sub

Private Sub btnNext_Click()
    If rs.EOF = False Then
        If rs.BOF = True Then
             rs.MoveFirst
        End If
        rs.MoveNext
    End If
    If rs.EOF = False Then
        FillDataFields
    End If
End Sub

Private Sub btnLast_Click()
    If rs.EOF = False Then
        rs.MoveLast
    End If
    If rs.EOF = False Then
        FillDataFields
    End If
End Sub