frmhwbmquery.frm

用vb和SQLSERVER编译的关于数据库的源程序例子。

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmHwbmQuery 
   Caption         =   "货物查询"
   ClientHeight    =   4950
   ClientLeft      =   2115
   ClientTop       =   3510
   ClientWidth     =   8805
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4950
   ScaleWidth      =   8805
   Begin VB.CommandButton Command 
      Caption         =   "退出(&X)"
      Height          =   345
      Index           =   1
      Left            =   7500
      TabIndex        =   7
      Top             =   630
      Width           =   1125
   End
   Begin VB.CommandButton Command 
      Caption         =   "查询(&R)"
      Height          =   345
      Index           =   0
      Left            =   7500
      TabIndex        =   6
      Top             =   180
      Width           =   1125
   End
   Begin VB.Frame Frame 
      Caption         =   "查询条件"
      Height          =   1275
      Left            =   120
      TabIndex        =   1
      Top             =   90
      Width           =   7245
      Begin VB.TextBox Text 
         Height          =   330
         Index           =   1
         Left            =   1200
         TabIndex        =   5
         Top             =   720
         Width           =   2025
      End
      Begin VB.TextBox Text 
         Height          =   330
         Index           =   0
         Left            =   1200
         TabIndex        =   3
         Top             =   300
         Width           =   2025
      End
      Begin VB.Label Label 
         Caption         =   "货物名称:"
         Height          =   195
         Index           =   1
         Left            =   150
         TabIndex        =   4
         Top             =   780
         Width           =   825
      End
      Begin VB.Label Label 
         Caption         =   "货物编码:"
         Height          =   195
         Index           =   0
         Left            =   150
         TabIndex        =   2
         Top             =   360
         Width           =   825
      End
   End
   Begin MSFlexGridLib.MSFlexGrid Flex 
      Height          =   3405
      Left            =   150
      TabIndex        =   0
      Top             =   1440
      Width           =   7215
      _ExtentX        =   12726
      _ExtentY        =   6006
      _Version        =   393216
      Cols            =   6
      AllowUserResizing=   3
      FormatString    =   "|<货物分类码|<货物分类名称|<货物编码|<货物名称|>货物单价"
   End
End
Attribute VB_Name = "frmHwbmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TxtHwBmCode = 0
Const TxtHwBmMc = 1

Const CmdQuery = 0
Const CmdExit = 1

Private Sub Command_Click(Index As Integer)
On Error GoTo Errorhandle

   Select Case Index
   Case CmdQuery
         LoadData
   Case CmdExit
         Unload Me
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub
   
Private Sub LoadData()
   Dim ItemStr As String
   Dim SqlStr As String
   Dim ConnStr As String
   Dim Conn As ADODB.Connection
   Dim Rs As ADODB.Recordset
   Dim mHwbmCode As String, mHwbmMc As String
On Error GoTo Errorhandle
   
   Flex.Rows = 1
   
   ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=;Initial Catalog=fiterp;Data Source=ERP002"

   Set Conn = New ADODB.Connection
   Conn.ConnectionString = ConnStr
   Conn.Open
   
   If Trim(Text(TxtHwBmCode).Text) <> "" Then
      mHwbmCode = Trim(Text(TxtHwBmCode).Text)
   End If
   
   If Trim(Text(TxtHwBmMc).Text) <> "" Then
      mHwbmMc = Trim(Text(TxtHwBmMc).Text)
   End If
   
   Set Rs = New ADODB.Recordset
   Set Rs.ActiveConnection = Conn
   
   SqlStr = "{CALL VBSQLPROQUERY1('" & mHwbmCode & "','" & mHwbmMc & "')}"
   Rs.Open SqlStr
   
   Do While Not Rs.EOF
      ItemStr = vbTab & Rs("HWFLCODE") & vbTab & Rs("HWFLMC") & vbTab & Rs("HWBMCODE") & vbTab & Rs("HWBMMC") & vbTab & Rs("HWBMPRICE")
      Flex.AddItem ItemStr
      Rs.MoveNext
   Loop
   
   Rs.Close
   Set Rs = Nothing
   
   Conn.Close
   Set Conn = Nothing
   
Exit Sub
Errorhandle:
   Set Rs = Nothing
   Set Conn = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub