我是怎么写的，用vb编写dll从数据表中返回array（部分源代码），请大虾过目，希望斑竹能放进精华区

Option Explicit

Private MyErrObj As errorCls
Private ScriptingContext As ScriptingContext
Private request As request
Private response As response
Private server As server
Private session As session
Dim dbpath
Dim DbProvider As String

Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)

Set ScriptingContext = PassedScriptingContext
Set request = ScriptingContext.request
Set response = ScriptingContext.response
Set server = ScriptingContext.server
Set session = ScriptingContext.session
Set MyErrObj = New errorCls
dbpath = server.MapPath("xx9601.mdb")

@#用odbc数据源进行连接
DbProvider = "dsn=xx9601;uid=;pwd="

@#DbProvider = "driver={microsoft aclearcase/" target="_blank" >ccess driver (*.mdb)};dbq=" & dbpath

End Sub

Public Sub OnEndPage()

Set ScriptingContext = Nothing
Set request = Nothing
Set response = Nothing
Set server = Nothing
Set session = Nothing
Set MyErrObj = Nothing

End Sub

Private Function GetAll(adoCnn As ADODB.Connection, SCmd As String)

Dim adoRs As ADODB.Recordset
Dim arrayAdo()
Dim ivar
Dim jvar
    
On Error Resume Next

Set adoRs = New ADODB.Recordset

adoRs.Open SCmd, adoCnn, 3, 1

If adoCnn.Errors.Count > 0 Or adoRs.EOF Then
    GetAll = Null
    Set adoRs = Nothing
    Exit Function
End If

ReDim arrayAdo(adoRs.RecordCount - 1, adoRs.Fields.Count - 1)

For ivar = 0 To adoRs.RecordCount - 1
    For jvar = 0 To adoRs.Fields.Count - 1
        arrayAdo(ivar, jvar) = Trim(adoRs.Fields(jvar))
    Next
    adoRs.MoveNext
Next

Set adoRs = Nothing

@#vb6的数组赋值方式
GetAll = arrayAdo

End Function

Public Function GetToAry(PWD As Integer, SCmd As String)

If PWD <> 9601 Then
    GetToAry = Null
    Exit Function
End If

@#建立数据库连接
Dim adoCnn As ADODB.Connection
Set adoCnn = New ADODB.Connection
adoCnn.Open DbProvider

GetToAry = GetAll(adoCnn, SCmd)

adoCnn.Close
Set adoCnn = Nothing

End Function

Public Sub SqlexecOut(OPWD As Integer, SCmd As String)

If OPWD <> 9601 Then
    DisplayErr "密码错误!"
    Exit Sub
End If

@#建立数据库连接
Dim adoCnn As ADODB.Connection
Set adoCnn = New ADODB.Connection
adoCnn.Open DbProvider

SqlExec adoCnn, SCmd

adoCnn.Close
Set adoCnn = Nothing

End Sub

Private Sub SqlExec(adoCnn As ADODB.Connection, SCmd As String)

adoCnn.Execute SCmd

End Sub

Private Sub DisplayErr(errmsg As String)

Dim MyErrObj As errorCls

Set MyErrObj = New errorCls

MyErrObj.DisplayErr errmsg, response

End Sub

原文转自：http://www.ltesting.net