[firebase-br] Conexão e Concorrência

[Eduardo]

Olá Pessoal, como podem ver pelo horário já estou maluco, mas vamos lá.

Bom, estou com um pequeno problema que é o seguinte:
    Tenho um componente que chama a base para efetuar uma consulta simples, 
validação de usuário.
    Este componente é feito em vb6 e está no COM+ "2003 server", sem 
transação.
    Se eu efetuar a chamada de duas maquinas diferentes ao mesmo tempo, o 
objeto no com+ fica travado e acompanhando por log, vejo que abriu apenas 
uma conexão no banco.
    Efetuei diversos testes com vbs, com o isql e diversas chamdas externas 
e funcionaram, porém faço a mesma coisa com o sql server e o problema não se 
repete.

Pergunta existe alguma configuração de provider ou banco que possa estar me 
barrando ?

Estou usando o Firebird 1.5 e Firebird ODBC driver v1.2 para a conexão.

Segue o código para que você possam analisar, Obrigado Eduardo Venâncio.



Public Function ObterNmFuncionarioLogin(ByRef msgErro As Variant, _
                                        ByVal nm_login As Variant, _
                                        ByVal nm_arquivo As String) As 
Recordset

    On Error GoTo ProcessaErr

        NomeMetodo = "ObterNmFuncionarioLogin"

        'envia a string de conexao para a class que trata a mesma
        Dim objCnn As Object
        Dim strSQL As String

        Set objCnn = CreateObject("DataService.clsConnection")

        strSQL = "SELECT tbf.cd_funcionario, tbf.nm_funcionario FROM 
tbFuncionario tbf" & Chr(13)
        strSQL = strSQL & "JOIN tbUsuarios tbu" & Chr(13)
        strSQL = strSQL & "ON tbf.cd_funcionario = tbu.cd_funcionario" & 
Chr(13)
        strSQL = strSQL & "WHERE tbu.nm_login = '" & LCase(nm_login) & "'"

        Set ObterNmFuncionarioLogin = objCnn.ExecutaQueryRs(msgErro, strSQL, 
True, nm_arquivo)

        If msgErro <> "" Then
            GoTo ProcessaErr
        End If

        msgErro = ""

        'destruindo o objeto
        Set objCnn = Nothing

    Exit Function

ProcessaErr:

    Set Erro = CreateObject("Erro.clsErro")

    If msgErro = "" Then
        msgErro = Err.Number & " - " & Err.Description & " - " & NomeMetodo
    End If

    Call Erro.GeraLogErro("CallCenter", 1000, msgErro, NomeServico, 
NomeMetodo)

    Set Erro = Nothing

End Function



Public Function ExecutaQueryRs(ByRef msgErro As Variant, _
                               ByVal Query As String, _
                               ByVal FechaBanco As Boolean, _
                      Optional ByVal nm_arquivo As String) As Recordset

    On Error GoTo ProcessaErr

        Const NomeMetodo As String = "ExecutaQueryRs"

        Dim rs As Object

        Dim cn As Object
        Set cn = CreateObject("adodb.connection")

        cn.Open "DSN=teste"

        Open App.Path & "\log.txt" For Append As #1
            Print #1, "Abriu conexao = " & App.ThreadID
        Close #1

        Set rs = CreateObject("ADODB.Recordset")
            rs.ActiveConnection = cn
            rs.CursorLocation = 3 ' adUseClient
            rs.CursorType = 0 ' adOpenForwardOnly
            rs.LockType = 1 ' adLockReadOnly
            rs.Open Query

        Open App.Path & "\log.txt" For Append As #1
            Print #1, "Depois do rs.Open = " & App.ThreadID
        Close #1

        Set ExecutaQueryRs = rs

        Set cn = Nothing

        Open App.Path & "\log.txt" For Append As #1
            Print #1, "Fechou DB = " & App.ThreadID
        Close #1

    Exit Function

ProcessaErr:

        msgErro = Err.Number & " - " & Err.Description & " - " & msgErro

End Function