frmselectuser.frm

这是一个Web短信平台后台部分中的预付费管理系统,采用SQL Server数据库,主要是对短信服务的注册用户进得后台充值预付费管理。用到了第三方控件 VideoSoft Active Controls

VERSION 5.00
Begin VB.Form frmSelectUser 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择用户"
   ClientHeight    =   5685
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4200
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmSelectUser.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5685
   ScaleWidth      =   4200
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   2925
      TabIndex        =   2
      Top             =   5175
      Width           =   1005
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   1710
      TabIndex        =   1
      Top             =   5175
      Width           =   1005
   End
   Begin VB.ListBox lstUser 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4935
      Left            =   45
      TabIndex        =   0
      Top             =   45
      Width           =   4110
   End
End
Attribute VB_Name = "frmSelectUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :选择用户
'*    功 能 描 述 :
'*    程序员姓名  :谭怀志
'*    最后修改人  :谭怀志
'*    最后修改时间:2003/6/26
'*    备        注:
'*******************************************************

Private strUserID() As String
Private strUserName() As String

Private Sub cmdCancel_Click()
    
    Unload Me
    
End Sub

Private Sub cmdOK_Click()

    On Error Resume Next
    
    If lstUser.ListIndex <> -1 Then
        
        '确定选择的用户
        frmErrTable.SelectUid = strUserID(lstUser.ListIndex)
        
    End If
    
    Unload Me

End Sub

Private Sub Form_Load()

    Dim i As Long
    
    On Error GoTo ADOError
    
    '载入所有用户
    strQry = "select JFsetting.UserID,sysUser.FirstName,sysUser.LastName,FLlist.FLid,FLname,JFquan,JFtype from JFsetting,sysUser,FLlist where JFsetting.UserID=sysUser.UserID and JFsetting.FLid=FLlist.FLid"
    
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    
    ReDim strUserID(rstCustomers.RecordCount - 1)
    ReDim strUserName(rstCustomers.RecordCount - 1)
    
    While Not rstCustomers.EOF
    
        lstUser.AddItem rstCustomers!UserID & "-----" & rstCustomers!FirstName & rstCustomers!LastName
        lstUser.ItemData(lstUser.NewIndex) = rstCustomers!FLid
        strUserID(i) = rstCustomers!UserID
        strUserName(i) = rstCustomers!FirstName & rstCustomers!LastName
        i = i + 1
        rstCustomers.MoveNext
        
    Wend
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub