求一个VB三层结构的小例子。

Question

公司领导外出后，让我琢磨一个三层结构，根据他的描述，程序结构是：
客户端：登陆。输入用户名，密码。
中间层：在数据库端发布了一个组件。
数据库服务器。
据说，那家伙只用10分钟就做好了一个。
哪位达人能帮忙做这么一个小例子？

Answer 1

深吸一口气，5分20秒。
中间还浪费了一些时间，有个人过来跟我借了只笔。还说了几句话1。
中间层：
新建一个Activex dll工程，取名Test
 Class模块改名为 clsTest
 代码如下
 ======================================================
 Option ExplicitPublic Function CheckLogin(ByVal strUserName As String, ByVal strPassword As String) As Boolean
    Dim objConn As New ADODB.Connection
    Dim objRs As New ADODB.Recordset
    objRs.CursorLocation = adUseClient
    Dim strSql As String
    '数据库连接
    objConn.Open "OLEDB--String"
    strSql = "Select * From [Users] Where Username='" & strUserName & "'"
    objRs.Open strSql, 1, 1
    If objRs.EOF Then
        CheckLogin = False
    Else
        If objRs("Password") = strPassword Then
            CheckLogin = True
        Else
            CheckLogin = False
        End If
    End If
    objRs.Close
    Set objRs =Nothing
    objConn.Close
    Set objConn=Nothing
End Function
===============================================================保存，编译2。客户端拖两个Label,两个Textbox,一个buttonlabel1.caption="用户名"
label2.caption="密码"
button == > 改名 cmdLogin Textbox1 ==>txtUser
Textbox2 ==>txtPassword代码
===============================================================
Option ExplicitPrivate Sub cmdLogin_Click()
    Dim objTest As New Test.clsTest
    Dim blnReturn As Boolean
    If Trim(txtUser.Text) = "" Then
        MsgBox "请输入用户名"
        Exit Sub
    End If
    blnReturn = objTest.CheckLogin(txtUser.Text, txtPassword)
    If blnReturn = True Then
        MsgBox "登录成功"
    Else
        MsgBox "登录失败"
    End If
    Set objTest=Nothing
End Sub
===============================================================

Answer 2

http://www.xc-soft.com/docs/3tieranddatabase.htm

Answer 3

To: blackbug119(黑虫子)
 pcwak() 提供的文章很好，看看什么叫3层

Answer 4

babyt(阿泰) 的例子就很好，吧它编译成dll后，用regsvr32注册或者拖到mts里就可以了。

Answer 5

请问，编译成的test.dll，还需要在服务器那端发布吗？ 

Answer 6

>>问，编译成的test.dll，还需要在服务器那端发布吗？不一定，看实际情况
如果不是大的应用需要组件均衡之类的，
可以直接把这个dll和客户端放在一台机器上的。我觉得你这个需求就不用发到服务器上了

Answer 7

这个就可以直接发布到服务器上去你打开服务器的组件服务，创建一个新的服务器应用，把这个组件安装上去
然后再导出服务安装包，在你的客户端上安装一下就可以了还有一种方法是不用导出安装包，在客户端定义的时候，不用
 Dim objTest As New Test.clsTest
 而是这样
  Dim objTest As Test.clsTest
  Set objTest = CreateObject("Test.clsTest","服务器IP")
  也可以

Answer 8

SQL数据库：
只有一个myDB数据库，t_User表，字段：
id 自增
Name VarChar
Age  Integer
Sex VarChar三个存储过程：AddUser,DelUser,EditUser
AddUser：
CREATE PROCEDURE AddUser
 @UserName varchar(50),
 @UserAge int ,
 @UserSex varchar(2)
AS
 insert into t_User(Name,Age,Sex) values(@UserName,@UserAge,@UserSex)
GODelUser：
CREATE PROCEDURE DelUser
 @UserID int
AS
 delete from t_User where id=@UserID
GOEditUser：
CREATE PROCEDURE EditUser
 @UserID int,
 @UserName varchar(50),
 @UserAge int ,
 @UserSex varchar(2)
AS
 update t_User set Name=@UserName, Age=@UserAge,Sex=@UserSex where id=@UserID
GO新建一个ActiveX DLL工程，命名为：myConn增加一个模块，命名为：DBConn，用于连接数据库，代码如下：Option ExplicitPublic Conn As ADODB.Connection  '用于连接数据库'ActiveX DLL的启动程序
Public Sub Main()
    Call DBConn("ZHD", "myDB", "sa", "nndk")
End Sub'SName 服务器名称
'DBName 数据库名称
'SUName 登录用户名
'SPass 服务器密码
Public Function DBConn(SName As String, DBName As String, SUName As String, SUPass As String) As Boolean
    On Error GoTo ErrConn
    Set Conn = New ADODB.Connection    '连接到数据库
    With Conn
        .CursorLocation = adUseClient
        .CommandTimeout = 10
        .ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=" & SUName & ";Initial Catalog=" & DBName & ";Data Source=" & SName & ";pwd=" & SUPass
        .Open
    End With
    DBConn = True
    Exit Function
ErrConn:
    MsgBox "连接数据出错"
    DBConn = False
End Function
 
增加一个类模块，命名为：DM，用于存放操作数据库的代码，代码如下：
Option ExplicitPrivate UserID As Integer       '用户ID
Private UserName As String      '用户姓名
Private UserAge As Integer      '用户年龄
Private UserSex As String       '用户姓名'用户ID
Public Property Get g_UserID() As Integer
    g_UserID = UserID
End PropertyPublic Property Let g_UserID(ByVal vData As Integer)
    UserID = vData
End Property'用户姓名
Public Property Get g_UserName() As String
    g_UserName = UserName
End PropertyPublic Property Let g_UserName(ByVal vData As String)
    UserName = vData
End Property'用户年龄
Public Property Get g_UserAge() As Integer
    g_UserAge = UserAge
End PropertyPublic Property Let g_UserAge(ByVal vData As Integer)
    UserAge = vData
End Property'用户性别
Public Property Get g_UserSex() As String
    g_UserSex = UserSex
End PropertyPublic Property Let g_UserSex(ByVal vData As String)
    UserSex = vData
End Property'增加用户
Public Function AddUser(Optional StrName As String, Optional IntAge As Integer, Optional StrSex As String) As Boolean
    On Error GoTo ErrAddUser
    
    If StrName <> "" Then g_UserName = StrName
    If IntAge <> 0 Then g_UserName = IntAge
    If StrSex <> "" Then g_UserSex = StrSex
    
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
    
    With cmd
        Set .ActiveConnection = Conn
        .CommandType = adCmdStoredProc      '设置Command类型为“存储过程”
        .CommandText = "AddUser"            '存储过程的名称
        
        '传入存储过程参数
        .Parameters.Append .CreateParameter("@UserName", adVarChar, adParamInput, 50, Me.g_UserName)
        .Parameters.Append .CreateParameter("@UserAge", adInteger, adParamInput, , Me.g_UserAge)
        .Parameters.Append .CreateParameter("@UserSex", adVarChar, adParamInput, 2, Me.g_UserSex)
        
        .Execute
    End With
    AddUser = True
    Set cmd = Nothing
    Exit Function
ErrAddUser:
    If Not cmd Is Nothing Then Set cmd = Nothing
    AddUser = False
End Function'删除用户
Public Function DelUser(Optional IntID As Integer) As Boolean
    On Error GoTo ErrDelUser    If IntID <> 0 Then g_UserID = IntID
    
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
    
    With cmd
        Set .ActiveConnection = Conn
        .CommandType = adCmdStoredProc      '设置Command类型为“存储过程”
        .CommandText = "DelUser"            '存储过程的名称
       
        '传入存储过程参数
        .Parameters.Append .CreateParameter("@UserID", adInteger, adParamInput, , g_UserID)
        .Execute
    End With
    DelUser = True
    Set cmd = Nothing
    Exit Function
ErrDelUser:
    If Not cmd Is Nothing Then Set cmd = Nothing
    DelUser = False
End Function'修改用户
Public Function EditUser(Optional StrName As String, Optional IntAge As Integer, Optional StrSex As String) As Boolean
    On Error GoTo ErrEditUser    If IntID <> 0 Then g_UserID = IntID
    
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
    
    With cmd
        Set .ActiveConnection = Conn
        .CommandType = adCmdStoredProc      '设置Command类型为“存储过程”
        .CommandText = "EditUser"           '存储过程的名称
       
        '传入存储过程参数
        .Parameters.Append .CreateParameter("@UserID", adInteger, adParamInput, , g_UserID)
        .Parameters.Append .CreateParameter("@UserName", adVarChar, adParamInput, 50, Me.g_UserName)
        .Parameters.Append .CreateParameter("@UserAge", adInteger, adParamInput, , Me.g_UserAge)
        .Parameters.Append .CreateParameter("@UserSex", adVarChar, adParamInput, 2, Me.g_UserSex)
        .Execute
    End With
    EditUser = True
    Set cmd = Nothing
    Exit Function
ErrEditUser:
    If Not cmd Is Nothing Then Set cmd = Nothing
    EditUser = False
End Function增加一个类模块，命名为：RsGrid，设置DataSourceBehavior = 1，代码如下：
Option ExplicitPrivate WithEvents rsNames As ADODB.RecordsetPrivate Sub Class_GetDataMember(DataMember As String, Data As Object)
    Set Data = rsNames
End SubPrivate Sub Class_Initialize()
    On Error GoTo Errvs
    Set rsNames = New ADODB.Recordset
    rsNames.Open "select * from t_User", Conn, adOpenKeyset, adLockOptimistic
    Exit Sub
Errvs:
    MsgBox Err.Description
End Sub将启动对象设置为“Sub Main”，然后生成myConn.dll新建一个EXE工程，引用myConn.dll，在窗体上加载一个DataGrid1，二个文本框，一个组合框，三个按钮，窗体代码如下：Option ExplicitDim ObjUser As New DM'增加用户
Private Sub btnAdd_Click()
    If txtName.Text = "" Or Not IsNumeric(txtAge.Text) Then
        MsgBox "输入有错"
        Exit Sub
    End If
    With ObjUser
        .g_UserName = txtName.Text
        .g_UserAge = CInt(txtAge.Text)
        .g_UserSex = cmbSex.Text
        If Not .AddUser Then
            MsgBox "操作出错"
        Else
            MsgBox "操作成功"
            Form_Load
        End If
    End With
End Sub'删除用户
Private Sub btnDel_Click()
    If MsgBox("要删除人员？", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
    ObjUser.g_UserID = Me.DataGrid1.Columns(0).Text
    If Not ObjUser.DelUser Then
        MsgBox "操作出错"
    Else
        MsgBox "操作成功"
        Form_Load
    End If
End Sub'修改用户
Private Sub btnEdit_Click()
    With ObjUser
        .g_UserID = DataGrid1.Columns(0).Text
        .g_UserName = txtName.Text
        .g_UserAge = txtAge.Text
        .g_UserSex = cmbSex.Text
        If Not .EditUser Then
            MsgBox "操作出错"
        Else
            MsgBox "操作成功"
            Form_Load
        End If
    End With
End SubPrivate Sub DataGrid1_click()
    txtName.Text = DataGrid1.Columns(1).Text
    txtAge.Text = DataGrid1.Columns(2).Text
    If DataGrid1.Columns(3).Text = "男" Then
        cmbSex.ListIndex = 0
    End If
    If DataGrid1.Columns(3).Text = "女" Then
        cmbSex.ListIndex = 1
    End If
End SubPrivate Sub Form_Load()
    Dim RS As New RsGrid
    Set Me.DataGrid1.DataSource = RS
    cmbSex.ListIndex = 0
End Sub

Answer 9

部署的问题，你可以参考这两个帖子http://community.csdn.net/Expert/topic/3204/3204023.xml?temp=.9965784
http://community.csdn.net/Expert/topic/3172/3172619.xml?temp=5.010623E-02

Answer 10

第一篇：转贴：
终于试验成功了！
我在原本只有win2000 professional 的机器上又安装了一个win2000 server，并将其配置成主域
控制器，然后在另一台win98机器上用Administrator登录，启动VB，写个小程序试了一下，OK！为避免大家继续在黑暗中摸索，我现将试验用的具体例子及步骤详述如下（一个最简单的例子）：
1、在win2000 server机器上用VB(+SP5.0)创建一个ActiveX(DLL)工程，将工程名字改为“COM_Test”
2、添加一个类模块，名称为“ClsAdd”，并输入如下几行代码：
   Option Explicit
   Public x, y As Integer
   Public Function myAdd() As Integer
     myAdd = x + y
   End Function
3、打开“工程属性”对话框，选择“生成”，选中“自动升级”；选择“部件”，选中“远程服务器文件”（此点很重要，否则编译时不会生成类型库文件COM_Test.TLB）及“二进制兼容”，最后“确定”
4、保存并编译，生成“Com_Test.dll”
5、打开“控制面板/管理/组件服务”，在“COM+应用程序”下利用“COM+应用程序安装向导”创建一个空的COM＋应用程序，名称为“MyTest”
6、在“MyTest”下，新建“组件”，在“组件安装向导”中，选择“安装新组件”（注意：不要使用“导入已被注册的组件”）,然后将第4步生成的Com_Test.dll及Com_Test.tlb都添加进来（两个文件都要！），完成。
7、右击“COM+应用程序”上方的“我的电脑”，选择“属性”，然后在“属性”对话框中的“默认属性”页下，将“默认身份验证级”改为“无”，确定。
8、右击“MyTest”,导出客户端的“应用代理”。注意：在导出对话框中，必须选择“应用程序代理”而不是“服务器应用程序”！
9、将导出后的两个文件（即应用程序代理）安装到win98机器上，此时它会在注册表中添加几处注册项，并在C:\program files\ComPlus Applications下产生一个以CLISD命名的文件夹，打开来可看到Com_Test.tlb及Apl82.tmp二个文件。
注意：win98机器上是没有Com_Test.dll文件的，该文件在win2000 server机器上！好了，准备工作至此结束，下面在win98机器上来验证你的COM+配置型组件能否工作。（先用Administrator及口令登录）
10、启动VB(+sp5.0)，创建一个exe工程，在窗体上放置一个文本框与一个命令按钮，并在命令按钮的Click事件中加入代码：Dim ox as object
set ox=createobject("Com_Test.ClsAdd","win2000 server 的IP地址")
ox.x=12
ox.y=13
text1.text=ox.myAdd() 执行程序，win2000 server 机器的硬盘灯一阵闪烁之后，Text1中欢快地跳出“25”
－－－成功了！以上经验是在我经过多次痛苦的失败之后摸索出来的，看来靠别人不如靠自己。后记：1、此前，我对有关COM＋的内容可以说是一片空白，什么都不懂，甚至也没做过有关DCOM的试验。近来空闲，络续看了点CSDN论坛中的提问与回答，可没有一个让人满意的。万不得已，自力更生。
2、个人以为，COM+组件并不一定要配置在主域控制器上，但必须配置在某个域中的某台win 2000 Server上，而不是一般的2000 professional上(可能考虑到安全性)。
3、配置COM+组件不是在win98机器上的，而是在win 2000 Server上。比如，你在win98机器上安装
应用程序代理后，找不到相应的DLL文件，只有TLB文件（类型库），该DLL文件在win 2000 Server上由Dllhost.exe来负责装入内存。
4、若是创建非配置型组件，则第一步中不是创建一个ActiveX(DLL)工程，而是ActiveX(EXE)工程,
因为该exe文件在服务端不是由Dllhost.exe来负责装入内存，而是自行执行。此种情形下，当然也
就不需要第5至9步的操作了。以上观点，只是个人看法，错误难免，欢迎各位不吝赐教。/////////////////////////////////////////////////////////////////////////////////////////////第二篇：详细步骤！
1、首先在VB中写一ActiveX(DLL)组件，工程名为COMTEST。编译后在另一程序中调用，确认组件工作正常。
2、打开“控制面板/管理/组件服务”，在“COM+应用程序”下利用“COM+应用程序安装向导”创建一个空的COM＋应用程序，名称为“COMTEST”。
3、在“COMTEST”下，新建“组件”，在“组件安装向导”中，选择“安装新组件”（注意：不要使用“导入已被注册的组件”）,然后将生成的dll及tlb都添加进来（两个文件都要！），完成。
4、右击“COM+应用程序”上方的“我的电脑”，选择“属性”，然后在“属性”对话框中的“默认属性”页下，将“默认身份验证级”改为“无”，将“默认模拟级别”改为“匿名”，然后在“默认安全设置”页下的默认启动权限里添加"Everyone"，确定。（这里是匿名关键之一）
5、在本地用户管理里启用Guest用户！（这就是有人说权限里设置了Everyone仍然无法访问的原因）
6、右击“COMTEST”,导出客户端的“应用代理”。注意：在导出对话框中，必须选择“应用程序代理”而不是“服务器应用程序”！并将导出的文件在客户机安装！
7、好了！现在就可以在客户端进行调用了，点击运行后第一次运行在数秒弹出希望看到的运行结果，在激活服务器的准备状态以后的运行通常都在半秒内响应完成！（注：VB状态下加垃圾机器）

Answer 11

babyt(阿泰) 的小例子，终于成功，太开心了，谢谢你！也谢谢大家！