Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Module MdRotinasBasicas

    Public gDtBcoDados As Date
    Public gstrServidor As String
    Public gstrServidorSite As String
    Public gstrPortaSql As String
    Public gstrDSN As String
    Public gstrDataBase As String
    Public gstrDataBaseSite As String
    Public gstrSenha As String
    Public gstrSenhaSite As String
    Public gstrNmEstacao As String
    Public gblnCnxMysql As Boolean
    Public gblnCnxMysqlSite As Boolean
    Public gstrDBEsquema As String
    Public gstrDBColunas As String
    Public gstrDBVisao As String
    Public gstrZlcMask As String
    '### Oracle ##############################
    Public gstrOrclUser As String
    Public gstrOrclPass As String
    Public gstrOrclDBas As String
    Public gblnOracleCarregado As Boolean
    'Link Center
    Public gstrBDCLinkCenter As String
    Public gstrBDMLinkCenter As String
    '
    Public Const gstrTituloMensagem As String = "Mensagem do Sistema"
    '### Usuario ##############################
    Public gstrUsuario_Matricula As String
    Public gstrUsuario_Nome As String
    Public gstrUsuario_Login As String
    Public glngUsuario_Id As Integer
    Public glngUsuario_IdGrupo As Integer
    Public gblnUsuario_Opcao As Boolean
    Public gblnUsuario_RecMan As Boolean
    Public gintUsuario_NivelCaixa As Short
    Public gintUsuario_NivelAcesso As Short
    '### Usuario Acesso Especial ##############
    Public gblnUsuario_Consumidor_criar_novo As Boolean
    Public gblnUsuario_Consumidor_salvar As Boolean
    Public gblnUsuario_Unidade_consumidora_criarnovo As Boolean
    Public gblnUsuario_Unidade_consumidora_excluir As Boolean
    Public gblnUsuario_Unidade_consumidora_historico As Boolean
    Public gblnUsuario_Unidade_consumidora_salvar As Boolean
    Public gblnUsuario_Atendimento_comercial_salvar As Boolean
    Public gblnUsuario_Faturas_demonstrativo As Boolean
    Public gblnUsuario_Faturas_segunda_via As Boolean
    Public gblnUsuario_Faturas_pedido_prazo As Boolean
    Public gblnUsuario_Faturas_todos_aberto As Boolean
    Public gblnUsuario_Faturas_aberto_cortado As Boolean
    Public gblnUsuario_Faturas_reserva_judice As Boolean
    Public gblnUsuario_Faturas_pagas As Boolean
    Public gblnUsuario_Faturas_ultimos_consumos As Boolean
    Public gblnUsuario_Servicos_convenios As Boolean
    Public gblnUsuario_Servicos_extrato As Boolean
    Public gblnUsuario_Servicos_historico As Boolean
    Public gblnUsuario_Servicos_nis As Boolean
    Public gblnUsuario_Servicos_ordem_servico As Boolean
    Public gblnUsuario_Servicos_reclamacao As Boolean
    Public gblnUsuario_Servicos_ultimas_ordens_servicos As Boolean
    Public gblnUsuario_Servicos_ultimas_reclamacoes As Boolean

    '############################################################
    Public glngNumCaixa As Integer
    Public gstrDocumentoCpfCnpj As String

    '### Empresa ##############################
    Public gintEmpresa_Codigo As Short
    Public gstrEmpresa_Nome_Sel As String
    Public gstrEmpresa_Nome As String
    Public gstrEmpresa_0800 As String
    Public gstrEmpresa_EMAIL As String
    Public gstrEmpresa_Cidade As String
    Public gstrEmpresa_Endereco As String
    Public gstrEmpresa_Fone As String
    Public gstrEmpresa_Site As String
    Public gstrEmpresa_Sigla As String
    Public gstrEmpresa_UF As String
    Public gstrEmpresa_CNPJ As String
    Public gstrEmpresa_CodRes89 As String
    Public gstrSistemaSocios As String
    Public gstrDataBaseSocios As String
    Public gstrProcessa_Desligado As String
    Public gstrPesquisaZona999 As String
    Public gstrEmpresa_Modelo2 As String
    Public gstrEmpresa_ModItens As String
    Public gstrEmpresa_DevDuplPgtoAuto As String
    Public gstrEmpresa_CapSocialAutomatic As String
    Public gstrEmpresa_Conjunto As String
    Public gstrEmpresaUsarNovoCalIlum As String
    Public gstrReaviso_na_fatura As String
    Public gdteDataBandeiraInicio As Date
    '
    Public glngPortaria_Sef_344_2019 As Integer

    '### Funções do Kernel ####################
    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"'
    ' Private Declare Function GetPrivateProfileString Lib "kernel32"  Alias "GetPrivateProfileStringA"(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer

    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"'
    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"'
    'Private Declare Function WritePrivateProfileString Lib "kernel32"  Alias "WritePrivateProfileStringA"(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Integer



    Public Sub CenterForm(ByRef afrmAux As System.Windows.Forms.Form)
        'centraliza um form dentro do MDIform
        Dim lsinVlrX As Single
        Dim lsinVlrY As Single
        lsinVlrX = (((VB6.PixelsToTwipsX(FrmAtPrincipal.ClientRectangle.Width) - VB6.PixelsToTwipsX(afrmAux.Width)) \ 2) + VB6.PixelsToTwipsX(FrmAtPrincipal.Left))
        lsinVlrY = (((VB6.PixelsToTwipsY(FrmAtPrincipal.ClientRectangle.Height) - VB6.PixelsToTwipsY(afrmAux.Height)) \ 2) + VB6.PixelsToTwipsY(FrmAtPrincipal.Top) + 100)
        Call afrmAux.SetBounds(VB6.TwipsToPixelsX(lsinVlrX), VB6.TwipsToPixelsY(lsinVlrY), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
    End Sub

    Public Sub CenterFormQuemChama(ByRef afrmAux As System.Windows.Forms.Form, ByRef afrmQuemChama As System.Windows.Forms.Form)
        'centraliza um form dentro do form que chamou
        Dim lsinVlrX As Single
        Dim lsinVlrY As Single
        lsinVlrX = (((VB6.PixelsToTwipsX(afrmQuemChama.ClientRectangle.Width) - VB6.PixelsToTwipsX(afrmAux.Width)) \ 2) + VB6.PixelsToTwipsX(afrmQuemChama.Left))
        lsinVlrY = (((VB6.PixelsToTwipsY(afrmQuemChama.ClientRectangle.Height) - VB6.PixelsToTwipsY(afrmAux.Height)) \ 2) + VB6.PixelsToTwipsY(afrmQuemChama.Top) + 100)
        Call afrmAux.SetBounds(VB6.TwipsToPixelsX(lsinVlrX), VB6.TwipsToPixelsY(lsinVlrY), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
    End Sub

    Public Function PreencheCampo(ByVal astrCampo As String, ByVal aintTamanho As Short, Optional ByVal astrCaracter As String = " ", Optional ByVal astrAlinhamento As String = "D") As String
        Dim lstrAlinhamento As String
        Dim lstrCampo As String
        Dim ldblMeio As Double
        Dim lstrRetorno As String
        '
        lstrAlinhamento = Left(UCase(astrAlinhamento), 1)
        lstrCampo = Trim(astrCampo)
        '
        Select Case lstrAlinhamento
            Case "E"
                lstrRetorno = Right(New String(astrCaracter, aintTamanho) & lstrCampo, aintTamanho)
            Case "D"
                lstrRetorno = Left(lstrCampo & New String(astrCaracter, aintTamanho), aintTamanho)
            Case "C"
                ldblMeio = Arredondar(aintTamanho / 2, 0)
                ldblMeio = ldblMeio - Arredondar(CInt(Len(lstrCampo)) / 2, 0)
                lstrRetorno = New String(astrCaracter, CInt(ldblMeio)) & lstrCampo & New String(astrCaracter, aintTamanho - CInt(ldblMeio + CInt(Len(lstrCampo))))
        End Select
        PreencheCampo = lstrRetorno
    End Function

    Public Sub limpaCampo(ByRef Formulário As System.Windows.Forms.Form)
        Dim vControl As System.Windows.Forms.Control
        For Each vControl In Formulário.Controls
            ' ---------------------- TextBox ------------------------------------
            'UPGRADE_WARNING: TypeOf has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
            If TypeOf vControl Is System.Windows.Forms.TextBox Then vControl.Text = ""
            ' ---------------------- Label conectado a Dados ----------
            'UPGRADE_WARNING: TypeOf has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
            If TypeOf vControl Is System.Windows.Forms.Label Then
                'UPGRADE_WARNING: Couldn't resolve default property of object vControl.DataField. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                If Len(vControl.DataField) > 0 Then vControl.Text = ""
            End If
            '----------------------- ComboBox --------------------------------
            'UPGRADE_WARNING: TypeOf has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
            If TypeOf vControl Is System.Windows.Forms.ComboBox Then
                'UPGRADE_WARNING: Couldn't resolve default property of object vControl.ListCount. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                'UPGRADE_WARNING: Couldn't resolve default property of object vControl.ListIndex. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                If vControl.ListCount > 0 Then vControl.ListIndex = -1
            End If
            '----------------------- ListBox --------------------------------
            'UPGRADE_WARNING: TypeOf has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
            'UPGRADE_WARNING: Couldn't resolve default property of object vControl.ListIndex. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            If TypeOf vControl Is System.Windows.Forms.ListBox Then vControl.ListIndex = -1
            '----------------------- Data Picker -------------------------------
            '  If TypeOf vControl Is DTPicker Then vControl.Value = Now
            '----------------------- MaskData Picker -------------------------------
            '  If TypeOf vControl Is MaskEdBox Then vControl.Text = ""
        Next vControl
        '--------- Utilizado no meu Sistema, pode ser adaptado -------------
        'Formulário.Tag = "Novo"
    End Sub

    Public Function EImpar(ByVal iNum As Integer) As Boolean
        'Verifica se o número é impar
        'Se for impar a função retorna True.
        'Se for par a função retorna False.
        EImpar = (iNum Mod 2)
    End Function

    Public Function Carrega_Banco() As Boolean
        Dim lstrAux As String

        On Error GoTo ErroCarregaBanco

        If gstrPortaSql = "" Then gstrPortaSql = "3306"
        lstrAux = ""
        lstrAux = lstrAux & "DRIVER={MySQL ODBC 3.51 Driver};"
        lstrAux = lstrAux & "SERVER=" & gstrServidor & ";"
        lstrAux = lstrAux & "DATABASE=" & gstrDataBase & ";"
        lstrAux = lstrAux & "USER=nss;"
        lstrAux = lstrAux & "PASSWORD=ba65d7baedb0c8e8;"
        lstrAux = lstrAux & "PORT=" & gstrPortaSql & ";"
        lstrAux = lstrAux & "OPTION=" & (1 + 2 + 8 + 32 + 2048) & ";"
        With myConC
            .Mode = ADODB.ConnectModeEnum.adModeReadWrite
            .CursorLocation = ADODB.CursorLocationEnum.adUseServer
            .ConnectionString = lstrAux
            .Open()
        End With
        gblnCnxMysql = True
        gstrOrclUser = Trim(LeConfig("SGD_USUARIO"))
        If gstrOrclUser = "-1" Then gstrOrclUser = ""
        gstrOrclPass = Trim(LeConfig("SGD_SENHA"))
        If gstrOrclPass = "-1" Then gstrOrclPass = ""
        gstrOrclDBas = Trim(LeConfig("SGD_DATABASE"))
        If gstrOrclDBas = "-1" Then gstrOrclDBas = ""

        gstrServidorSite = Trim(LeConfig("SITE_SERVIDOR"))
        If gstrServidorSite = "-1" Then gstrServidorSite = ""
        gstrDataBaseSite = Trim(LeConfig("SITE_DATABASE"))
        If gstrDataBaseSite = "-1" Then gstrDataBaseSite = ""

ErroCarregaBanco:
        With myConC
            If .Errors.Count > 0 Then
                Call MsgBox("Código: " & .Errors.Item(.Errors.Count - 1).NativeError & vbCrLf & "Descrição:" & .Errors.Item(.Errors.Count - 1).Description, MsgBoxStyle.Exclamation, gstrTituloMensagem)
                gblnCnxMysql = False
            ElseIf Err.Number > 0 Then
                Call MsgBox("Erro: " & Err.Number & " - " & Err.Description, MsgBoxStyle.Information, gstrTituloMensagem)
                gblnCnxMysql = False
            End If
        End With
        Carrega_Banco = gblnCnxMysql
    End Function

    Public Function Carrega_Banco_site(ByRef astrRetErro As String) As Boolean
        Dim lstrAux As String

        On Error GoTo ErroCarregaBancoSite
        gblnCnxMysqlSite = False
        lstrAux = ""
        lstrAux = lstrAux & "DRIVER={MySQL ODBC 3.51 Driver};"
        lstrAux = lstrAux & "SERVER=" & gstrServidorSite & ";"
        lstrAux = lstrAux & "DATABASE=" & gstrDataBaseSite & ";"
        'lstrAux = lstrAux & "USER=eflul;"
        'lstrAux = lstrAux & "PASSWORD=p9n4y7d2;"
        lstrAux = lstrAux & "PORT=3306;"
        lstrAux = lstrAux & "OPTION=3;"
        With MyConCSite
            .Mode = ADODB.ConnectModeEnum.adModeReadWrite
            .CursorLocation = ADODB.CursorLocationEnum.adUseServer
            .ConnectionString = lstrAux
            .CommandTimeout = 0
            .ConnectionTimeout = 0
            Call .Open(lstrAux, "eflul", "p9n4y7d2")
            'Call .Open(lstrAux) '
        End With
        gblnCnxMysqlSite = True

ErroCarregaBancoSite:
        With MyConCSite
            If .Errors.Count > 0 Then
                astrRetErro = "Código: " & .Errors.Item(.Errors.Count - 1).NativeError & " Descrição:" & .Errors.Item(.Errors.Count - 1).Description
                gblnCnxMysqlSite = False
            ElseIf Err.Number > 0 Then
                astrRetErro = "Erro: " & Err.Number & " - " & Err.Description
                gblnCnxMysqlSite = False
            End If
        End With
        Carrega_Banco_site = gblnCnxMysqlSite
    End Function

    Public Function CarregaOracle() As Boolean
        Dim lstrConexao As String

        On Error GoTo ErroCarregaOracle
        gblnOracleCarregado = True
        lstrConexao = ""
        lstrConexao = lstrConexao & "DRIVER={Microsoft ODBC For Oracle}"
        lstrConexao = lstrConexao & ";SERVER=" & gstrOrclDBas
        lstrConexao = lstrConexao & ";UID=" & gstrOrclUser
        lstrConexao = lstrConexao & ";PWD=" & gstrOrclPass & ";"
        With gadoOraclCx
            If .State = ADODB.ObjectStateEnum.adStateOpen Then Call .Close()
            .ConnectionString = lstrConexao
            .CursorLocation = ADODB.CursorLocationEnum.adUseClient
            .Open()
        End With
ErroCarregaOracle:
        With gadoOraclCx
            If .Errors.Count > 0 Then
                Call MsgBox("Código: " & .Errors.Item(.Errors.Count - 1).NativeError & vbCrLf & "Descrição:" & .Errors.Item(.Errors.Count - 1).Description, MsgBoxStyle.Exclamation, gstrTituloMensagem)
                gblnOracleCarregado = False
            ElseIf Err.Number > 0 Then
                Call MsgBox("Erro: " & Err.Number & " - " & Err.Description, MsgBoxStyle.Information, gstrTituloMensagem)
                gblnOracleCarregado = False
            End If
        End With
        CarregaOracle = gblnOracleCarregado
        Resume Next
    End Function

    Public Function CarregaOracleProvider(ByVal astrOrclDBas As String, ByVal astrOrclUser As String, ByVal astrOrclPass As String) As Boolean
        Dim lstrConexao As String
        On Error GoTo ErroCarregaOracleProvider
        gblnOracleCarregado = True
        lstrConexao = ""
        With gadoOraclCx
            If .State = ADODB.ObjectStateEnum.adStateOpen Then Call .Close()
            .Provider = "OraOLEDB.Oracle"
            .Properties("Data Source").Value = astrOrclDBas
            .Properties("User Id").Value = astrOrclUser
            .Properties("Password").Value = astrOrclPass
            .Open()
        End With
        CarregaOracleProvider = gblnOracleCarregado
        Exit Function
ErroCarregaOracleProvider:
        With gadoOraclCx
            If .Errors.Count > 0 Then
                Call MsgBox("Código: " & .Errors.Item(.Errors.Count - 1).NativeError & vbCrLf & "Descrição:" & .Errors.Item(.Errors.Count - 1).Description, MsgBoxStyle.Exclamation, gstrTituloMensagem)
                gblnOracleCarregado = False
            ElseIf Err.Number > 0 Then
                Call MsgBox("Erro: " & Err.Number & " - " & Err.Description, MsgBoxStyle.Information, gstrTituloMensagem)
                gblnOracleCarregado = False
            End If
        End With
        CarregaOracleProvider = gblnOracleCarregado
        Resume Next
    End Function

    Public Sub Init_Carrega_Dados_Empresa()
        Dim lstrSql As String
        Dim lstrAux As String
        gDtBcoDados = BuscaDataBD()
        gadoOraclCx = New ADODB.Connection
        gadoOraclCm = New ADODB.Command
        '--- Essa função carrega os principais dados da empresa para a memória
        gstrEmpresa_Nome = Trim(LeConfig("EMPRESA_NOME"))
        gstrEmpresa_0800 = Trim(LeConfig("EMPRESA_0800"))
        gstrEmpresa_EMAIL = Trim(LeConfig("EMPRESA_EMAIL"))
        gstrEmpresa_Cidade = Trim(LeConfig("EMPRESA_MUNICIPIO"))
        gstrEmpresa_Sigla = Trim(LeConfig("EMPRESA_SIGLA"))
        gstrEmpresa_UF = Trim(LeConfig("EMPRESA_UF"))
        gstrEmpresa_CNPJ = Trim(LeConfig("EMPRESA_CNPJ"))
        gstrEmpresa_CodRes89 = Trim(LeConfig("EMPRESA_COD_RES89"))
        gstrEmpresa_DevDuplPgtoAuto = Trim(LeConfig("EMPRESA_DEVDUPLPGTO_AUTOMATICO"))
        gstrReaviso_na_fatura = Trim(LeConfig("REAVISO_NA_FATURA"))
        gstrDBEsquema = Trim(LeConfig("DATABASE_ESQUEMA"))
        gstrDBColunas = Trim(LeConfig("DATABASE_ESQUEMA_COLUNAS"))
        gstrDBVisao = Trim(LeConfig("DATABASE_ESQUEMA_VIEW"))
        gstrBDCLinkCenter = LCase(Trim(LeConfig("BANCO_COMERCIAL_LC")))
        '
        gstrProcessa_Desligado = Trim(LeConfig("PROCESSA_DESLIGADO"))
        gstrEmpresa_Modelo2 = Trim(LeConfig("EMPRESA_MODELO2"))
        gstrSistemaSocios = Trim(LeConfig("SISTEMA_SOCIOS_NOVO"))
        gstrDataBaseSocios = Trim(LeConfig("DATABASE_SOCIOS_NOVO"))
        gstrEmpresa_CapSocialAutomatic = Trim(LeConfig("EMPRESA_CAP_SOCIAL_AUTOMATICO"))
        gstrEmpresa_ModItens = Trim(LeConfig("EMPRESA_MODITENS"))
        gstrZlcMask = LCase(Trim(LeConfig("SGD_UC_MASK")))
        If gstrZlcMask = "-1" Then gstrZlcMask = "ZZZLLCCCCCC"
        '
        ' Define valores padrões caso não possua
        '
        If gstrDBEsquema = "-1" Then
            gstrDBEsquema = "information_schema"
            Call CriaParConfig("DATABASE_ESQUEMA", gstrDBEsquema, False, "Data base dos esquemas de dados.")
        ElseIf gstrDBEsquema = "" Then
            gstrDBEsquema = "information_schema"
            Call GravaConfig("DATABASE_ESQUEMA", gstrDBEsquema)
        End If
        '
        If gstrDBColunas = "-1" Then
            gstrDBColunas = "COLUMNS"
            Call CriaParConfig("DATABASE_ESQUEMA_COLUNAS", gstrDBColunas, False, "Data base dos esquemas de dados.")
        ElseIf gstrDBColunas = "" Then
            gstrDBColunas = "COLUMNS"
            Call GravaConfig("DATABASE_ESQUEMA_COLUNAS", gstrDBColunas)
        End If
        '
        If gstrDBVisao = "-1" Then
            gstrDBVisao = "VIEWS"
            Call CriaParConfig("DATABASE_ESQUEMA_VIEW", gstrDBVisao, False, "Data base dos esquemas de visao dos dados.")
        ElseIf gstrDBVisao = "" Then
            gstrDBVisao = "VIEWS"
            Call GravaConfig("DATABASE_ESQUEMA_VIEW", gstrDBVisao)
        End If
        '
        If gstrBDCLinkCenter = "" Then
            gstrBDCLinkCenter = "`fatd_" & LCase(gstrEmpresa_Sigla) & "`"
            Call GravaConfig("BANCO_COMERCIAL_LC", gstrBDCLinkCenter)
        ElseIf gstrBDCLinkCenter = "-1" Then
            gstrBDCLinkCenter = "`fatd_" & LCase(gstrEmpresa_Sigla) & "`"
            Call CriaParConfig("BANCO_COMERCIAL_LC", gstrBDCLinkCenter, True, "Banco de dados do comercial do sistema Link Center")
        End If
        '
        gstrBDMLinkCenter = LCase(Trim(LeConfig("BANCO_MEDICAO_LC")))
        If gstrBDMLinkCenter = "" Then
            gstrBDMLinkCenter = "`medicao_" & LCase(gstrEmpresa_Sigla) & "`"
            Call GravaConfig("BANCO_MEDICAO_LC", gstrBDMLinkCenter)
        ElseIf gstrBDMLinkCenter = "-1" Then
            gstrBDMLinkCenter = "`medicao_" & LCase(gstrEmpresa_Sigla) & "`"
            Call CriaParConfig("BANCO_MEDICAO_LC", gstrBDMLinkCenter, True, "Banco de dados de medição do sistema Link Center")
        End If
        '
        If gstrEmpresa_Modelo2 = "-1" Then
            Call CriaParConfig("EMPRESA_MODELO2", "N", False, "Configura a empresa se vai usar as colunas novas da nf.")
            gstrEmpresa_Modelo2 = "N"
        ElseIf gstrEmpresa_Modelo2 = "" Then
            Call GravaConfig("EMPRESA_MODELO2", "N")
            gstrEmpresa_Modelo2 = "N"
        ElseIf gstrEmpresa_Modelo2 <> "S" Then
            gstrEmpresa_Modelo2 = "N"
        End If
        '
        If gstrEmpresa_ModItens = "-1" Then
            Call CriaParConfig("EMPRESA_MODITENS", "N", False, "Usa o novo formato dos itens da impressão da fatura.")
            gstrEmpresa_ModItens = "N"
        ElseIf gstrEmpresa_ModItens = "" Then
            Call GravaConfig("EMPRESA_MODITENS", "N")
            gstrEmpresa_ModItens = "N"
        ElseIf gstrEmpresa_ModItens <> "S" Then
            gstrEmpresa_ModItens = "N"
        End If
        '
        If gstrEmpresa_DevDuplPgtoAuto = "-1" Then
            Call CriaParConfig("EMPRESA_DEVDUPLPGTO_AUTOMATICO", "N", True, "Devolução de duplicidade de pagemento automático.")
            gstrEmpresa_DevDuplPgtoAuto = "N"
        ElseIf gstrEmpresa_DevDuplPgtoAuto = "" Then
            Call GravaConfig("EMPRESA_DEVDUPLPGTO_AUTOMATICO", "N")
            gstrEmpresa_DevDuplPgtoAuto = "N"
        ElseIf gstrEmpresa_DevDuplPgtoAuto <> "S" Then
            gstrEmpresa_DevDuplPgtoAuto = "N"
        End If
        '
        lstrAux = Trim(LeConfig("NAO_ANALIZAR_KWH_MENOR_QUE"))
        If lstrAux = "-1" Then
            Call CriaParConfig("NAO_ANALIZAR_KWH_MENOR_QUE", "0", True, "Não analisar no grupo B kWh menor que...")
        ElseIf lstrAux = "" Then
            Call GravaConfig("NAO_ANALIZAR_KWH_MENOR_QUE", "0")
        End If
        '
        lstrAux = Trim(LeConfig("ANALIZAR_KWH_MENOR_CUSTO"))
        If lstrAux = "-1" Then
            Call CriaParConfig("ANALIZAR_KWH_MENOR_CUSTO", "N", True, "Analisar no grupo B kWh menor que o custo de disponibilidade(S/N).")
        ElseIf lstrAux = "" Then
            Call GravaConfig("ANALIZAR_KWH_MENOR_CUSTO", "N")
        End If
        '
        lstrAux = Trim(LeConfig("DATA_BANDEIRA_INICIO"))
        If lstrAux = "-1" Then
            If gstrEmpresa_Sigla = "CERGAL" Or gstrEmpresa_Sigla = "COORSEL" Then
                gdteDataBandeiraInicio = CDate("2015-07-01")
            Else
                gdteDataBandeiraInicio = CDate("2015-01-01")
            End If
            Call CriaParConfig("DATA_BANDEIRA_INICIO", CStr(gdteDataBandeiraInicio), False, "Mês e ano de inicio do calculo das bandeiras tarifárias.")
        ElseIf lstrAux = "" Then
            If gstrEmpresa_Sigla = "CERGAL" Or gstrEmpresa_Sigla = "COORSEL" Then
                gdteDataBandeiraInicio = CDate("2015-07-01")
            Else
                gdteDataBandeiraInicio = CDate("2015-01-01")
            End If
            Call GravaConfig("DATA_BANDEIRA_INICIO", CStr(gdteDataBandeiraInicio))
        Else
            If IsDate(lstrAux) Then
                gdteDataBandeiraInicio = CDate(lstrAux)
            Else
                If gstrEmpresa_Sigla = "CERGAL" Or gstrEmpresa_Sigla = "COORSEL" Then
                    gdteDataBandeiraInicio = CDate("2015-07-01")
                Else
                    gdteDataBandeiraInicio = CDate("2015-01-01")
                End If
            End If
        End If
        '
        gstrPesquisaZona999 = Trim(LeConfig("PESQUISA_ZONA_999"))
        If gstrPesquisaZona999 = "-1" Then
            gstrPesquisaZona999 = "N"
            Call CriaParConfig("PESQUISA_ZONA_999", gstrPesquisaZona999, True, "Localiza Zona 999 nas telas de pesquisa.")
        ElseIf gstrPesquisaZona999 = "" Then
            gstrPesquisaZona999 = "N"
            Call GravaConfig("PESQUISA_ZONA_999", gstrPesquisaZona999)
        End If
        'Novo calculo de CIP
        gstrEmpresaUsarNovoCalIlum = Trim(LeConfig("EMPRESA_USAR_NOVO_CALC_ILUM"))
        If gstrEmpresaUsarNovoCalIlum = "-1" Then
            Call CriaParConfig("EMPRESA_USAR_NOVO_CALC_ILUM", "N", True, "Usar novo calculo de iluminação pública")
            gstrEmpresaUsarNovoCalIlum = "N"
        ElseIf gstrEmpresaUsarNovoCalIlum = "" Then
            Call GravaConfig("EMPRESA_USAR_NOVO_CALC_ILUM", "N")
            gstrEmpresaUsarNovoCalIlum = "N"
        ElseIf gstrEmpresaUsarNovoCalIlum <> "S" Then
            gstrEmpresaUsarNovoCalIlum = "N"
        End If
        '
        lstrSql = ""
        lstrSql = lstrSql & "CREATE TABLE IF NOT EXISTS " & gstrDataBase & ".`auditoria_comandos_lc` ("
        lstrSql = lstrSql & "  `idauditoria` int(11) NOT NULL AUTO_INCREMENT,"
        lstrSql = lstrSql & "  `movimento` datetime NOT NULL DEFAULT '0000-00-00 00:00:00',"
        lstrSql = lstrSql & "  `comando` longtext, "
        lstrSql = lstrSql & "  PRIMARY KEY (`idauditoria`)"
        lstrSql = lstrSql & ") ENGINE=InnoDB DEFAULT CHARSET=latin1  "
        Call Executar(lstrSql)
        'Falta criar variaveis
        'LeConfig("EMPRESA_CODBARRA_FEBRABAN")
        'LeConfig("EMPRESA_COD_DECFEC")
        gstrEmpresa_Conjunto = LeConfig("EMPRESA_CONJUNTO")
        'LeConfig("EMPRESA_CEP")
        gstrEmpresa_Endereco = LeConfig("EMPRESA_ENDERECO")
        'LeConfig("EMPRESA_FAX")
        gstrEmpresa_Fone = LeConfig("EMPRESA_FONE")
        gstrEmpresa_Site = LeConfig("EMPRESA_SITE")
        'LeConfig("DIR_RPT")
        'LeConfig("ARQUIVO_LOGOTIPO")
        lstrAux = Trim(LeConfig("PORTARIA_SEF_344_2019"))
        If CDbl(lstrAux) = -1 Then
            glngPortaria_Sef_344_2019 = 202004
            Call CriaParConfig("PORTARIA_SEF_344_2019", CStr(glngPortaria_Sef_344_2019), True, "Mês inicio da portaria sef 344 2019.")
        ElseIf lstrAux = "" Then
            glngPortaria_Sef_344_2019 = 202004
            Call GravaConfig("PORTARIA_SEF_344_2019", CStr(glngPortaria_Sef_344_2019))
        Else
            glngPortaria_Sef_344_2019 = CInt(lstrAux)
        End If



    End Sub

    Public Function Valida_CPF_CGC(ByRef documento2 As String) As Boolean
        '--- Essa função mascara uma string para o formato de CPF ou CGC
        '--- Dependendo do nro. de caracteres
        Dim doc_puro As String
        doc_puro = Str_Retira(documento2, "/\()-=.+*[]}{ ")
        'Valida_CPF_CGC = True
        Select Case Len(doc_puro)
            Case 11
                'ex: 00434615900    -> 004.346.159-00
                gstrDocumentoCpfCnpj = Mid(doc_puro, 1, 3) & "." & Mid(doc_puro, 4, 3) & "." & Mid(doc_puro, 7, 3) & "-" & Mid(doc_puro, 10, 2)
                'falta validação

                Valida_CPF_CGC = CPFOk(doc_puro)
            Case 14
                'ex: 78859113000115 -> 78.859.113/0001-15
                gstrDocumentoCpfCnpj = Mid(doc_puro, 1, 2) & "." & Mid(doc_puro, 3, 3) & "." & Mid(doc_puro, 6, 3) & "/" & Mid(doc_puro, 9, 4) & "-" & Mid(doc_puro, 13, 2)
                Valida_CPF_CGC = Int_Valida_CNPJ(doc_puro)
        End Select
    End Function

    Public Function Int_Valida_CNPJ(ByVal astrCNPJ As String) As Boolean
        Dim lblnRetorno As Boolean
        Dim lintAux As Short
        Dim llngSoma As Integer
        Dim lintPasso As Short
        Dim lintDigito1 As Short
        Dim lintDigito2 As Short
        Dim lintFlag As Short
        lblnRetorno = False
        astrCNPJ = Trim(astrCNPJ)
        If Len(astrCNPJ) = 14 Then
            For lintPasso = 5 To 6
                llngSoma = 0
                lintFlag = lintPasso
                For lintAux = 1 To lintPasso + 7
                    llngSoma = llngSoma + (Val(Mid(astrCNPJ, lintAux, 1)) * lintFlag)
                    lintFlag = IIf(lintFlag > 2, lintFlag - 1, 9)
                Next lintAux
                llngSoma = llngSoma Mod 11
                If lintPasso = 5 Then lintDigito1 = IIf(llngSoma > 1, 11 - llngSoma, 0)
                If lintPasso = 6 Then lintDigito2 = IIf(llngSoma > 1, 11 - llngSoma, 0)
            Next
            If (lintDigito1 = Val(Mid(astrCNPJ, 13, 1)) And lintDigito2 = Val(Mid(astrCNPJ, 14, 1))) Then
                lblnRetorno = True
            End If
        End If
        Int_Valida_CNPJ = lblnRetorno
    End Function

    Public Function CPFOk(ByVal strNumeroCPF As String) As Boolean
        '--------------------------------------------------------------'
        ' FUNÇÃO USADA PARA VALIDAR O CPF.                             '
        '--------------------------------------------------------------'
        ' PARÂMETRO:                                                   '
        '                                                              '
        ' 1 - strNumeroCPF(Valor digitado - Tipo String)               '
        '--------------------------------------------------------------'
        Dim intSoma As Short
        Dim intMult As Short
        Dim intDigito As Short
        Dim intC As Short
        Dim intI As Short
        'strNumeroCPF = gstrTiraCaracterAlfa(strNumeroCPF)
        If Len(strNumeroCPF) = 0 Or Len(strNumeroCPF) > 11 Then
            Exit Function
        ElseIf Len(strNumeroCPF) < 11 Then
            strNumeroCPF = New String("0", 11 - Len(strNumeroCPF)) & strNumeroCPF
        End If
        For intC = 9 To 10
            intMult = 2
            intSoma = 0
            For intI = intC To 1 Step -1
                intSoma = intSoma + (Val(Mid(strNumeroCPF, intI, 1)) * intMult)
                intMult = intMult + 1
            Next intI
            If intSoma Mod 11 < 2 Then
                intDigito = 0
            Else
                intDigito = 11 - (intSoma Mod 11)
            End If
            If intDigito <> Val(Mid(strNumeroCPF, intC + 1, 1)) Then
                Exit Function
            End If
        Next
        CPFOk = True
    End Function

    Public Function ValidaTituloEleitor(ByVal astrTitulo As String) As Boolean
        Dim strTitulo As String
        Dim lngSoma As Integer
        Dim lngResultado As Integer
        Dim intPasso As Short
        Dim intCDV1 As Short
        Dim intCDV2 As Short
        Dim intODV1 As Short
        Dim intODV2 As Short
        Dim intUF As Short

        ValidaTituloEleitor = False

        'Retira os caracteres inválidos
        strTitulo = Replace(Replace(Replace(Trim(astrTitulo), "/", ""), ".", ""), "-", "")

        'Prepara o titulo para que o mesmo tenha somente 12 digitos
        strTitulo = Right("000000000000" & strTitulo, 12)

        intODV1 = Val(Mid(strTitulo, 11, 1))
        intODV2 = Val(Mid(strTitulo, 12, 1))
        'Válida se o nono e o décimo digitos correspodem a algum estado
        '01-SP, 02-MG, 03-RJ, 04-RS, 05-BA, 06-PR, 07-CE, 08-PE, 09-SC, 10-GO, 11-MA, 12-PB, 13-PA, 14-ES,
        '15-PI, 16-RN, 17-AL, 18-MT, 19-MS, 20-DF, 21-SE, 22-AM, 23-RO, 24-AC, 25-AP, 26-RR, 27-TO, 28-Exterior(ZZ).
        intUF = Val(Mid(strTitulo, 9, 2))
        If intUF < 1 And intUF > 28 Then Exit Function

        'Calcula o Digito Verificador 1
        lngSoma = 0
        For intPasso = 1 To 8
            lngSoma = lngSoma + (Val(Mid(strTitulo, intPasso, 1)) * (10 - intPasso))
        Next intPasso
        lngResultado = lngSoma Mod 11
        If lngResultado = 0 Then
            If (intUF = 1 Or intUF = 2) Then
                intCDV1 = 1
            Else
                intCDV1 = 0
            End If
        Else
            If lngResultado = 1 Then
                intCDV1 = 0
            Else
                intCDV1 = 11 - lngResultado
            End If
        End If
        If (intCDV1 <> intODV1) Then Exit Function
        'Calcula o Digito Verificador 2
        lngSoma = 0
        For intPasso = 9 To 10
            lngSoma = lngSoma + (Val(Mid(strTitulo, intPasso, 1)) * (13 - intPasso))
        Next intPasso
        lngSoma = lngSoma + (intCDV1 * 2)
        lngResultado = lngSoma Mod 11
        If lngResultado = 0 Then
            If (intUF = 1 Or intUF = 2) Then
                intCDV2 = 1
            Else
                intCDV2 = 0
            End If
        Else
            If lngResultado = 1 Then
                intCDV2 = 0
            Else
                intCDV2 = 11 - lngResultado
            End If
        End If
        If (intCDV2 <> intODV2) Then Exit Function
        ValidaTituloEleitor = True
    End Function

    Public Function Valida_CEP(ByRef cep As String) As String
        '--- Essa função mascara uma string para o formato de C.E.P.
        cep = Str_Retira(cep, "/\()-=.+*[]}{ ")
        If Len(cep) = 5 Then
            '88704 -> 88704-000
            cep = cep & "-000"
        End If
        If Len(cep) = 8 Then
            '88704320 -> 88704-200
            cep = Mid(cep, 1, 5) & "-" & Mid(cep, 6, 7)
        End If
        Valida_CEP = cep
    End Function

    Public Function Valida_Data_Dia_Mes(ByRef data As String) As String
        '--- Essa função mascara uma string para o formato de dia/mes
        Dim temp As String
        temp = Str_Retira(data, "/\()-=.+*[]}{: ")
        Valida_Data_Dia_Mes = Mid(temp, 1, 2) & "/" & Mid(temp, 3, 2)
    End Function

    Public Function Valida_Data(ByRef data As String) As String
        '--- Essa função mascara uma string para o formato de data
        '--- Conforme configuração do Windows.
        Dim temp As String
        temp = Str_Retira(data, "/\()-=.+*[]}{: ")
        Select Case Len(temp)
            Case 6
                '111102   -> 11/11/02'
                temp = VB6.Format(temp, "##/##/##")
            Case 8
                '11112002 -> 11/11/2002'
                temp = VB6.Format(temp, "##/##/####")
            Case 14
                '11112002121000 -> 11/11/2002'
                temp = Mid(temp, 1, 8)
                temp = VB6.Format(temp, "##/##/####")
        End Select
        If Len(temp) > 0 Then
            'Configurar conforme configuração do windows (painel de controle, configurações regionais)
            If IsDate(temp) Then
                temp = FormatDateTime(CDate(temp), CShort("DD/MM/YYYY"))
            Else
                temp = ""
            End If
        End If
        Valida_Data = temp
    End Function

    Public Function ValidaMesAno(ByVal astrMesAno As String) As String
        Dim lstrRet As String

        lstrRet = Str_Retira(astrMesAno, "./-")
        Select Case Len(lstrRet)
            Case 1
                If Val(lstrRet) >= 1 Or Val(lstrRet) <= 12 Then
                    lstrRet = VB6.Format(lstrRet, "00") & "/" & VB6.Format(Today, "yyyy")
                Else
                    lstrRet = ""
                End If
            Case 2
                If Val(lstrRet) >= 1 Or Val(lstrRet) <= 12 Then
                    lstrRet = VB6.Format(lstrRet, "00") & "/" & VB6.Format(Today, "yyyy")
                Else
                    lstrRet = ""
                End If
            Case 3
                If Val(Left(lstrRet, 1)) >= 1 Or Val(Left(lstrRet, 1)) <= 9 Then
                    lstrRet = VB6.Format(Left(lstrRet, 1), "00") & "/" & IIf(CDbl(Right(lstrRet, 2)) >= 51, "19" & VB6.Format(Right(lstrRet, 2), "00"), "20" & VB6.Format(Right(lstrRet, 2), "00"))
                Else
                    lstrRet = ""
                End If
            Case 4
                If Val(Left(lstrRet, 2)) >= 1 Or Val(Left(lstrRet, 2)) <= 12 Then
                    lstrRet = VB6.Format(Left(lstrRet, 2), "00") & "/" & IIf(CDbl(Right(lstrRet, 2)) >= 51, "19" & VB6.Format(Right(lstrRet, 2), "00"), "20" & VB6.Format(Right(lstrRet, 2), "00"))
                Else
                    lstrRet = ""
                End If
            Case 5
                If Val(Left(lstrRet, 1)) >= 1 Or Val(Left(lstrRet, 1)) <= 9 Then
                    lstrRet = VB6.Format(Left(lstrRet, 1), "00") & "/" & VB6.Format(Right(lstrRet, 4), "0000")
                Else
                    lstrRet = ""
                End If
            Case 6
                If Val(Left(lstrRet, 2)) >= 1 Or Val(Left(lstrRet, 2)) <= 9 Then
                    lstrRet = VB6.Format(Left(lstrRet, 2), "00") & "/" & VB6.Format(Right(lstrRet, 4), "0000")
                Else
                    lstrRet = ""
                End If
            Case Else
                lstrRet = ""
        End Select
        ValidaMesAno = lstrRet
    End Function

    Public Function Str_Arruma(ByVal Entrada As String) As String
        Dim lstrRet As String
        Dim llngCon As Integer
        Dim llngTam As Integer
        Dim lstrAux As String
        Dim lblnAux As Boolean
        lblnAux = False
        lstrRet = Entrada
        llngTam = CDbl(Len(Entrada))
        If llngTam > 0 Then
            lstrRet = ""
            For llngCon = 1 To llngTam
                lstrAux = Mid(Entrada, llngCon, 1)
                If llngCon > 1 Then
                    If AscW(lstrAux) = System.Windows.Forms.Keys.Space Then
                        If lstrAux = Mid(Entrada, llngCon - 1, 1) Then
                            lstrAux = ""
                        End If
                    End If
                End If
                lstrRet = lstrRet & lstrAux
            Next llngCon
        End If
        Str_Arruma = lstrRet
    End Function

    Public Function Str_Retira(ByVal Entrada As String, ByVal Retirar As String, Optional ByVal Troca As String = "") As String
        Dim lstrRet As String
        Dim llngCo1 As Integer
        Dim llngCo2 As Integer
        Dim llngCo3 As Integer
        Dim lblnAux As Boolean
        Dim lstrAux As String
        Dim llngTa1 As Integer
        Dim llngTa2 As Integer
        Dim llngTa3 As Integer
        '
        lstrRet = Entrada
        llngTa1 = CDbl(Len(Entrada))
        llngTa2 = CDbl(Len(Retirar))
        llngTa3 = CDbl(Len(Troca))
        '
        If llngTa1 > 0 And llngTa2 > 0 Then
            lstrRet = ""
            For llngCo1 = 1 To llngTa1
                lstrAux = Mid(Entrada, llngCo1, 1)
                lblnAux = False
                For llngCo2 = 1 To llngTa2
                    If lstrAux = Mid(Retirar, llngCo2, 1) Then
                        lblnAux = True
                        llngCo3 = llngCo2
                        llngCo2 = llngTa2
                    End If
                Next llngCo2
                If Not lblnAux Then
                    lstrRet = lstrRet & lstrAux
                Else
                    If llngTa3 > 0 Then
                        If llngTa3 = llngTa2 Then
                            lstrRet = lstrRet & Mid(Troca, llngCo3, 1)
                        Else
                            lstrRet = lstrRet & Mid(Troca, 1, 1)
                        End If
                    End If
                End If
            Next llngCo1
        End If
        Str_Retira = lstrRet
    End Function

    Public Function Retorna_Semana(ByVal aBase As Date, Optional ByVal aAbreviado As Byte = 0) As String
        '--- Essa função retorna o nome da semana conforme a data
        Dim strNomeSemana As Object
        Dim intSemana As Short

        intSemana = Weekday(aBase, FirstDayOfWeek.Sunday)
        'UPGRADE_WARNING: Array has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
        'UPGRADE_WARNING: Couldn't resolve default property of object strNomeSemana. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
        strNomeSemana = New Object() {"Domingo", "Segunda-Feira", "Terça-Feira", "Quarta-Feira", "Quinta-Feira", "Sexta-Feira", "Sábado"}
        'UPGRADE_WARNING: Couldn't resolve default property of object strNomeSemana(). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
        Retorna_Semana = IIf(aAbreviado = 0, strNomeSemana(intSemana), Left(strNomeSemana(intSemana), 3))
    End Function

    Public Function Retorna_Mes(ByRef mes As Byte) As String
        '--- Essa função retorna o nome do mês conforme numero
        Retorna_Mes = ""
        Select Case mes
            Case 1
                Retorna_Mes = "Janeiro"
            Case 2
                Retorna_Mes = "Fevereiro"
            Case 3
                Retorna_Mes = "Março"
            Case 4
                Retorna_Mes = "Abril"
            Case 5
                Retorna_Mes = "Maio"
            Case 6
                Retorna_Mes = "Junho"
            Case 7
                Retorna_Mes = "Julho"
            Case 8
                Retorna_Mes = "Agosto"
            Case 9
                Retorna_Mes = "Setembro"
            Case 10
                Retorna_Mes = "Outubro"
            Case 11
                Retorna_Mes = "Novembro"
            Case 12
                Retorna_Mes = "Dezembro"
        End Select
    End Function

    Public Function FormataCNPJ(ByVal astrCNPJ As String) As String
        If CInt(Len(Trim(astrCNPJ))) > 0 Then
            astrCNPJ = VB6.Format(astrCNPJ, "00000000000000")
            astrCNPJ = Mid(astrCNPJ, 1, 2) & "." & Mid(astrCNPJ, 3, 3) & "." & Mid(astrCNPJ, 6, 3) & "/" & Mid(astrCNPJ, 9, 4) & "-" & Mid(astrCNPJ, 13, 2)
        Else
            astrCNPJ = ""
        End If
        FormataCNPJ = astrCNPJ
    End Function

    Public Function FormataCPF(ByVal astrCpf As String) As String
        If CInt(Len(Trim(astrCpf))) > 0 Then
            astrCpf = VB6.Format(astrCpf, "00000000000")
            astrCpf = Mid(astrCpf, 1, 3) & "." & Mid(astrCpf, 4, 3) & "." & Mid(astrCpf, 7, 3) & "-" & Mid(astrCpf, 10, 2)
        Else
            astrCpf = ""
        End If
        FormataCPF = astrCpf
    End Function

    Public Function FormataHashCod(ByVal astrHashCod As String) As String
        Dim lstrRetorno As String
        lstrRetorno = astrHashCod
        If CInt(Len(Trim(lstrRetorno))) = 0 Then
            lstrRetorno = "0"
        End If
        lstrRetorno = VB6.Format(lstrRetorno, New String("0", 32))
        lstrRetorno = Mid(lstrRetorno, 1, 4) & "." & Mid(lstrRetorno, 5, 4) & "." & Mid(lstrRetorno, 9, 4) & "." & Mid(lstrRetorno, 13, 4) & "." & Mid(lstrRetorno, 17, 4) & "." & Mid(lstrRetorno, 21, 4) & "." & Mid(lstrRetorno, 25, 4) & "." & Mid(lstrRetorno, 29, 4)

        FormataHashCod = lstrRetorno
    End Function

    Public Function FormataTel(ByVal astrTel As String) As String
        astrTel = Left(VB6.Format(Str_Retira(astrTel, ".-/ "), "00000000"), 8)
        If CInt(Len(Trim(astrTel))) > 0 Then
            astrTel = Left(astrTel, 4) & "-" & Right(astrTel, 4)
        Else
            astrTel = ""
        End If
        FormataTel = astrTel
    End Function

    Public Function FormataCep(ByVal astrCep As String) As String
        Dim intTam As Short

        astrCep = Left(Str_Retira(astrCep, ".-/ "), 8)
        intTam = Len(Trim(astrCep))
        If intTam > 0 Then
            Select Case intTam
                Case 1
                    astrCep = astrCep & "0000000"
                Case 2
                    astrCep = astrCep & "000000"
                Case 3
                    astrCep = astrCep & "00000"
                Case 4
                    astrCep = astrCep & "0000"
                Case 5
                    astrCep = astrCep & "000"
                Case 6
                    astrCep = astrCep & "00"
                Case 7
                    astrCep = astrCep & "0"
                Case 8
                    astrCep = astrCep
            End Select
            astrCep = Left(astrCep, 2) & "." & Mid(astrCep, 3, 3) & "-" & Right(astrCep, 3)
        Else
            astrCep = ""
        End If
        FormataCep = astrCep
    End Function

    Public Sub Acesso_Menu()
        Dim lstrMCp As String
        Dim lstrMNm As String
        Dim lmd5Aux As clsMd5
        Dim lintIdx As Short
        Dim lintIx2 As Short
        Dim lstrVlr As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lmd5Aux = New clsMd5

        ' ----- Desabilita todos os menus
        With FrmAtPrincipal
            'UPGRADE_WARNING: Controls method Controls.Count has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
            For lintIdx = 0 To .Controls.Count() - 1
                'UPGRADE_WARNING: TypeOf has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
                If TypeOf .Controls(lintIdx) Is System.Windows.Forms.ToolStripMenuItem Then
                    lstrMCp = Replace(.Controls(lintIdx).Text, "&", "")
                    If lstrMCp <> "" And lstrMCp <> "-" Then
                        Call CallByName(.Controls(lintIdx), "Enabled", CallType.Set, False)
                    End If
                End If
            Next lintIdx
            ' ----- Habilita os menus que o usuário tiver acesso
            'UPGRADE_WARNING: Controls method Controls.Count has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
            For lintIdx = 0 To .Controls.Count() - 1
                'UPGRADE_WARNING: TypeOf has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
                If TypeOf .Controls(lintIdx) Is System.Windows.Forms.ToolStripMenuItem Then
                    lstrMNm = .Controls(lintIdx).Name
                    lstrMCp = Replace(.Controls(lintIdx).Text, "&", "")
                    If lstrMCp <> "" And lstrMCp <> "-" Then
                        ' ----- Busca a situação do menu no banco
                        lstrSql = ""
                        lstrSql = lstrSql & "SELECT `usuarios_permissao_menu`.`valor` "
                        lstrSql = lstrSql & "  FROM `usuarios_permissao_menu` "
                        lstrSql = lstrSql & " WHERE `usuarios_permissao_menu`.`idusuarios` = " & glngUsuario_Id
                        lstrSql = lstrSql & "   AND `usuarios_permissao_menu`.`idmenus`    = '" & LCase(lmd5Aux.DigestStrToHexStr(lstrMNm)) & "' "
                        Call Conectar(lstrSql, lrstAux)
                        With lrstAux
                            If .RecordCount > 0 Then
                                'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                lstrVlr = IIf(IsDBNull(.Fields("valor").Value), "", .Fields("valor").Value)
                                If lstrVlr = LCase(lmd5Aux.DigestStrToHexStr(lstrMNm & "_SIM")) Then
                                    Call CallByName(CType(FrmAtPrincipal.Controls(lintIdx), Object), "Enabled", CallType.Set, True)
                                Else
                                    Call CallByName(CType(FrmAtPrincipal.Controls(lintIdx), Object), "Enabled", CallType.Set, False)
                                    If Not gblnUsuario_Opcao Then
                                        Call CallByName(CType(FrmAtPrincipal.Controls(lintIdx), Object), "Visible", CallType.Set, False)
                                        'UPGRADE_WARNING: Controls method Controls.Count has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
                                        For lintIx2 = lintIdx + 1 To FrmAtPrincipal.Controls.Count() - 1
                                            'UPGRADE_WARNING: Controls method Controls.Count has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
                                            If lintIx2 < FrmAtPrincipal.Controls.Count() Then
                                                'UPGRADE_WARNING: TypeOf has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
                                                If TypeOf CType(FrmAtPrincipal.Controls(lintIx2), Object) Is System.Windows.Forms.ToolStripMenuItem Then
                                                    If Trim(Replace(CType(FrmAtPrincipal.Controls(lintIx2), Object).Text, "&", "")) = "-" Then
                                                        Call CallByName(CType(FrmAtPrincipal.Controls(lintIx2), Object), "Visible", CallType.Set, False)
                                                    End If
                                                    'UPGRADE_WARNING: Controls method Controls.Count has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
                                                    lintIx2 = FrmAtPrincipal.Controls.Count()
                                                End If
                                            End If
                                        Next lintIx2
                                    End If
                                End If
                            Else
                                If .State > 0 Then Call .Close()
                                lstrSql = ""
                                lstrSql = lstrSql & "SELECT `usuarios_grupos_permissao_menu`.`valor` "
                                lstrSql = lstrSql & "  FROM `usuarios_grupos_permissao_menu` "
                                lstrSql = lstrSql & " WHERE `usuarios_grupos_permissao_menu`.`idgrupos` = " & glngUsuario_IdGrupo
                                lstrSql = lstrSql & "   AND `usuarios_grupos_permissao_menu`.`idmenus`  = '" & LCase(lmd5Aux.DigestStrToHexStr(lstrMNm)) & "' "
                                Call Conectar(lstrSql, lrstAux)
                                If .RecordCount > 0 Then
                                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                    lstrVlr = IIf(IsDBNull(.Fields("valor").Value), "", .Fields("valor").Value)
                                    If lstrVlr = LCase(lmd5Aux.DigestStrToHexStr(lstrMNm & "_SIM")) Then
                                        Call CallByName(CType(FrmAtPrincipal.Controls(lintIdx), Object), "Enabled", CallType.Set, True)
                                    Else
                                        Call CallByName(CType(FrmAtPrincipal.Controls(lintIdx), Object), "Enabled", CallType.Set, False)
                                        If Not gblnUsuario_Opcao Then
                                            Call CallByName(CType(FrmAtPrincipal.Controls(lintIdx), Object), "Visible", CallType.Set, False)
                                            'UPGRADE_WARNING: Controls method Controls.Count has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
                                            For lintIx2 = lintIdx + 1 To FrmAtPrincipal.Controls.Count() - 1
                                                'UPGRADE_WARNING: Controls method Controls.Count has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
                                                If lintIx2 < FrmAtPrincipal.Controls.Count() Then
                                                    'UPGRADE_WARNING: TypeOf has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
                                                    If TypeOf CType(FrmAtPrincipal.Controls(lintIx2), Object) Is System.Windows.Forms.ToolStripMenuItem Then
                                                        If Trim(Replace(CType(FrmAtPrincipal.Controls(lintIx2), Object).Text, "&", "")) = "-" Then
                                                            Call CallByName(CType(FrmAtPrincipal.Controls(lintIx2), Object), "Visible", CallType.Set, False)
                                                        End If
                                                        'UPGRADE_WARNING: Controls method Controls.Count has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
                                                        lintIx2 = FrmAtPrincipal.Controls.Count()
                                                    End If
                                                End If
                                            Next lintIx2
                                        End If
                                    End If
                                Else
                                    Call CallByName(CType(FrmAtPrincipal.Controls(lintIdx), Object), "Enabled", CallType.Set, False)
                                    If Not gblnUsuario_Opcao Then
                                        'Call CallByName(FrmAtPrincipal.Controls(lintIdx), "Visible", VbLet, False)
                                    End If
                                End If
                            End If
                            If .State > 0 Then Call .Close()
                        End With
                    End If
                End If
            Next lintIdx
        End With
        'UPGRADE_NOTE: Object lmd5Aux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lmd5Aux = Nothing
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
    End Sub

    Public Function ValidaZona(ByVal astrZona As String) As Boolean
        Dim lblnRet As Boolean
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lblnRet = False
        lstrSql = ""
        lstrSql = lstrSql & "SELECT "
        lstrSql = lstrSql & "       cod "
        lstrSql = lstrSql & "  FROM munic "
        lstrSql = lstrSql & " WHERE zona = '" & astrZona & "' "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                lblnRet = (.RecordCount > 0)
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        ValidaZona = lblnRet
    End Function

    Public Function ValidaView(ByVal astrView As String) As Boolean
        Dim lblnRet As Boolean
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lblnRet = False
        lstrSql = ""
        lstrSql = lstrSql & "SELECT * "
        lstrSql = lstrSql & "  FROM `" & gstrDBEsquema & "`.`" & gstrDBVisao & "` "
        lstrSql = lstrSql & " WHERE `" & gstrDBEsquema & "`.`" & gstrDBVisao & "`.`TABLE_SCHEMA` = '" & gstrDataBase & "' " & vbCrLf
        lstrSql = lstrSql & "   AND `" & gstrDBEsquema & "`.`" & gstrDBVisao & "`.`TABLE_NAME`   = '" & astrView & "' " & vbCrLf
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                lblnRet = .RecordCount > 0
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        ValidaView = lblnRet
    End Function

    Public Function ValidaSentencaFrase(ByVal astrTexto As String) As Boolean
        Dim lblnRet As Boolean
        Dim lstrAux As String
        Dim llngTam As Integer
        Dim llngCon As Integer
        Dim llngQtdePalavras As Integer
        Dim llngLetraRepetida As Integer 'desconsiderar o rr e ss
        lblnRet = False
        lstrAux = astrTexto
        llngTam = CInt(Len(lstrAux))
        llngQtdePalavras = 0
        llngLetraRepetida = 0
        For llngCon = 1 To llngTam
            If Mid(lstrAux, llngCon, 1) = " " Then
                llngQtdePalavras = llngQtdePalavras + 1
            End If
            If llngCon > 1 Then
                If UCase(Mid(lstrAux, llngCon, 1)) <> "R" And UCase(Mid(lstrAux, llngCon, 1)) <> "S" Then
                    If Mid(lstrAux, llngCon, 1) = Mid(lstrAux, llngCon - 1, 1) Then
                        llngLetraRepetida = llngLetraRepetida + 1
                    End If
                End If
            End If
        Next llngCon
        llngQtdePalavras = llngQtdePalavras + 1
        If llngQtdePalavras < 3 Then
            lblnRet = True
        End If
        If llngLetraRepetida > 0 Then
            lblnRet = True
        End If
        ValidaSentencaFrase = lblnRet
    End Function

    Public Function BuscaNomeUsuario(ByVal alngIdUsuario As Integer) As String
        Dim lstrRet As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lstrRet = ""
        lstrSql = ""
        lstrSql = lstrSql & "SELECT `usuarios`.`id`, "
        lstrSql = lstrSql & "       `usuarios`.`nome` "
        lstrSql = lstrSql & "  FROM `usuarios` "
        lstrSql = lstrSql & " WHERE `usuarios`.`id` = " & alngIdUsuario & " "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    lstrRet = IIf(IsDBNull(.Fields("nome").Value), "", .Fields("nome").Value)
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaNomeUsuario = lstrRet
    End Function

    Public Function BuscaCodigoEstadoCivil(ByVal astrDescricao As String) As Integer
        Dim llngRet As Integer
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        llngRet = 0
        lstrSql = ""
        lstrSql = lstrSql & "SELECT *"
        lstrSql = lstrSql & "  FROM `estado_civil` "
        lstrSql = lstrSql & " WHERE `descricao` LIKE '%" & astrDescricao & "%' "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    llngRet = CInt(IIf(IsDBNull(.Fields("id").Value), "0", .Fields("id").Value))
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaCodigoEstadoCivil = llngRet
    End Function

    Public Function BuscaDescricaoClasse(ByVal astrCodigo As String) As String
        Dim lstrRet As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lstrRet = ""
        lstrSql = ""
        lstrSql = lstrSql & "SELECT *"
        lstrSql = lstrSql & "  FROM `classe` "
        lstrSql = lstrSql & " WHERE `codigo` = '" & astrCodigo & "' "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    lstrRet = IIf(IsDBNull(.Fields("descricao").Value), "", .Fields("descricao").Value)
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaDescricaoClasse = lstrRet
    End Function

    Public Function BuscaDescricaoSituacao(ByVal alngIdSituacao As Integer) As String
        Dim lstrRet As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lstrRet = ""
        lstrSql = ""
        lstrSql = lstrSql & "SELECT `situacao`.`id`, "
        lstrSql = lstrSql & "       `situacao`.`descricao` "
        lstrSql = lstrSql & "  FROM `situacao` "
        lstrSql = lstrSql & " WHERE `situacao`.`id` = " & alngIdSituacao & " "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    lstrRet = IIf(IsDBNull(.Fields("descricao").Value), "", .Fields("descricao").Value)
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaDescricaoSituacao = lstrRet
    End Function

    Public Function BuscaBandeira(ByVal adteVigencia As Date, ByRef adteBandeira As Date) As Integer
        Dim llngRet As Integer
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        llngRet = 0
        lstrSql = ""
        lstrSql = lstrSql & "SELECT * "
        lstrSql = lstrSql & "  FROM bandeiras "
        lstrSql = lstrSql & " WHERE vigencia <= '" & VB6.Format(adteVigencia, "yyyy-MM-dd") & "' "
        lstrSql = lstrSql & " ORDER BY vigencia DESC LIMIT 0, 1"
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    llngRet = CInt(IIf(IsDBNull(.Fields("idtipo_bandeira").Value), 0, .Fields("idtipo_bandeira").Value))
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    adteBandeira = CDate(IIf(IsDBNull(.Fields("vigencia").Value), "1900-01-01", .Fields("vigencia").Value))
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaBandeira = llngRet
    End Function

    Public Function BuscaTipoPadraoMedidor_Medidores(ByVal alngIdMedidor As Integer) As Integer
        Dim llngRet As Integer
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        llngRet = 0
        lstrSql = ""
        lstrSql = lstrSql & "SELECT `medidores`.`id`, "
        lstrSql = lstrSql & "       `medidores`.`idtipo_padrao_medicao` "
        lstrSql = lstrSql & "  FROM `medidores` "
        lstrSql = lstrSql & " WHERE `medidores`.`id` = " & alngIdMedidor & " "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    llngRet = IIf(IsDBNull(.Fields("idtipo_padrao_medicao").Value), 0, .Fields("idtipo_padrao_medicao").Value)
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaTipoPadraoMedidor_Medidores = llngRet
    End Function

    Public Function BuscaCampoDescricaoTabelaPadrao(ByVal astrTabela As String, ByVal astrCampoDescricao As String, ByVal alngId_A As Integer) As Object
        Dim lstrRet As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        If ValidaView(astrTabela) Then
            astrTabela = Mid(astrTabela, 3)
        End If
        If alngId_A > 0 Then
            lstrRet = ""
            lstrSql = ""
            lstrSql = lstrSql & "SELECT * " & vbCrLf
            lstrSql = lstrSql & "  FROM `" & astrTabela & "` " & vbCrLf
            lstrSql = lstrSql & " WHERE `id` = " & alngId_A
            Call Conectar(lstrSql, lrstAux)
            With lrstAux
                If .State = ADODB.ObjectStateEnum.adStateOpen Then
                    If .RecordCount > 0 Then
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrRet = Trim(IIf(IsDBNull(.Fields(astrCampoDescricao).Value), "", .Fields(astrCampoDescricao).Value))
                    End If
                    Call .Close()
                End If
            End With
        End If
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        'UPGRADE_WARNING: Couldn't resolve default property of object BuscaCampoDescricaoTabelaPadrao. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
        BuscaCampoDescricaoTabelaPadrao = lstrRet
    End Function

    Public Function BuscaCampoDescricaoTabela(ByVal astrTabela As String, ByVal astrCampoDescricao As String, ByVal astrCampoId As String, ByVal alngCodigo As Integer, Optional ByVal astrCampoIdSistema As String = "", Optional ByRef alngCodigoSistema As Integer = 0) As String
        Dim lstrRet As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        'If alngCodigo > 0 Then
        lstrRet = ""
        lstrSql = ""
        lstrSql = lstrSql & "SELECT * " & vbCrLf
        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`" & astrTabela & "` " & vbCrLf
        lstrSql = lstrSql & " WHERE `" & astrCampoId & "` = " & alngCodigo
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    lstrRet = Trim(IIf(IsDBNull(.Fields(astrCampoDescricao).Value), "", .Fields(astrCampoDescricao).Value))
                    If astrCampoIdSistema <> "" Then
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        alngCodigoSistema = IIf(IsDBNull(.Fields(astrCampoIdSistema).Value), 0, .Fields(astrCampoIdSistema).Value)
                    End If
                End If
                Call .Close()
            End If
        End With
        'End If
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaCampoDescricaoTabela = lstrRet
    End Function

    Public Function BuscaNomeExecutor(ByVal alngCodigo As Integer) As String
        Dim lstrRet As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lstrRet = "Ex.não enc."
        lstrSql = ""
        lstrSql = lstrSql & "SELECT * "
        lstrSql = lstrSql & "  FROM `executor` "
        lstrSql = lstrSql & " WHERE `cod` = " & alngCodigo & " "
        lstrSql = lstrSql & " LIMIT 0, 1 "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    lstrRet = IIf(IsDBNull(.Fields("descricao").Value), "Executor não encontrado", .Fields("descricao").Value)
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaNomeExecutor = lstrRet
    End Function

    Public Function ChecaPrazoFatura(ByVal adblNumNf As Double, ByVal astrMesAno As String) As Date
        Dim ldtePra As Date
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lstrSql = ""
        lstrSql = lstrSql & "SELECT `nf`.`numnf`, `nf`.`mesano`, `nf`.`dataprazo` "
        lstrSql = lstrSql & "  FROM `nf` "
        lstrSql = lstrSql & " WHERE `nf`.`numnf`  = " & adblNumNf & " "
        lstrSql = lstrSql & "   AND `nf`.`mesano` = '" & astrMesAno & "' "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State > 0 Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    ldtePra = CDate(IIf(IsDBNull(.Fields("dataprazo").Value), "1900-01-01", .Fields("dataprazo").Value))
                End If
                Call .Close()
            End If
        End With
        ChecaPrazoFatura = ldtePra
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
    End Function

    Public Function BuscaQtdeSuspensao(ByVal alngConsId As Integer, ByVal alngUnidId As Integer, ByVal alngQtde As Integer) As Integer
        Dim lintDia As Short
        Dim lintBiS As Short
        Dim ldteIni As Date
        Dim ldteFim As Date
        Dim llngRet As Integer
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        ldteIni = BuscaDataBD()
        lintBiS = fnMod(Year(ldteIni), 4)
        lintDia = IIf(lintBiS = 0, 366, 365)
        ldteFim = System.DateTime.FromOADate(DateSerial(Year(ldteIni), Month(ldteIni), VB.Day(ldteIni)).ToOADate - lintDia)
        llngRet = 0
        lstrSql = ""
        lstrSql = lstrSql & "SELECT `cons_id`, " & IIf(alngUnidId > 0, "`unid_id`,", "") & "COUNT(*) `qtde` "
        lstrSql = lstrSql & "FROM `concorte2` "
        lstrSql = lstrSql & "WHERE (`datacorte` <= '" & VB6.Format(ldteIni, "yyyy-MM-dd") & " 00:00:01' AND `datacorte` >= '" & VB6.Format(ldteFim, "yyyy-MM-dd") & " 23:59:59') "
        lstrSql = lstrSql & "AND `cons_id` = " & alngConsId & " "
        If alngUnidId > 0 Then
            lstrSql = lstrSql & "AND `unid_id` = " & alngUnidId & " "
        End If
        lstrSql = lstrSql & "GROUP BY `cons_id`" & IIf(alngUnidId > 0, ",`unid_id`", "") & " "
        lstrSql = lstrSql & "ORDER BY `cons_id` ASC, " & IIf(alngUnidId > 0, "`unid_id` ASC, ", "") & "`datacorte` DESC "
        lstrSql = lstrSql & "LIMIT 0, " & alngQtde & " "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    llngRet = IIf(IsDBNull(.Fields("qtde").Value), 0, .Fields("qtde").Value)
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        BuscaQtdeSuspensao = llngRet
    End Function

    Public Function fnMod(ByVal valor As Object, ByVal Divisor As Object) As Short
        Dim lintRet As Short
        lintRet = 0
        If IsNumeric(valor) And IsNumeric(Divisor) Then
            'UPGRADE_WARNING: Couldn't resolve default property of object Divisor. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            If Divisor > 0 Then
                'UPGRADE_WARNING: Couldn't resolve default property of object Divisor. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                'UPGRADE_WARNING: Couldn't resolve default property of object valor. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                lintRet = CShort(valor - (Divisor * CShort(valor / Divisor)))
            Else
                Call MsgBox("Divisor não pode ser ZERO!", MsgBoxStyle.Critical, gstrTituloMensagem)
                lintRet = 1
            End If
        Else
            Call MsgBox("A parametro valor ou parametro divisor não é um valor numérico!", MsgBoxStyle.Critical, gstrTituloMensagem)
            lintRet = 1
        End If
        fnMod = lintRet
    End Function

    Public Function TarifaProporcional(ByVal adteLeitAnterior As Date, ByVal adteLeitAtual As Date, ByVal astrCodTarifa As String, ByVal aintTipoBandeira As Short, Optional ByRef astrTexto As String = "", Optional ByRef aintTipoTarifa As Short = 0) As Double
        Dim ldblTotTarifa As Double 'Resultado Final
        Dim ldblTotTarifaAnt As Double 'Resultado Final
        Dim ldblTotTarifaNov As Double 'Resultado Final
        Dim ldblTarAnter_VD As Double 'Valor da tarifa anterior Verde
        Dim ldblTarAnter_AM As Double 'Valor da tarifa anterior Amarela
        Dim ldblTarAnter_VM As Double 'Valor da tarifa anterior Vermelha
        Dim ldteTarAnter As Date 'Data da tarifa anterior
        Dim ldteTarAnter_BD As Date 'Data da tarifa anterior Bandeira
        Dim ldblTarAtual_VD As Double 'Valor da tarifa atual Verde
        Dim ldblTarAtual_AM As Double 'Valor da tarifa atual Amarela
        Dim ldblTarAtual_VM As Double 'Valor da tarifa atual Vermelha
        Dim ldteTarAtual As Date 'Data da tarifa atual
        Dim ldteTarAtual_BD As Date 'Data da tarifa atual Bandeira
        Dim ldteLeitAnter As Date 'Data da leitura anterior
        Dim ldteleitAtual As Date 'Data da leitura atual
        Dim llngDiasAtual As Integer 'Qtde de dias da tarifa atual
        Dim llngDiasAnter As Integer 'Qtde de dias da tarifa anterior
        Dim llngBanAnter As Integer 'Tipo de bandeira
        Dim llngBanAtual As Integer 'Tipo de bandeira
        Dim ldtDataDescontoSP As Date 'Data do começo do desconto da porcentagem da tarifa - serviço público
        Dim lintPorcDescontoSP_Ant As Short 'Porcentagem do desconto da tarifa - serviço público 15%
        Dim lintPorcDescontoSP_Nov As Short 'Porcentagem do desconto da tarifa - serviço público 12%

        Dim ldteLoop As Date
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        '
        lrstAux = New ADODB.Recordset
        lstrSql = ""
        lstrSql = lstrSql & "SELECT * "
        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`tarifa` "
        lstrSql = lstrSql & " WHERE `num` = '" & astrCodTarifa & "' "
        lstrSql = lstrSql & "   AND NOT ISNULL(`datanova`) "
        lstrSql = lstrSql & "   AND `referencia` <> '1951-01-01' "
        lstrSql = lstrSql & "   AND `referencia` <= '" & VB6.Format(adteLeitAtual, "yyyy-MM-dd") & "' "
        lstrSql = lstrSql & " ORDER BY `referencia` DESC LIMIT 0, 2 "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    If aintTipoTarifa = 0 Then
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldblTarAtual_VD = IIf(IsDBNull(.Fields("valor").Value), 0, .Fields("valor").Value)
                    ElseIf aintTipoTarifa = 1 Then
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldblTarAtual_VD = IIf(IsDBNull(.Fields("valor_base_economica").Value), 0, .Fields("valor_base_economica").Value)
                    ElseIf aintTipoTarifa = 2 Then
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldblTarAtual_VD = IIf(IsDBNull(.Fields("valor_sem_subsidio").Value), 0, .Fields("valor_sem_subsidio").Value)
                    End If
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    ldblTarAtual_AM = IIf(IsDBNull(.Fields("valor_amarela").Value), 0, .Fields("valor_amarela").Value)
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    ldblTarAtual_VM = IIf(IsDBNull(.Fields("valor_vermelha").Value), 0, .Fields("valor_vermelha").Value)
                    If ldblTarAtual_AM = 0 Then ldblTarAtual_AM = ldblTarAtual_VD
                    If ldblTarAtual_VM = 0 Then ldblTarAtual_VM = ldblTarAtual_VD
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    ldteTarAtual = IIf(IsDBNull(.Fields("datanova").Value), "1951-01-01", .Fields("datanova").Value)
                    If .RecordCount = 2 Then
                        Call .MoveNext()
                    End If
                    If aintTipoTarifa = 0 Then
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldblTarAnter_VD = IIf(IsDBNull(.Fields("valor").Value), 0, .Fields("valor").Value)
                    ElseIf aintTipoTarifa = 1 Then
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldblTarAnter_VD = IIf(IsDBNull(.Fields("valor_base_economica").Value), 0, .Fields("valor_base_economica").Value)
                    ElseIf aintTipoTarifa = 2 Then
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldblTarAnter_VD = IIf(IsDBNull(.Fields("valor_sem_subsidio").Value), 0, .Fields("valor_sem_subsidio").Value)
                    End If
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    ldblTarAnter_AM = IIf(IsDBNull(.Fields("valor_amarela").Value), 0, .Fields("valor_amarela").Value)
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    ldblTarAnter_VM = IIf(IsDBNull(.Fields("valor_vermelha").Value), 0, .Fields("valor_vermelha").Value)
                    If ldblTarAnter_AM = 0 Then ldblTarAnter_AM = ldblTarAnter_VD
                    If ldblTarAnter_VM = 0 Then ldblTarAnter_VM = ldblTarAnter_VD
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    ldteTarAnter = IIf(IsDBNull(.Fields("datanova").Value), "1951-01-01", .Fields("datanova").Value)
                End If
                Call .Close()
            End If
        End With
        '
        'UPGRADE_WARNING: DateValue has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
        ldteLeitAnter = DateValue(CStr(adteLeitAnterior))
        ldteleitAtual = adteLeitAtual
        '
        If ldteleitAtual > ldteTarAtual And ldteLeitAnter < ldteTarAtual Then
            llngDiasAtual = (ldteleitAtual.ToOADate - ldteTarAtual.ToOADate)
            llngDiasAnter = ldteTarAtual.ToOADate - ldteLeitAnter.ToOADate
        ElseIf ldteleitAtual <= ldteTarAtual And ldteLeitAnter < ldteTarAtual Then
            llngDiasAtual = 0
            llngDiasAnter = 1
        Else
            llngDiasAtual = 1
            llngDiasAnter = 0
        End If

        If astrCodTarifa = "01B3201101" Then
            'Se a classe for serviço público desconta 15%(depois de 29/09/2019 muda para 12%) na tarifa - Arlindo
            ldtDataDescontoSP = CDate(Trim(LeConfig("DESCONTO_SP_DATA")))
            If BuscaDataBD() >= ldtDataDescontoSP Then
                ldblTotTarifa = ((ldblTarAtual_VD * llngDiasAtual) + (ldblTarAnter_VD * llngDiasAnter)) / (llngDiasAtual + llngDiasAnter)
            Else
                lintPorcDescontoSP_Ant = CShort(Trim(LeConfig("DESCONTO_SP_ANTIGO")))
                lintPorcDescontoSP_Nov = CShort(Trim(LeConfig("DESCONTO_SP_NOVO")))

                ldblTotTarifaNov = ldblTarAtual_VD - ((ldblTarAtual_VD * lintPorcDescontoSP_Nov) / 100)
                ldblTotTarifaNov = ((ldblTotTarifaNov / (llngDiasAtual + llngDiasAnter)) * llngDiasAtual)

                ldblTotTarifaAnt = ldblTarAnter_VD - ((ldblTarAnter_VD * lintPorcDescontoSP_Ant) / 100)
                ldblTotTarifaAnt = ((ldblTotTarifaAnt / (llngDiasAtual + llngDiasAnter)) * llngDiasAnter)

                ldblTotTarifa = ldblTotTarifaNov + ldblTotTarifaAnt
            End If
        Else
            ldblTotTarifa = ((ldblTarAtual_VD * llngDiasAtual) + (ldblTarAnter_VD * llngDiasAnter)) / (llngDiasAtual + llngDiasAnter)
        End If

        If aintTipoBandeira <> 3 Then
            If gdteDataBandeiraInicio <= gDtBcoDados Then
                '
                'Controle bandeiras
                '1 = vermelha
                '2 = amarela
                '3 = verde
                lstrSql = ""
                lstrSql = lstrSql & "SELECT * "
                lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`bandeiras` "
                lstrSql = lstrSql & " WHERE `vigencia` <= '" & VB6.Format(adteLeitAtual, "yyyy-MM-dd") & "' "
                lstrSql = lstrSql & " ORDER BY `vigencia` DESC LIMIT 0, 2 "
                Call Conectar(lstrSql, lrstAux)
                With lrstAux
                    If .State = ADODB.ObjectStateEnum.adStateOpen Then
                        If .RecordCount > 0 Then
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldteTarAtual_BD = IIf(IsDBNull(.Fields("vigencia").Value), "1951-01-01", .Fields("vigencia").Value)
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            llngBanAtual = IIf(IsDBNull(.Fields("idtipo_bandeira").Value), 1, .Fields("idtipo_bandeira").Value)
                            If .RecordCount = 2 Then
                                Call .MoveNext()
                            End If
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldteTarAnter_BD = IIf(IsDBNull(.Fields("vigencia").Value), "1951-01-01", .Fields("vigencia").Value)
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            llngBanAnter = IIf(IsDBNull(.Fields("idtipo_bandeira").Value), 1, .Fields("idtipo_bandeira").Value)
                            If ldteTarAnter_BD < CDate("2015-01-01") Then
                                llngBanAnter = 3
                            End If
                        End If
                        Call .Close()
                    End If
                End With
                ldblTotTarifa = 0
                ldteLoop = ldteLeitAnter
                If llngDiasAtual = 1 And llngDiasAnter = 0 Then
                    ldblTotTarifa = IIf(llngBanAtual = 1, ldblTarAtual_VM, IIf(llngBanAtual = 2, ldblTarAtual_AM, 0))
                ElseIf llngDiasAtual = 0 And llngDiasAnter = 1 Then
                    ldblTotTarifa = IIf(llngBanAtual = 1, ldblTarAnter_VM, IIf(llngBanAtual = 2, ldblTarAnter_AM, 0))
                Else
                    While ldteLoop <= ldteTarAtual_BD Or ldteLoop < ldteTarAtual
                        If ldteLoop >= ldteTarAnter_BD And ldteLoop < ldteTarAtual Then
                            ldblTotTarifa = ldblTotTarifa + IIf(llngBanAnter = 1, ldblTarAnter_VM, IIf(llngBanAnter = 2, ldblTarAnter_AM, 0))
                        ElseIf ldteLoop < ldteTarAtual_BD And ldteLoop > ldteTarAnter Then
                            ldblTotTarifa = ldblTotTarifa + IIf(llngBanAtual = 1, ldblTarAtual_VM, IIf(llngBanAtual = 2, ldblTarAtual_AM, 0))
                        End If
                        ldteLoop = System.DateTime.FromOADate(ldteLoop.ToOADate + 1)
                    End While
                    While ldteLoop >= IIf(ldteTarAtual_BD >= ldteTarAtual, ldteTarAtual_BD, ldteTarAtual) And ldteLoop < ldteleitAtual
                        ldblTotTarifa = ldblTotTarifa + IIf(llngBanAtual = 1, ldblTarAtual_VM, IIf(llngBanAtual = 2, ldblTarAtual_AM, 0))
                        ldteLoop = System.DateTime.FromOADate(ldteLoop.ToOADate + 1)
                    End While
                End If
                ldblTotTarifa = ldblTotTarifa / (llngDiasAtual + llngDiasAnter)
            End If
        End If
        TarifaProporcional = CDbl(VB6.Format(ldblTotTarifa, "#,##0.00"))
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
    End Function

    Public Function TarifaProporcionalBandeira(ByVal adteLeitAnterior As Date, ByVal adteLeitAtual As Date, ByVal aintTipoBandeira As Short, ByVal adteBandeira As Date, Optional ByRef astrBanPeriodo As String = "") As Double
        Dim ldblTotTarifa As Double 'Resultado Final
        Dim ldteTarAnter_BD As Date 'Data da tarifa anterior Bandeira
        Dim ldteTarAtual_BD As Date 'Data da tarifa atual Bandeira
        Dim llngDiasAtual As Integer 'Qtde de dias da tarifa atual
        Dim llngDiasAnter As Integer 'Qtde de dias da tarifa anterior
        Dim llngBanAnter As Integer 'Tipo de bandeira
        Dim llngBanAtual As Integer 'Tipo de bandeira
        Dim ldblBanAnter As Double 'valor de bandeira anterior
        Dim ldblBanAtual As Double 'valor de bandeira atual
        '
        Dim ldteLoop As Date
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        '
        lrstAux = New ADODB.Recordset
        If aintTipoBandeira <> 3 Or (aintTipoBandeira = 3 And adteBandeira > adteLeitAnterior And adteBandeira <= adteLeitAtual) Then
            If gdteDataBandeiraInicio <= gDtBcoDados Then
                '
                'Controle bandeiras
                '1 = vermelha
                '2 = amarela
                '3 = verde
                lstrSql = ""
                lstrSql = lstrSql & "SELECT * "
                lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`bandeiras` "
                lstrSql = lstrSql & " WHERE `vigencia` <= '" & VB6.Format(adteLeitAtual, "yyyy-MM-dd") & "' "
                lstrSql = lstrSql & " ORDER BY `vigencia` DESC LIMIT 0, 2 "
                Call Conectar(lstrSql, lrstAux)
                With lrstAux
                    If .State = ADODB.ObjectStateEnum.adStateOpen Then
                        If .RecordCount > 0 Then
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldteTarAtual_BD = IIf(IsDBNull(.Fields("vigencia").Value), "1951-01-01", .Fields("vigencia").Value)
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            llngBanAtual = IIf(IsDBNull(.Fields("idtipo_bandeira").Value), 1, .Fields("idtipo_bandeira").Value)
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblBanAtual = IIf(IsDBNull(.Fields("valor").Value), 0, .Fields("valor").Value)
                            If .RecordCount = 2 Then
                                Call .MoveNext()
                            End If
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldteTarAnter_BD = IIf(IsDBNull(.Fields("vigencia").Value), "1951-01-01", .Fields("vigencia").Value)
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            llngBanAnter = IIf(IsDBNull(.Fields("idtipo_bandeira").Value), 1, .Fields("idtipo_bandeira").Value)
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblBanAnter = IIf(IsDBNull(.Fields("valor").Value), 0, .Fields("valor").Value)
                        End If
                        Call .Close()
                    End If
                End With
                ldblTotTarifa = 0

                'UPGRADE_WARNING: DateDiff behavior may be different. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6B38EC3F-686D-4B2E-B5A5-9E8E7A762E32"'
                llngDiasAtual = DateDiff(Microsoft.VisualBasic.DateInterval.Day, ldteTarAtual_BD, adteLeitAtual)
                'UPGRADE_WARNING: DateDiff behavior may be different. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6B38EC3F-686D-4B2E-B5A5-9E8E7A762E32"'
                llngDiasAnter = DateDiff(Microsoft.VisualBasic.DateInterval.Day, adteLeitAnterior, ldteTarAtual_BD)
                astrBanPeriodo = ""
                If llngDiasAtual > 0 Then
                    If llngBanAtual = 1 Then
                        astrBanPeriodo = "VM."
                    ElseIf llngBanAtual = 2 Then
                        astrBanPeriodo = "AM."
                    End If
                End If
                If llngDiasAnter > 0 Then
                    If llngBanAnter = 1 Then
                        astrBanPeriodo = astrBanPeriodo & IIf(Len(Trim(astrBanPeriodo)) > 0, " + ", "") & "VM."
                    ElseIf llngBanAnter = 2 Then
                        astrBanPeriodo = astrBanPeriodo & IIf(Len(Trim(astrBanPeriodo)) > 0, " + ", "") & "AM."
                    End If
                End If
                If Len(Trim(astrBanPeriodo)) > 0 Then astrBanPeriodo = " (" & astrBanPeriodo & " ) "

                ldteLoop = adteLeitAnterior

                If llngDiasAtual >= 1 And llngDiasAnter = 0 Then
                    ldblTotTarifa = ldblBanAtual * llngDiasAtual
                ElseIf llngDiasAtual = 0 And llngDiasAnter >= 1 Then
                    ldblTotTarifa = ldblBanAnter * llngDiasAnter
                Else
                    While ldteLoop < ldteTarAtual_BD
                        If ldteLoop >= ldteTarAnter_BD Then
                            ldblTotTarifa = ldblTotTarifa + ldblBanAnter
                        End If
                        ldteLoop = System.DateTime.FromOADate(ldteLoop.ToOADate + 1)
                    End While
                    While ldteLoop >= ldteTarAtual_BD And ldteLoop < adteLeitAtual
                        ldblTotTarifa = ldblTotTarifa + ldblBanAtual
                        ldteLoop = System.DateTime.FromOADate(ldteLoop.ToOADate + 1)
                    End While
                End If
                ldblTotTarifa = ldblTotTarifa / (llngDiasAtual + llngDiasAnter)
            End If
        End If
        TarifaProporcionalBandeira = CDbl(VB6.Format(ldblTotTarifa, "#,##0.00"))
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
    End Function

    Public Function CalcCM(ByVal astrMesAno As String, ByVal astrZona As String, ByVal astrLivro As String, ByVal astrConta As String, ByVal astrGrupo As String, ByVal alngTenKei As Integer, ByVal aintMesIniPerSeco As Short, ByVal aintMesFimPerSeco As Short, Optional ByVal adblDivisor As Double = 730, Optional ByVal alngConsId As Integer = 0, Optional ByVal alngUnidId As Integer = 0) As Double
        Dim ldblAux As Double
        Dim ldblCon As Double
        Dim ldblIni As Double
        Dim ldblFim As Double
        Dim ldblLim As Double
        Dim lstrCod As String
        Dim ldblTar As Double
        Dim ldblVlr As Double
        Dim ldblVlX As Double
        Dim ldblVCM As Double
        Dim lstrAux As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset

        Dim lintMesLeitAtual As Short
        Dim lblnPeriodo As Boolean
        Dim lstrItens As String
        Dim lstrTa As String
        Dim ldblConsumo As Double
        Dim ldblDemanda As Double
        Dim ldblReativo As Double
        Dim ldblConsu_p As Double
        Dim ldblCons_fp As Double
        Dim ldblDeman_p As Double
        Dim ldblDema_fp As Double
        Dim ldblReati_p As Double
        Dim ldblReat_fp As Double
        Dim lstrClasse As String
        Dim ldteLeituraAtual As Date
        Dim ldteLeituraAnterior As Date

        'On Error GoTo ErrCalcCm

        lstrSql = ""
        lstrSql = lstrSql & "SELECT "
        lstrSql = lstrSql & "       nf.dataleit, "
        lstrSql = lstrSql & "       nf.dataleitant, "
        lstrSql = lstrSql & "       nf.itensserv, "
        lstrSql = lstrSql & "       nf.codclas, "
        lstrSql = lstrSql & "       nf.zona, "
        lstrSql = lstrSql & "       nf.livro, "
        lstrSql = lstrSql & "       nf.conta, "
        lstrSql = lstrSql & "       nf.grupo, "
        lstrSql = lstrSql & "       nf.ta, "
        lstrSql = lstrSql & "       nf.mesano_ref, "
        lstrSql = lstrSql & "       nf.mesano, "
        lstrSql = lstrSql & "       nf.numnf "
        lstrSql = lstrSql & "  FROM nf "
        lstrSql = lstrSql & " WHERE nf.mesano_ref = " & CInt(Right(astrMesAno, 4) & Left(astrMesAno, 2))
        If alngConsId > 0 Then
            lstrSql = lstrSql & "   AND nf.cons_id  = " & alngUnidId & " "
        End If
        If alngUnidId > 0 Then
            lstrSql = lstrSql & "   AND nf.unid_id  = " & alngUnidId & " "
        Else
            lstrSql = lstrSql & "   AND nf.zona  = '" & astrZona & "' "
            lstrSql = lstrSql & "   AND nf.livro = '" & astrLivro & "' "
            lstrSql = lstrSql & "   AND nf.conta = '" & astrConta & "' "
        End If
        lstrSql = lstrSql & "   AND nf.grupo = '" & astrGrupo & "' "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    While Not .EOF
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrItens = Trim(IIf(IsDBNull(.Fields("itensserv").Value), "", .Fields("itensserv").Value))
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrTa = Trim(IIf(IsDBNull(.Fields("ta").Value), "01B100", .Fields("ta").Value))
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrClasse = Trim(IIf(IsDBNull(.Fields("codclas").Value), "9100", .Fields("codclas").Value))
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldteLeituraAtual = CDate(IIf(IsDBNull(.Fields("dataleit").Value), BuscaDataBD, .Fields("dataleit").Value))
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldteLeituraAnterior = CDate(IIf(IsDBNull(.Fields("dataleitant").Value), BuscaDataBD, .Fields("dataleitant").Value))
                        If astrGrupo = "B" Then
                            ldblConsumo = BuscaVlrItem(lstrItens, "030201009")
                        Else
                            If Mid(lstrTa, 3, 2) = "A4" Or Mid(lstrTa, 3, 2) = "AS" Then
                                ldblConsumo = BuscaVlrItem(lstrItens, "0302010009")
                                'ldblDemanda = BuscaVlrItem(lstrItens, "0302010017")
                                'ldblReativo = BuscaVlrItem(lstrItens, "0302010012")
                                'falta reativo de consumo
                            Else
                                ldblConsu_p = BuscaVlrItem(lstrItens, "0302010010")
                                ldblCons_fp = BuscaVlrItem(lstrItens, "0302010011")
                                'ldblDeman_p = BuscaVlrItem(lstrItens, "0302010021")
                                'ldblDema_fp = BuscaVlrItem(lstrItens, "0302010025")
                                'ldblReati_p = BuscaVlrItem(lstrItens, "0302010013")
                                'ldblReat_fp = BuscaVlrItem(lstrItens, "0302010014")
                                'falta reativo de consumo
                            End If
                        End If
                        Call .MoveNext()
                    End While
                End If
                Call .Close()
            End If
        End With
        If Len(lstrClasse) > 0 Then
            'O consumo a pegar tem que ser o consumo do mês do indicador e não do mês em faturamento
            'para trimestral pegar os tres ultimos consumos para traz a partir do consumo do mês de apuração
            'mesma regra para anual so que dos ultimos 12 meses
            ldblVCM = 0
            ldblVlX = 0
            ldblIni = 0
            ldblFim = 0
            ldblAux = ldblConsumo
            ldblVlr = 0
            If astrGrupo = "B" Then
                Select Case CShort(Left(lstrClasse, 1))
                    Case Is < 4
                        lstrAux = "01B31012"
                    Case Is = 4
                        lstrAux = "01B33012"
                    Case Is = 5
                        lstrAux = "01B20112"
                    Case Is = 6
                        If Left(lstrClasse, 2) = "64" Then
                            If CDbl(Right(lstrClasse, 1)) = 2 Then
                                lstrAux = "01B40212"
                            Else
                                lstrAux = "01B40112"
                            End If
                        Else
                            lstrAux = "01B35012"
                        End If
                    Case Is = 7
                        lstrAux = "01B32012"
                    Case Is = 8
                        lstrAux = "01B34012"
                    Case Is = 9
                        If (Right(lstrClasse, 1) = "2" Or Right(lstrClasse, 1) = "3" Or Right(lstrClasse, 1) = "4" Or Right(lstrClasse, 1) = "5" Or Right(lstrClasse, 1) = "6") Then
                            lstrAux = "01B10212"
                        Else
                            lstrAux = "01B10112"
                        End If
                    Case Else
                        lstrAux = "01B10112"
                End Select
                lstrSql = ""
                lstrSql = lstrSql & "SELECT `tarifa`.`num`, "
                lstrSql = lstrSql & "       `tarifa`.`descri`, "
                lstrSql = lstrSql & "       `tarifa`.`un`, "
                lstrSql = lstrSql & "       `tarifa`.`limitkwh`, "
                lstrSql = lstrSql & "       `tarifa`.`valor`, "
                lstrSql = lstrSql & "       `tarifa`.`datanova`, "
                lstrSql = lstrSql & "       `tarifa`.`flgcasc` "
                lstrSql = lstrSql & "  FROM `tarifa` "
                lstrSql = lstrSql & " WHERE LEFT(`tarifa`.`num`, 8) = '" & lstrAux & "' "
                lstrSql = lstrSql & "   AND `referencia` <> '1951-01-01' "
                lstrSql = lstrSql & "   AND `referencia` <= '" & VB6.Format(ldteLeituraAtual, "yyyy-MM-dd") & "' "
                lstrSql = lstrSql & " ORDER BY `referencia` DESC, `num` ASC "
                Call Conectar(lstrSql, lrstAux)
                With lrstAux
                    If .State = ADODB.ObjectStateEnum.adStateOpen Then
                        If .RecordCount > 0 Then
                            While Not .EOF
                                If ldblAux > 0 Then
                                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                    lstrCod = Trim(IIf(IsDBNull(.Fields("num").Value), "0000000000", .Fields("num").Value))
                                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                    ldblFim = CDbl(IIf(IsDBNull(.Fields("limitkwh").Value), 0, .Fields("limitkwh").Value))
                                    '----- pega tarifa proporcional ----------------------------------------------------------
                                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3) / 1000
                                    '-----------------------------------------------------------------------------------------
                                    ldblLim = ldblFim - ldblIni
                                    If ldblAux <= ldblLim Then
                                        ldblCon = ldblAux
                                        ldblVlr = Truncate(ldblAux * ldblTar, 2)
                                        ldblAux = 0
                                    Else
                                        ldblCon = ldblLim
                                        ldblVlr = Truncate(ldblLim * ldblTar, 2)
                                        ldblAux = ldblAux - ldblLim
                                    End If
                                    ldblVlX = ldblVlX + ldblVlr
                                End If
                                Call .MoveNext()
                            End While
                        End If
                        Call .Close()
                    End If
                End With
            Else
                If Left(lstrTa, 4) = "01A4" Or Left(lstrTa, 4) = "01AS" Then
                    'Convencional Consumo
                    lstrCod = Left(lstrTa, 4) & "011201"
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3) / 1000
                    ldblVlr = Truncate(ldblConsumo * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    'ldblVlr = Truncate(ldblReativo * ldblTar, 2) Reativo não entra mais por causa que é tarifa B1 TE
                    'ldblVlX = ldblVlX + ldblVlr
                    'Convencional Demanda
                    'lstrCod = Left(lstrTa, 4) & "012101"
                    'ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3)
                    'ldblVlr = Truncate(ldblDemanda * ldblTar, 2)
                    'ldblVlX = ldblVlX + ldblVlr
                Else
                    lintMesLeitAtual = CShort(Month(ldteLeituraAtual))
                    lblnPeriodo = (lintMesLeitAtual >= aintMesIniPerSeco And lintMesLeitAtual <= aintMesFimPerSeco)
                    'Horo consumo ponta
                    lstrCod = Left(lstrTa, 4) & IIf(lblnPeriodo, "011201", "011205")
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3) / 1000
                    ldblVlr = Truncate(ldblConsu_p * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    'ldblVlr = Truncate(ldblReati_p * ldblTar, 2)
                    'ldblVlX = ldblVlX + ldblVlr
                    'Horo consumo fora ponta
                    lstrCod = Left(lstrTa, 4) & IIf(lblnPeriodo, "011202", "011206")
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3) / 1000
                    ldblVlr = Truncate(ldblCons_fp * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    'ldblVlr = Truncate(ldblReat_fp * ldblTar, 2)
                    'ldblVlX = ldblVlX + ldblVlr
                    'Horo demanda ponta
                    'lstrCod = Left(lstrTa, 4) & IIf(lblnPeriodo, "012101", "012101")
                    'ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3)
                    'ldblVlr = Truncate(ldblDeman_p * ldblTar, 2)
                    'ldblVlX = ldblVlX + ldblVlr
                    'Horo demanda fora ponta
                    'lstrCod = Left(lstrTa, 4) & IIf(lblnPeriodo, "012102", "012102")
                    'ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3)
                    'ldblVlr = Truncate(ldblDema_fp * ldblTar, 2)
                    'ldblVlX = ldblVlX + ldblVlr
                End If
            End If
            ldblVCM = Arredondar((ldblVlX / adblDivisor) * alngTenKei, 2)
        Else
            ldblVCM = 0
        End If
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        'ErrCalcCm:
        '  If Err.Number <> 0 Then
        '    Call MsgBox("Erro! " & Err.Number & " - " & Err.Description & " - " & Err.Source & " - " & Err.LastDllError, vbExclamation, gstrTituloMensagem)
        '  End If
        CalcCM = ldblVCM
    End Function

    Public Function CalcEUSD(ByVal astrMesAno As String, ByVal astrZona As String, ByVal astrLivro As String, ByVal astrConta As String, ByVal astrGrupo As String, ByVal aintMesIniPerSeco As Short, ByVal aintMesFimPerSeco As Short, ByVal ablnFioB As Boolean, Optional ByRef astrClasse As String = "") As Double

        Dim ldblAux As Double
        Dim ldblCon As Double
        Dim ldblIni As Double
        Dim ldblFim As Double
        Dim ldblLim As Double
        Dim lstrCod As String
        Dim ldblTar As Double
        Dim ldblVlr As Double
        Dim ldblVlX As Double
        Dim ldblVCM As Double
        Dim lstrAux As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset

        Dim lintMesLeitAtual As Short
        Dim lblnPeriodo As Boolean
        Dim lstrItens As String
        Dim lstrTa As String
        Dim ldblConsumo As Double
        Dim ldblDemanda As Double
        Dim ldblReativo As Double
        Dim ldblConsu_p As Double
        Dim ldblCons_fp As Double
        Dim ldblDeman_p As Double
        Dim ldblDema_fp As Double
        Dim ldblReati_p As Double
        Dim ldblReat_fp As Double
        Dim lstrClasse As String
        Dim ldteLeituraAtual As Date
        Dim ldteLeituraAnterior As Date
        Dim ldteDataDb As Date
        'On Error GoTo ErrCalcCm
        ldteDataDb = BuscaDataBD()
        lstrSql = ""
        lstrSql = lstrSql & "SELECT "
        lstrSql = lstrSql & "       nf.dataleit, "
        lstrSql = lstrSql & "       nf.dataleitant, "
        lstrSql = lstrSql & "       nf.itensserv, "
        lstrSql = lstrSql & "       nf.codclas, "
        lstrSql = lstrSql & "       nf.zona, "
        lstrSql = lstrSql & "       nf.livro, "
        lstrSql = lstrSql & "       nf.conta, "
        lstrSql = lstrSql & "       nf.grupo, "
        lstrSql = lstrSql & "       nf.ta, "
        lstrSql = lstrSql & "       nf.mesano_ref, "
        lstrSql = lstrSql & "       nf.mesano, "
        lstrSql = lstrSql & "       nf.numnf "
        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".nf "
        lstrSql = lstrSql & " WHERE nf.mesano_ref = " & CInt(Right(astrMesAno, 4) & Left(astrMesAno, 2))
        lstrSql = lstrSql & "   AND nf.mesano = '" & astrMesAno & "' "
        lstrSql = lstrSql & "   AND nf.zona  = '" & astrZona & "' "
        lstrSql = lstrSql & "   AND nf.livro = '" & astrLivro & "' "
        lstrSql = lstrSql & "   AND nf.conta = '" & astrConta & "' "
        lstrSql = lstrSql & "   AND nf.grupo = '" & astrGrupo & "' "
        lstrSql = lstrSql & " LIMIT 0, 1 "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    While Not .EOF
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrItens = Trim(IIf(IsDBNull(.Fields("itensserv").Value), "", .Fields("itensserv").Value))
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrTa = Trim(IIf(IsDBNull(.Fields("ta").Value), "01B100", .Fields("ta").Value))
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrClasse = Trim(IIf(IsDBNull(.Fields("codclas").Value), "9100", .Fields("codclas").Value))
                        astrClasse = lstrClasse
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldteLeituraAtual = CDate(IIf(IsDBNull(.Fields("dataleit").Value), ldteDataDb, .Fields("dataleit").Value))
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldteLeituraAnterior = CDate(IIf(IsDBNull(.Fields("dataleitant").Value), ldteDataDb, .Fields("dataleitant").Value))
                        If astrGrupo = "B" Then
                            ldblConsumo = BuscaValorItem(lstrItens, "030201009")
                        Else
                            If Mid(lstrTa, 3, 2) = "A4" Or Mid(lstrTa, 3, 2) = "AS" Then
                                ldblConsumo = BuscaValorItem(lstrItens, "0302010009")
                                ldblDemanda = BuscaValorItem(lstrItens, "0302010017")
                                ldblReativo = BuscaValorItem(lstrItens, "0302010012")
                                'falta reativo de consumo
                            Else
                                ldblConsu_p = BuscaValorItem(lstrItens, "0302010010")
                                ldblCons_fp = BuscaValorItem(lstrItens, "0302010011")
                                ldblDeman_p = BuscaValorItem(lstrItens, "0302010021")
                                ldblDema_fp = BuscaValorItem(lstrItens, "0302010025")
                                ldblReati_p = BuscaValorItem(lstrItens, "0302010013")
                                ldblReat_fp = BuscaValorItem(lstrItens, "0302010014")
                                'falta reativo de consumo
                            End If
                        End If
                        Call .MoveNext()
                    End While
                End If
                Call .Close()
            End If
        End With
        If Len(lstrClasse) > 0 Then
            'O consumo a pegar tem que ser o consumo do mês do indicador e não do mês em faturamento
            'para trimestral pegar os tres ultimos consumos para traz a partir do consumo do mês de apuração
            'mesma regra para anual so que dos ultimos 12 meses
            ldblVCM = 0
            ldblVlX = 0
            ldblIni = 0
            ldblFim = 0
            ldblAux = ldblConsumo
            ldblVlr = 0
            If astrGrupo = "B" Then
                Select Case CShort(Left(lstrClasse, 1))
                    Case Is < 4
                        lstrAux = "01B31012"
                    Case Is = 4
                        lstrAux = "01B33012"
                    Case Is = 5
                        lstrAux = "01B20112"
                    Case Is = 6
                        If Left(lstrClasse, 2) = "64" Then
                            If CDbl(Right(lstrClasse, 1)) = 2 Then
                                lstrAux = "01B40212"
                            Else
                                lstrAux = "01B40112"
                            End If
                        Else
                            lstrAux = "01B35012"
                        End If
                    Case Is = 7
                        lstrAux = "01B32012"
                    Case Is = 8
                        lstrAux = "01B34012"
                    Case Is = 9
                        If (Right(lstrClasse, 1) = "2" Or Right(lstrClasse, 1) = "3" Or Right(lstrClasse, 1) = "4" Or Right(lstrClasse, 1) = "5" Or Right(lstrClasse, 1) = "6") Then
                            lstrAux = "01B10212"
                        Else
                            lstrAux = "01B10112"
                        End If
                    Case Else
                        lstrAux = "01B10112"
                End Select
                lstrSql = ""
                lstrSql = lstrSql & "SELECT `tarifa`.`num`, "
                lstrSql = lstrSql & "       `tarifa`.`descri`, "
                lstrSql = lstrSql & "       `tarifa`.`un`, "
                lstrSql = lstrSql & "       `tarifa`.`limitkwh`, "
                lstrSql = lstrSql & "       `tarifa`.`valor`, "
                lstrSql = lstrSql & "       `tarifa`.`datanova`, "
                lstrSql = lstrSql & "       `tarifa`.`flgcasc`, "
                lstrSql = lstrSql & "       `tarifa`.`valor_tusd_fio_b` "
                lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`tarifa` "
                lstrSql = lstrSql & " WHERE `tarifa`.`num_oito` = '" & Left(lstrAux, 8) & "' "
                lstrSql = lstrSql & "   AND `referencia` <> '1951-01-01' "
                lstrSql = lstrSql & "   AND `referencia` <= '" & VB6.Format(ldteLeituraAtual, "yyyy-MM-dd") & "' "
                lstrSql = lstrSql & " ORDER BY `referencia` DESC, `num` ASC "
                Call Conectar(lstrSql, lrstAux)
                With lrstAux
                    If .State = ADODB.ObjectStateEnum.adStateOpen Then
                        If .RecordCount > 0 Then
                            While Not .EOF
                                If ldblAux > 0 Then
                                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                    lstrCod = Trim(IIf(IsDBNull(.Fields("num").Value), "0000000000", .Fields("num").Value))
                                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                    ldblFim = CDbl(IIf(IsDBNull(.Fields("limitkwh").Value), 0, .Fields("limitkwh").Value))
                                    '----- pega tarifa proporcional ----------------------------------------------------------
                                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3,  , IIf(ablnFioB, 3, 0)) / 1000
                                    '-----------------------------------------------------------------------------------------
                                    ldblLim = ldblFim - ldblIni
                                    If ldblAux <= ldblLim Then
                                        ldblCon = ldblAux
                                        ldblVlr = Truncate(ldblAux * ldblTar, 2)
                                        ldblAux = 0
                                    Else
                                        ldblCon = ldblLim
                                        ldblVlr = Truncate(ldblLim * ldblTar, 2)
                                        ldblAux = ldblAux - ldblLim
                                    End If
                                    ldblVlX = ldblVlX + ldblVlr
                                Else
                                    Call .MoveLast()
                                End If
                                Call .MoveNext()
                            End While
                        End If
                        Call .Close()
                    End If
                End With
            Else
                If Left(lstrTa, 4) = "01A4" Or Left(lstrTa, 4) = "01AS" Then
                    'Convencional Consumo
                    lstrCod = Left(lstrTa, 4) & "011201"
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3) / 1000
                    ldblVlr = Truncate(ldblConsumo * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    ldblVlr = Truncate(ldblReativo * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    'Convencional Demanda
                    lstrCod = Left(lstrTa, 4) & "012101"
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3)
                    ldblVlr = Truncate(ldblDemanda * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                Else
                    lintMesLeitAtual = CShort(Month(ldteLeituraAtual))
                    lblnPeriodo = (lintMesLeitAtual >= aintMesIniPerSeco And lintMesLeitAtual <= aintMesFimPerSeco)
                    'Horo consumo ponta
                    lstrCod = Left(lstrTa, 4) & IIf(lblnPeriodo, "011201", "011205")
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3) / 1000
                    ldblVlr = Truncate(ldblConsu_p * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    ldblVlr = Truncate(ldblReati_p * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    'Horo consumo fora ponta
                    lstrCod = Left(lstrTa, 4) & IIf(lblnPeriodo, "011202", "011206")
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3) / 1000
                    ldblVlr = Truncate(ldblCons_fp * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    ldblVlr = Truncate(ldblReat_fp * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    'Horo demanda ponta
                    lstrCod = Left(lstrTa, 4) & IIf(lblnPeriodo, "012101", "012101")
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3)
                    ldblVlr = Truncate(ldblDeman_p * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                    'Horo demanda fora ponta
                    lstrCod = Left(lstrTa, 4) & IIf(lblnPeriodo, "012102", "012102")
                    ldblTar = TarifaProporcional(ldteLeituraAnterior, ldteLeituraAtual, lstrCod, 3)
                    ldblVlr = Truncate(ldblDema_fp * ldblTar, 2)
                    ldblVlX = ldblVlX + ldblVlr
                End If
            End If
            ldblVCM = Arredondar(ldblVlX, 2)
        Else
            ldblVCM = 0
        End If
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        CalcEUSD = ldblVCM
    End Function

    Public Sub Separa_Caminho_Arquivo(ByRef astrCaminho As String, ByRef astrArquivo As String)
        Dim lstrAux As String
        Dim llngAux As Integer
        Dim lintPos1 As Short
        Dim lintPos2 As Short
        For llngAux = 1 To Len(astrCaminho)
            lintPos1 = InStr(llngAux, astrCaminho, "\")
            lintPos2 = InStr(lintPos1 + 1, astrCaminho, "\")
            If lintPos2 = 0 Then llngAux = Len(astrCaminho) + 1
            'llngAux = IIf(lintPos2 > 0, lintPos2, lintPos1)
        Next llngAux
        astrArquivo = Mid(astrCaminho, IIf(lintPos2 > 0, lintPos2, lintPos1) + 1)
        astrCaminho = Replace(astrCaminho, astrArquivo, "")
    End Sub

    Public Function Valida_IE(ByRef pInscr As String, ByRef pUF As String) As Boolean
        Dim lblnRetorno As Boolean
        Dim strBase As String
        Dim strBase2 As String
        Dim strOrigem As String
        Dim strDigito1 As String
        Dim strDigito2 As String
        Dim intPos As Short
        Dim intValor As Short
        Dim intSoma As Short
        Dim intResto As Short
        Dim intNumero As Integer
        Dim intPeso As Short
        Dim intDig As Short

        lblnRetorno = False
        strBase = ""
        strBase2 = ""
        strOrigem = ""

        If Trim(pInscr) = "ISENTO" Then
            lblnRetorno = True
            Exit Function
        End If
        For intPos = 1 To Len(Trim(pInscr))
            If InStr(1, "0123456789P", Mid(pInscr, intPos, 1), CompareMethod.Text) > 0 Then
                strOrigem = strOrigem & Mid(pInscr, intPos, 1)
            End If
        Next

        Select Case pUF
            Case "AC"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                If Left(strBase, 2) = "01" And Mid(strBase, 3, 2) <> "00" Then
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "AL"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                If Left(strBase, 2) = "24" Then
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intSoma = intSoma * 10
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto = 10, "0", Str(intResto)), 1)
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "AM"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                intSoma = 0
                For intPos = 1 To 8
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * (10 - intPos)
                    intSoma = intSoma + intValor
                Next
                If intSoma < 11 Then
                    strDigito1 = Right(Str(11 - intSoma), 1)
                Else
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                End If
                strBase2 = Left(strBase, 8) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "AP"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                intPeso = 0
                intDig = 0
                If Left(strBase, 2) = "03" Then
                    intNumero = Val(Left(strBase, 8))
                    If intNumero >= 3000001 And intNumero <= 3017000 Then
                        intPeso = 5
                        intDig = 0
                    ElseIf intNumero >= 3017001 And intNumero <= 3019022 Then
                        intPeso = 9
                        intDig = 1
                    ElseIf intNumero >= 3019023 Then
                        intPeso = 0
                        intDig = 0
                    End If
                    intSoma = intPeso
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    intValor = 11 - intResto
                    If intValor = 10 Then
                        intValor = 0
                    ElseIf intValor = 11 Then
                        intValor = intDig
                    End If
                    strDigito1 = Right(Str(intValor), 1)
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "BA"
                strBase = Left(Trim(strOrigem) & "00000000", 8)
                If InStr(1, "0123458", Left(strBase, 1), CompareMethod.Text) > 0 Then
                    intSoma = 0
                    For intPos = 1 To 6
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (8 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 10
                    strDigito2 = Right(IIf(intResto = 0, "0", Str(10 - intResto)), 1)
                    strBase2 = Left(strBase, 6) & strDigito2
                    intSoma = 0
                    For intPos = 1 To 7
                        intValor = Val(Mid(strBase2, intPos, 1))
                        intValor = intValor * (9 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 10
                    strDigito1 = Right(IIf(intResto = 0, "0", Str(10 - intResto)), 1)
                Else
                    intSoma = 0
                    For intPos = 1 To 6
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (8 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    strDigito2 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                    strBase2 = Left(strBase, 6) & strDigito2
                    intSoma = 0
                    For intPos = 1 To 7
                        intValor = Val(Mid(strBase2, intPos, 1))
                        intValor = intValor * (9 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                End If
                strBase2 = Left(strBase, 6) & strDigito1 & strDigito2
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "CE"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                intSoma = 0
                For intPos = 1 To 8
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * (10 - intPos)
                    intSoma = intSoma + intValor
                Next
                intResto = intSoma Mod 11
                intValor = 11 - intResto
                If intValor > 9 Then
                    intValor = 0
                End If
                strDigito1 = Right(Str(intValor), 1)
                strBase2 = Left(strBase, 8) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "DF"
                strBase = Left(Trim(strOrigem) & "0000000000000", 13)
                If Left(strBase, 3) = "073" Then
                    intSoma = 0
                    intPeso = 2
                    For intPos = 11 To 1 Step -1
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * intPeso
                        intSoma = intSoma + intValor
                        intPeso = intPeso + 1
                        If intPeso > 9 Then
                            intPeso = 2
                        End If
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                    strBase2 = Left(strBase, 11) & strDigito1
                    intSoma = 0
                    intPeso = 2
                    For intPos = 12 To 1 Step -1
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * intPeso
                        intSoma = intSoma + intValor
                        intPeso = intPeso + 1
                        If intPeso > 9 Then
                            intPeso = 2
                        End If
                    Next
                    intResto = intSoma Mod 11
                    strDigito2 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                    strBase2 = Left(strBase, 12) & strDigito2
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "ES"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                intSoma = 0
                For intPos = 1 To 8
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * (10 - intPos)
                    intSoma = intSoma + intValor
                Next
                intResto = intSoma Mod 11
                strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                strBase2 = Left(strBase, 8) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "GO"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                If InStr(1, "10,11,15", Left(strBase, 2), CompareMethod.Text) > 0 Then
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    If intResto = 0 Then
                        strDigito1 = "0"
                    ElseIf intResto = 1 Then
                        intNumero = Val(Left(strBase, 8))
                        strDigito1 = Right(IIf(intNumero >= 10103105 And intNumero <= 10119997, "1", "0"), 1)
                    Else
                        strDigito1 = Right(Str(11 - intResto), 1)
                    End If
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "MA"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                If Left(strBase, 2) = "12" Then
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "MT"
                strBase = Left(Trim(strOrigem) & "0000000000", 10)
                intSoma = 0
                intPeso = 2
                For intPos = 10 To 1 Step -1
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * intPeso
                    intSoma = intSoma + intValor
                    intPeso = intPeso + 1
                    If intPeso > 9 Then
                        intPeso = 2
                    End If
                Next
                intResto = intSoma Mod 11
                strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                strBase2 = Left(strBase, 10) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "MS"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                If Left(strBase, 2) = "28" Then
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "MG"
                strBase = Left(Trim(strOrigem) & "0000000000000", 13)
                strBase2 = Left(strBase, 3) & "0" & Mid(strBase, 4, 8)
                intNumero = 2
                For intPos = 1 To 12
                    intValor = Val(Mid(strBase2, intPos, 1))
                    intNumero = IIf(intNumero = 2, 1, 2)
                    intValor = intValor * intNumero
                    If intValor > 9 Then
                        strDigito1 = VB6.Format(intValor, "00")
                        intValor = Val(Left(strDigito1, 1)) + Val(Right(strDigito1, 1))
                    End If
                    intSoma = intSoma + intValor
                Next
                intValor = intSoma
                While Right(VB6.Format(intValor, "000"), 1) <> "0"
                    intValor = intValor + 1
                End While
                strDigito1 = Right(VB6.Format(intValor - intSoma, "00"), 1)
                strBase2 = Left(strBase, 11) & strDigito1
                intSoma = 0
                intPeso = 2
                For intPos = 12 To 1 Step -1
                    intValor = Val(Mid(strBase2, intPos, 1))
                    intValor = intValor * intPeso
                    intSoma = intSoma + intValor
                    intPeso = intPeso + 1
                    If intPeso > 11 Then
                        intPeso = 2
                    End If
                Next
                intResto = intSoma Mod 11
                strDigito2 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                strBase2 = strBase2 & strDigito2
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "PA"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                If Left(strBase, 2) = "15" Then
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "PB"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                intSoma = 0
                For intPos = 1 To 8
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * (10 - intPos)
                    intSoma = intSoma + intValor
                Next
                intResto = intSoma Mod 11
                intValor = 11 - intResto
                If intValor > 9 Then
                    intValor = 0
                End If
                strDigito1 = Right(Str(intValor), 1)
                strBase2 = Left(strBase, 8) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "PE"
                strBase = Left(Trim(strOrigem) & "00000000000000", 14)
                intSoma = 0
                intPeso = 2
                For intPos = 13 To 1 Step -1
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * intPeso
                    intSoma = intSoma + intValor
                    intPeso = intPeso + 1
                    If intPeso > 9 Then
                        intPeso = 2
                    End If
                Next
                intResto = intSoma Mod 11
                intValor = 11 - intResto
                If intValor > 9 Then
                    intValor = intValor - 10
                End If
                strDigito1 = Right(Str(intValor), 1)
                strBase2 = Left(strBase, 13) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "PI"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                intSoma = 0
                For intPos = 1 To 8
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * (10 - intPos)
                    intSoma = intSoma + intValor
                Next
                intResto = intSoma Mod 11
                strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                strBase2 = Left(strBase, 8) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "PR"
                strBase = Left(Trim(strOrigem) & "0000000000", 10)
                intSoma = 0
                intPeso = 2
                For intPos = 8 To 1 Step -1
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * intPeso
                    intSoma = intSoma + intValor
                    intPeso = intPeso + 1
                    If intPeso > 7 Then
                        intPeso = 2
                    End If
                Next
                intResto = intSoma Mod 11
                strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                strBase2 = Left(strBase, 8) & strDigito1
                intSoma = 0
                intPeso = 2
                For intPos = 9 To 1 Step -1
                    intValor = Val(Mid(strBase2, intPos, 1))
                    intValor = intValor * intPeso
                    intSoma = intSoma + intValor
                    intPeso = intPeso + 1
                    If intPeso > 7 Then
                        intPeso = 2
                    End If
                Next
                intResto = intSoma Mod 11
                strDigito2 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                strBase2 = strBase2 & strDigito2
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "RJ"
                strBase = Left(Trim(strOrigem) & "00000000", 8)
                intSoma = 0
                intPeso = 2
                For intPos = 7 To 1 Step -1
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * intPeso
                    intSoma = intSoma + intValor
                    intPeso = intPeso + 1
                    If intPeso > 7 Then
                        intPeso = 2
                    End If
                Next
                intResto = intSoma Mod 11
                strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                strBase2 = Left(strBase, 7) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "RN"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                If Left(strBase, 2) = "20" Then
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intSoma = intSoma * 10
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto > 9, "0", Str(intResto)), 1)
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "RO"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                strBase2 = Mid(strBase, 4, 5)
                intSoma = 0
                For intPos = 1 To 5
                    intValor = Val(Mid(strBase2, intPos, 1))
                    intValor = intValor * (7 - intPos)
                    intSoma = intSoma + intValor
                Next
                intResto = intSoma Mod 11
                intValor = 11 - intResto
                If intValor > 9 Then
                    intValor = intValor - 10
                End If
                strDigito1 = Right(Str(intValor), 1)
                strBase2 = Left(strBase, 8) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "RR"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                If Left(strBase, 2) = "24" Then
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 9
                    strDigito1 = Right(Str(intResto), 1)
                    strBase2 = Left(strBase, 8) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "RS"
                strBase = Left(Trim(strOrigem) & "0000000000", 10)
                intNumero = Val(Left(strBase, 3))
                If intNumero > 0 And intNumero < 468 Then
                    intSoma = 0
                    intPeso = 2
                    For intPos = 9 To 1 Step -1
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * intPeso
                        intSoma = intSoma + intValor
                        intPeso = intPeso + 1
                        If intPeso > 9 Then
                            intPeso = 2
                        End If
                    Next
                    intResto = intSoma Mod 11
                    intValor = 11 - intResto
                    If intValor > 9 Then
                        intValor = 0
                    End If
                    strDigito1 = Right(Str(intValor), 1)
                    strBase2 = Left(strBase, 9) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If

            Case "SC"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                intSoma = 0
                For intPos = 1 To 8
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * (10 - intPos)
                    intSoma = intSoma + intValor
                Next
                intResto = intSoma Mod 11
                strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                strBase2 = Left(strBase, 8) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "SE"
                strBase = Left(Trim(strOrigem) & "000000000", 9)
                intSoma = 0
                For intPos = 1 To 8
                    intValor = Val(Mid(strBase, intPos, 1))
                    intValor = intValor * (10 - intPos)
                    intSoma = intSoma + intValor
                Next
                intResto = intSoma Mod 11
                intValor = 11 - intResto
                If intValor > 9 Then
                    intValor = 0
                End If
                strDigito1 = Right(Str(intValor), 1)
                strBase2 = Left(strBase, 8) & strDigito1
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "SP"
                If Left(strOrigem, 1) = "P" Then
                    strBase = Left(Trim(strOrigem) & "0000000000000", 13)
                    strBase2 = Mid(strBase, 2, 8)
                    intSoma = 0
                    intPeso = 1
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * intPeso
                        intSoma = intSoma + intValor
                        intPeso = intPeso + 1
                        If intPeso = 2 Then
                            intPeso = 3
                        End If
                        If intPeso = 9 Then
                            intPeso = 10
                        End If
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(Str(intResto), 1)
                    strBase2 = Left(strBase, 8) & strDigito1 & Mid(strBase, 11, 3)
                Else
                    strBase = Left(Trim(strOrigem) & "000000000000", 12)
                    intSoma = 0
                    intPeso = 1
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * intPeso
                        intSoma = intSoma + intValor
                        intPeso = intPeso + 1
                        If intPeso = 2 Then
                            intPeso = 3
                        End If
                        If intPeso = 9 Then
                            intPeso = 10
                        End If
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(Str(intResto), 1)
                    strBase2 = Left(strBase, 8) & strDigito1 & Mid(strBase, 10, 2)
                    intSoma = 0
                    intPeso = 2
                    For intPos = 11 To 1 Step -1
                        intValor = Val(Mid(strBase, intPos, 1))
                        intValor = intValor * intPeso
                        intSoma = intSoma + intValor
                        intPeso = intPeso + 1
                        If intPeso > 10 Then
                            intPeso = 2
                        End If
                    Next
                    intResto = intSoma Mod 11
                    strDigito2 = Right(Str(intResto), 1)
                    strBase2 = strBase2 & strDigito2
                End If
                If strBase2 = strOrigem Then
                    lblnRetorno = True
                End If

            Case "TO"
                strBase = Left(Trim(strOrigem) & "00000000000", 11)
                If InStr(1, "01,02,03,99", Mid(strBase, 3, 2), CompareMethod.Text) > 0 Then
                    strBase2 = Left(strBase, 2) & Mid(strBase, 5, 6)
                    intSoma = 0
                    For intPos = 1 To 8
                        intValor = Val(Mid(strBase2, intPos, 1))
                        intValor = intValor * (10 - intPos)
                        intSoma = intSoma + intValor
                    Next
                    intResto = intSoma Mod 11
                    strDigito1 = Right(IIf(intResto < 2, "0", Str(11 - intResto)), 1)
                    strBase2 = Left(strBase, 10) & strDigito1
                    If strBase2 = strOrigem Then
                        lblnRetorno = True
                    End If
                End If
        End Select
        Valida_IE = lblnRetorno
    End Function

    Public Sub AtualizaBD()
        Dim intARQ As Short
        Dim strNmArq As String
        Dim strLinha As String
        Dim blnGrava As Boolean
        Dim blnBloco As Boolean
        Dim strsql As String
        Dim intVerBD As Short
        Dim intVer As Short

        strNmArq = My.Application.Info.DirectoryPath & "\" & "atualizacoes.txt"
        intARQ = FreeFile()
        blnBloco = False
        intVerBD = CShort(Str(CDbl(LeConfig("VERSAO_BD"))))
        If intVerBD = -1 Then
            intVerBD = 0
            strsql = "INSERT INTO config SET nomepar = 'VERSAO_BD', valorpar = '0', flag = 'N', `desc` = 'Última atualização do BD'"
            Call Executar(strsql)
        End If
        strsql = ""

        'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
        If (Dir(strNmArq) <> "") Then 'Verifica se o arquivo existe

            FileOpen(intARQ, strNmArq, OpenMode.Input)
            While Not EOF(intARQ)

                'On Error GoTo ErroArquivo
                strLinha = LineInput(intARQ)
                strLinha = Trim(strLinha)

                If Len(strLinha) > 0 Then

                    If Left(strLinha, 9) = "--- BEG #" Then

                        intVer = CShort(Mid(strLinha, 11, 4))

                    ElseIf intVer > intVerBD Then

                        If Left(strLinha, 7) = "--- END" Then
                            If Trim(strsql) <> "" Then
                                'toClip (strSql)
                                Call Executar(strsql)
                                Call GravaConfig("VERSAO_BD", "" & intVer & "")
                            End If
                            blnBloco = False
                            strsql = ""
                        ElseIf strLinha = "/" And Trim(strsql) <> "" Then
                            'toClip (strSql)
                            Call Executar(strsql)
                            strsql = ""
                        Else
                            strsql = strsql & strLinha & Chr(10) & Chr(13)
                        End If

                    End If

                End If

            End While
            FileClose(intARQ)

        End If

        '  Exit Sub
        '
        'ErroArquivo:
        '  Call MsgBox("Erro: " & Err.Description, vbInformation, gstrTituloMensagem)
        '  Close intARQ
        '  Exit Sub
    End Sub

    Public Function GetMsgRevCadastral(ByVal alngAno As Integer, ByVal astrZona As String, ByVal astrLivro As String, ByVal astrConta As String, ByVal adteBase As Date) As String
        Dim ldteDtFim As Date
        Dim llngCroIdPro As Integer
        Dim llngGruIdTMs As Integer
        Dim lstrMensagem As String
        Dim lstrEst As String
        Dim lstrSql As String
        Dim lrstDad As ADODB.Recordset
        Dim lrstAux As ADODB.Recordset
        Dim ldteBase As Date
        Dim lalngAno As Integer

        lrstDad = New ADODB.Recordset
        lrstAux = New ADODB.Recordset

        lstrEst = ""
        lstrMensagem = ""

        lalngAno = CInt(Left(CStr(alngAno), 4))

        '(1) as datas indicadas nos textos das mensagens deverão ser incluídas de acordo com o cronograma do item 4 deste manual;
        '(2) o telefone indicado para preenchimento nas ações de validação é o da distribuidora.
        lstrSql = ""
        lstrSql = lstrSql & "SELECT * "
        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`cadrev_dados` "
        lstrSql = lstrSql & "   WHERE `data_final` >= '" & VB6.Format(adteBase, "yyyy-MM-dd") & "' "
        lstrSql = lstrSql & "   AND `zona` = '" & astrZona & "' "
        lstrSql = lstrSql & "   AND `livro` = '" & astrLivro & "' "
        lstrSql = lstrSql & "   AND `conta` = '" & astrConta & "' "
        lstrSql = lstrSql & "   AND `revisado` = 'N' "
        Call Conectar(lstrSql, lrstDad)
        With lrstDad
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    While Not .EOF
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrEst = IIf(IsDBNull(.Fields("cancelado").Value), "", .Fields("cancelado").Value)
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldteDtFim = IIf(IsDBNull(.Fields("data_final").Value), "1900-01-01", .Fields("data_final").Value)

                        If lstrEst = "N" Then
                            lstrEst = "Convocação"
                        Else
                            lstrEst = "Cancelamento"
                        End If

                        lstrSql = ""
                        lstrSql = lstrSql & "SELECT * "
                        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`cadrev_mensagens` "
                        lstrSql = lstrSql & " WHERE `descricao_tipos_mensagens` = '" & lstrEst & "'"
                        Call Conectar(lstrSql, lrstAux)
                        With lrstAux
                            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                                If .RecordCount > 0 Then
                                    While Not .EOF
                                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                        lstrMensagem = IIf(IsDBNull(.Fields("descricao").Value), "", .Fields("descricao").Value)
                                        Call .MoveNext()
                                    End While
                                End If
                                Call .Close()
                            End If
                        End With
                        lstrMensagem = Replace(Replace(Replace(lstrMensagem, "%DD/MM/AAAA%", VB6.Format(ldteDtFim, "dd/MM/yyyy")), "%XXXXXXXXXXX%", gstrEmpresa_0800), "%AAAA%", CStr(lalngAno))
                        Call .MoveNext()
                    End While
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstDad may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstDad = Nothing
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        GetMsgRevCadastral = lstrMensagem
    End Function
    Public Function GetMsgBaixaRenda(ByVal alngAno As Integer, ByVal astrZona As String, ByVal astrLivro As String, ByVal astrConta As String, ByVal adteBase As Date) As String
        Dim llngGru As Integer
        Dim ldteIniMsg As Date
        Dim ldteLimAtu As Date
        Dim ldteCroIni As Date
        Dim ldteCroLim As Date
        Dim ldteCroCan As Date
        Dim llngCroIdPro As Integer
        Dim llngGruIdTMs As Integer
        Dim lstrMensagem As String
        Dim lstrMot As String
        Dim lstrEst As String
        Dim lstrSql As String
        Dim lrstDad As ADODB.Recordset
        Dim lrstAux As ADODB.Recordset
        Dim ldteBase As Date

        lrstDad = New ADODB.Recordset
        lrstAux = New ADODB.Recordset

        lstrMensagem = ""
        ldteBase = CDate("01/" & VB6.Format(adteBase, "MM/yyyy"))

        '(1) as datas indicadas nos textos das mensagens deverão ser incluídas de acordo com o cronograma do item 4 deste manual;
        '(2) o telefone indicado para preenchimento nas ações de validação é o da distribuidora.
        lstrSql = ""
        lstrSql = lstrSql & "SELECT * "
        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`caduni_dados` "
        lstrSql = lstrSql & " WHERE `ano_mes` <= " & alngAno & " "
        lstrSql = lstrSql & "   AND `zona` = '" & astrZona & "' "
        lstrSql = lstrSql & "   AND `livro` = '" & astrLivro & "' "
        lstrSql = lstrSql & "   AND `conta` = '" & astrConta & "' "
        lstrSql = lstrSql & "   AND `data_limite_atualizacao` >= '" & VB6.Format(ldteBase, "yyyy-MM-dd") & "' "
        lstrSql = lstrSql & " ORDER BY `ano_mes` DESC "
        Call Conectar(lstrSql, lrstDad)
        With lrstDad
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    While Not .EOF
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        llngGru = IIf(IsDBNull(.Fields("id_caduni_grupos").Value), 0, .Fields("id_caduni_grupos").Value)
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrMot = IIf(IsDBNull(.Fields("descricao_caduni_motivos_validacoes").Value), "", .Fields("descricao_caduni_motivos_validacoes").Value)
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        lstrEst = IIf(IsDBNull(.Fields("descricao_caduni_estados_cadastrais").Value), "", .Fields("descricao_caduni_estados_cadastrais").Value)
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldteIniMsg = IIf(IsDBNull(.Fields("data_inicio_mensagem").Value), "1900-01-01", .Fields("data_inicio_mensagem").Value)
                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                        ldteLimAtu = IIf(IsDBNull(.Fields("data_limite_atualizacao").Value), "1900-01-01", .Fields("data_limite_atualizacao").Value)
                        'Cronograma
                        lstrSql = ""
                        lstrSql = lstrSql & "SELECT * "
                        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`caduni_cronograma` "
                        lstrSql = lstrSql & " WHERE `ano` = " & Left(CStr(alngAno), 4) & " "
                        lstrSql = lstrSql & "   AND `id_caduni_grupos` = " & llngGru & " "
                        lstrSql = lstrSql & "   AND `dt_anomes_inicio_mensagem` = '" & VB6.Format(CDate("01/" & VB6.Format(adteBase, "MM/yyyy")), "yyyy-MM-dd") & "' "
                        Call Conectar(lstrSql, lrstAux)
                        With lrstAux
                            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                                If .RecordCount > 0 Then
                                    While Not .EOF
                                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                        ldteCroIni = IIf(IsDBNull(.Fields("dt_anomes_inicio_mensagem").Value), "1900-01-01", .Fields("dt_anomes_inicio_mensagem").Value)
                                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                        ldteCroLim = IIf(IsDBNull(.Fields("dt_limite_atualizacao").Value), "1900-01-01", .Fields("dt_limite_atualizacao").Value)
                                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                        ldteCroCan = IIf(IsDBNull(.Fields("dt_anomes_cancelamento").Value), "1900-01-01", .Fields("dt_anomes_cancelamento").Value)
                                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                        llngCroIdPro = IIf(IsDBNull(.Fields("id_caduni_processos").Value), 0, .Fields("id_caduni_processos").Value)
                                        Call .MoveNext()
                                    End While
                                End If
                                Call .Close()
                            End If
                        End With
                        lstrSql = ""
                        lstrSql = lstrSql & "SELECT * "
                        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`caduni_grupos_mensagens` "
                        lstrSql = lstrSql & " WHERE `ano` = " & Left(CStr(alngAno), 4) & " "
                        lstrSql = lstrSql & "   AND `id_caduni_grupos` = " & llngGru & " "
                        lstrSql = lstrSql & "   AND `id_caduni_processos` = " & llngCroIdPro & " "
                        If ldteBase > ldteCroCan Then
                            lstrSql = lstrSql & "   AND `id_caduni_tipos_mensagens` = 2 "
                        Else
                            lstrSql = lstrSql & "   AND `id_caduni_tipos_mensagens` = 1 "
                        End If
                        Call Conectar(lstrSql, lrstAux)
                        With lrstAux
                            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                                If .RecordCount > 0 Then
                                    While Not .EOF
                                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                        llngGruIdTMs = IIf(IsDBNull(.Fields("id_caduni_tipos_mensagens").Value), 0, .Fields("id_caduni_tipos_mensagens").Value)
                                        'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                                        lstrMensagem = IIf(IsDBNull(.Fields("descricao_caduni_mensagens").Value), 0, .Fields("descricao_caduni_mensagens").Value)
                                        Call .MoveNext()
                                    End While
                                End If
                                Call .Close()
                            End If
                        End With
                        If llngGruIdTMs = 1 Then
                            lstrMensagem = Replace(Replace(Replace(lstrMensagem, "%DD/MM/AAAA%", VB6.Format(ldteCroLim, "dd/MM/yyyy")), "%XXXXXXXXXXX%", gstrEmpresa_0800), "%AAAA%", CStr(alngAno))
                        Else
                            lstrMensagem = Replace(Replace(Replace(lstrMensagem, "%DD/MM/AAAA%", VB6.Format(ldteCroCan, "dd/MM/yyyy")), "%XXXXXXXXXXX%", gstrEmpresa_0800), "%AAAA%", CStr(alngAno))
                        End If
                        Call .MoveNext()
                    End While
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstDad may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstDad = Nothing
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        GetMsgBaixaRenda = lstrMensagem
    End Function


    Public Sub GetTarifasComposicao(ByVal adteReferencia As Date, ByRef pdblEnergia As Double, ByRef pdblTransmissao As Double, ByRef pdblDistribuicao As Double, ByRef pdblEncargos As Double, ByRef pdblPerdas As Double, ByRef pdblTributosIcms As Double, ByRef pdblTributosPisCofins As Double)
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lstrSql = "SELECT * "
        lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`tarifas_composicao` "
        lstrSql = lstrSql & " WHERE referencia <= '" & VB6.Format(adteReferencia, "yyyy-MM-dd") & "' "
        lstrSql = lstrSql & " LIMIT 0, 1"
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    pdblEnergia = IIf(IsDBNull(.Fields("energia_real").Value), 0, .Fields("energia_real").Value)
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    pdblTransmissao = IIf(IsDBNull(.Fields("transmissao").Value), 0, .Fields("transmissao").Value)
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    pdblDistribuicao = IIf(IsDBNull(.Fields("distribuicao").Value), 0, .Fields("distribuicao").Value)
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    pdblEncargos = IIf(IsDBNull(.Fields("enc_setoriais").Value), 0, .Fields("enc_setoriais").Value)
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    pdblPerdas = IIf(IsDBNull(.Fields("perdas").Value), 0, .Fields("perdas").Value)
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    pdblTributosIcms = IIf(IsDBNull(.Fields("tributos_icms").Value), 0, .Fields("tributos_icms").Value)
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    pdblTributosPisCofins = IIf(IsDBNull(.Fields("tributos_pis_cofins").Value), 0, .Fields("tributos_pis_cofins").Value)
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
    End Sub

    Public Function CalculaIluminacaoPublica(ByVal alngCidade As Integer, ByVal astrClasse As String, ByVal adblQtdConsumo As Double, ByVal adblVlrConsumo As Double, ByVal adteLeitura As Date, ByVal adblTarCons_B1 As Double, ByVal adblTarCons_B4 As Double, ByVal astrGrupo As String) As Double
        Dim lstrTip As String 'Tipo de calculo percentual ou valor fixo
        '
        Dim ldblIni As Double 'Faixa inicial de consumo
        Dim ldblFim As Double 'Faixa final de consumo
        Dim ldblVlr As Double 'Valor ou percentual a ser aplicado
        Dim ldblTet As Double 'Valor do teto quando for por percentual
        Dim ldblBas As String 'Valor auxiliar para ser usado como base de cálculo
        '
        Dim lintCla As Short 'Código da classe
        Dim lintTB1 As Short 'Se deve usar o valor da tarifa residencial
        Dim lintkWh As Short 'se deve usar o valor do consumo no calculo
        Dim lintBxR As Short 'se deve calcular para o baixa renda
        Dim lintTB4 As Short 'Se deve usar o valor da tarifa da iluminação pública rede para valor de base de cálculo
        Dim ldblRet As Double 'Valor de retorno
        '
        Dim lblnAux As Boolean
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        '
        lintCla = CShort(Left(Trim(astrClasse), IIf(Left(Trim(astrClasse), 1) <> "6", 1, 2))) 'classes 0,1,2,3,4,5,61,62,63,64,7,8,9
        ldblRet = 0
        lstrSql = ""
        lstrSql = lstrSql & "   SELECT * "
        lstrSql = lstrSql & "     FROM " & gstrDataBase & ".`cip` "
        lstrSql = lstrSql & "    WHERE `cidade` = " & alngCidade & " "
        lstrSql = lstrSql & "      AND `classe` = " & lintCla & " "
        lstrSql = lstrSql & "      AND `grupo` IN('T','" & astrGrupo & "') "
        lstrSql = lstrSql & "      AND `data` <= '" & VB6.Format(adteLeitura, "yyyy-MM-dd") & "' "
        lstrSql = lstrSql & "      AND ("
        lstrSql = lstrSql & "           (`tipo` = 'P' AND (`faixa_ini` >= 0 AND `faixa_fim` <= 999999999)) OR "
        lstrSql = lstrSql & "           (`tipo` = 'F' AND (" & Replace(CStr(adblQtdConsumo), ",", ".") & " BETWEEN `faixa_ini` AND `faixa_fim`)) "
        lstrSql = lstrSql & "          ) "
        lstrSql = lstrSql & "      AND " & Replace(CStr(adblQtdConsumo), ",", ".") & " BETWEEN `faixa_ini` AND `faixa_fim` "
        lstrSql = lstrSql & " ORDER BY `grupo` ASC, `data` DESC, faixa_fim DESC , faixa_ini DESC LIMIT 0, 1 "
        If Conectar(lstrSql, lrstAux,  , True) Then
            With lrstAux
                If .State = ADODB.ObjectStateEnum.adStateOpen Then
                    If .RecordCount > 0 Then
                        While Not .EOF
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblIni = CDbl(IIf(IsDBNull(.Fields("faixa_ini").Value), 0, .Fields("faixa_ini").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblFim = CDbl(IIf(IsDBNull(.Fields("faixa_fim").Value), 999999999, .Fields("faixa_fim").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lstrTip = UCase(Trim(IIf(IsDBNull(.Fields("tipo").Value), "F", .Fields("tipo").Value)))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblVlr = CDbl(IIf(IsDBNull(.Fields("valor").Value), 0, .Fields("valor").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblTet = CDbl(IIf(IsDBNull(.Fields("valor_teto_fixo").Value), 0, .Fields("valor_teto_fixo").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lintTB1 = CShort(IIf(IsDBNull(.Fields("tarifa_residencial").Value), 0, .Fields("tarifa_residencial").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lintkWh = CShort(IIf(IsDBNull(.Fields("valor_consumo").Value), 0, .Fields("valor_consumo").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lintBxR = CShort(IIf(IsDBNull(.Fields("baixa_renda").Value), 0, .Fields("baixa_renda").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lintTB4 = CShort(IIf(IsDBNull(.Fields("base_tarifa_b4").Value), 0, .Fields("base_tarifa_b4").Value))
                            lblnAux = True
                            If lintBxR = 0 And (astrClasse = "9104" Or astrClasse = "9105" Or astrClasse = "9106") Then
                                lblnAux = False
                            End If
                            If lblnAux Then
                                '
                                If lstrTip = "P" Then
                                    '
                                    'caso for percentual
                                    '
                                    If adblQtdConsumo >= ldblIni Then
                                        If adblQtdConsumo > ldblFim Then
                                            ldblBas = IIf(lintTB4 = 0, IIf(lintkWh = 0, ldblFim, adblVlrConsumo), adblTarCons_B4)
                                            ldblRet = Arredondar((CDbl(ldblBas) * IIf(lintTB1 = 0, 1, adblTarCons_B1)) * (ldblVlr / 100), 2)
                                        Else
                                            ldblBas = IIf(lintTB4 = 0, IIf(lintkWh = 0, adblQtdConsumo, adblVlrConsumo), adblTarCons_B4)
                                            ldblRet = Arredondar((CDbl(ldblBas) * IIf(lintTB1 = 0, 1, adblTarCons_B1)) * (ldblVlr / 100), 2)
                                        End If
                                    End If
                                    If ldblTet > 0 And (ldblRet > ldblTet) Then
                                        ldblRet = Arredondar(ldblTet, 2)
                                    End If
                                ElseIf lstrTip = "F" Then
                                    '
                                    'caso for valor fixo
                                    '
                                    If ldblRet = 0 Then
                                        ldblRet = Arredondar(ldblVlr, 2)
                                    End If
                                    Call .MoveLast()
                                End If
                            End If
                            Call .MoveNext()
                        End While
                    End If
                    Call .Close()
                End If
            End With
        End If
        CalculaIluminacaoPublica = ldblRet
    End Function

    Public Function CalculaCodigosRegrasEspeciais(ByVal astrCodigo As String, ByVal alngCidade As Integer, ByVal astrClasse As String, ByVal adblQtdConsumo As Double, ByVal adblVlrConsumo As Double, ByVal adteLeitura As Date, ByVal astrGrupo As String, ByVal ablnSocio As Boolean) As Double
        Dim lstrTip As String 'Tipo de calculo percentual ou valor fixo
        '
        Dim ldblIni As Double 'Faixa inicial de consumo
        Dim ldblFim As Double 'Faixa final de consumo
        Dim ldblVlr As Double 'Valor ou percentual a ser aplicado
        Dim ldblTet As Double 'Valor do teto quando for por percentual
        Dim ldblBas As String 'Valor auxiliar para ser usado como base de cálculo
        '
        Dim lintCla As Short 'Código da classe
        Dim lintkWh As Short 'se deve usar o valor do consumo no calculo
        Dim lintBxR As Short 'se deve calcular para o baixa renda
        Dim lintSoc As Short 'Se deve usar o valor da tarifa da iluminação pública rede para valor de base de cálculo
        Dim ldblRet As Double 'Valor de retorno
        '
        Dim lblnAux As Boolean
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        '
        lintCla = CShort(Left(Trim(astrClasse), IIf(Left(Trim(astrClasse), 1) <> "6", 1, 2))) 'classes 0,1,2,3,4,5,61,62,63,64,7,8,9
        ldblRet = 0
        lstrSql = ""
        lstrSql = lstrSql & "   SELECT * "
        lstrSql = lstrSql & "     FROM " & gstrDataBase & ".`regras_especiais` "
        lstrSql = lstrSql & "    WHERE `codigo` = '" & astrCodigo & "' "
        lstrSql = lstrSql & "      AND `cidade` = " & alngCidade & " "
        lstrSql = lstrSql & "      AND `classe` = " & lintCla & " "
        lstrSql = lstrSql & "      AND `grupo` IN('T','" & astrGrupo & "') "
        lstrSql = lstrSql & "      AND `data` <= '" & VB6.Format(adteLeitura, "yyyy-MM-dd") & "' "
        lstrSql = lstrSql & "      AND ("
        lstrSql = lstrSql & "           (`tipo` = 'P' AND (`faixa_ini` >= 0 AND `faixa_fim` <= 999999999)) OR "
        lstrSql = lstrSql & "           (`tipo` = 'F' AND (" & Replace(CStr(adblQtdConsumo), ",", ".") & " BETWEEN `faixa_ini` AND `faixa_fim`)) "
        lstrSql = lstrSql & "          ) "
        lstrSql = lstrSql & "      AND " & Replace(CStr(adblQtdConsumo), ",", ".") & " BETWEEN `faixa_ini` AND `faixa_fim` "
        lstrSql = lstrSql & " ORDER BY `grupo` ASC, `data` DESC, faixa_fim DESC , faixa_ini DESC LIMIT 0, 1 "
        If Conectar(lstrSql, lrstAux,  , True) Then
            With lrstAux
                If .State = ADODB.ObjectStateEnum.adStateOpen Then
                    If .RecordCount > 0 Then
                        While Not .EOF
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblIni = CDbl(IIf(IsDBNull(.Fields("faixa_ini").Value), 0, .Fields("faixa_ini").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblFim = CDbl(IIf(IsDBNull(.Fields("faixa_fim").Value), 999999999, .Fields("faixa_fim").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lstrTip = UCase(Trim(IIf(IsDBNull(.Fields("tipo").Value), "F", .Fields("tipo").Value)))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblVlr = CDbl(IIf(IsDBNull(.Fields("valor").Value), 0, .Fields("valor").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            ldblTet = CDbl(IIf(IsDBNull(.Fields("valor_teto_fixo").Value), 0, .Fields("valor_teto_fixo").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lintkWh = CShort(IIf(IsDBNull(.Fields("valor_consumo").Value), 0, .Fields("valor_consumo").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lintBxR = CShort(IIf(IsDBNull(.Fields("baixa_renda").Value), 0, .Fields("baixa_renda").Value))
                            'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                            lintSoc = CShort(IIf(IsDBNull(.Fields("socio").Value), 0, .Fields("socio").Value))
                            lblnAux = True
                            If lintBxR = 0 And (astrClasse = "9104" Or astrClasse = "9105" Or astrClasse = "9106") Then
                                lblnAux = False
                            End If
                            If lintSoc = 1 And Not ablnSocio Then
                                lblnAux = False
                            End If
                            If lblnAux Then
                                '
                                If lstrTip = "P" Then
                                    '
                                    'caso for percentual
                                    '
                                    If adblQtdConsumo >= ldblIni Then
                                        If adblQtdConsumo > ldblFim Then
                                            ldblBas = IIf(lintkWh = 0, ldblFim, adblVlrConsumo)
                                            ldblRet = Arredondar(CDbl(ldblBas) * (ldblVlr / 100), 2)
                                        Else
                                            ldblBas = IIf(lintkWh = 0, adblQtdConsumo, adblVlrConsumo)
                                            ldblRet = Arredondar(CDbl(ldblBas) * (ldblVlr / 100), 2)
                                        End If
                                    End If
                                    If ldblTet > 0 And (ldblRet > ldblTet) Then
                                        ldblRet = Arredondar(ldblTet, 2)
                                    End If
                                ElseIf lstrTip = "F" Then
                                    '
                                    'caso for valor fixo
                                    '
                                    If ldblRet = 0 Then
                                        ldblRet = Arredondar(ldblVlr, 2)
                                    End If
                                    Call .MoveLast()
                                End If
                            End If
                            Call .MoveNext()
                        End While
                    End If
                    Call .Close()
                End If
            End With
        End If
        CalculaCodigosRegrasEspeciais = ldblRet
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
    End Function

    '[Função para verificar a matrícula dos sócios se existe alguma]
    Public Function GetMatriculaSocio(ByVal alngConsId As Integer) As String
        Dim lstrSql As String
        Dim lstrMat As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset

        lstrMat = "0"
        lstrSql = ""
        lstrSql = lstrSql & "SELECT * "
        lstrSql = lstrSql & "  FROM `consum` "
        lstrSql = lstrSql & " WHERE `consum`.`consreg` = " & alngConsId
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State > 0 Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    lstrMat = Trim(IIf(IsDBNull(.Fields("matricula").Value), "0", .Fields("matricula").Value))
                    If Len(lstrMat) = 0 Then lstrMat = CStr(0)
                End If
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        GetMatriculaSocio = lstrMat
    End Function

    Public Function GetMensagemTarifaAjuste(ByVal astrGrupo As String, ByVal astrClasse As String, ByVal adteLAnterior As Date, ByVal adteLAtual As Date) As String
        Dim ldblVlr As Double
        Dim lstrMsg As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        ldblVlr = 0
        lstrMsg = ""
        lstrSql = "SELECT * FROM tarifa_ajustes "
        lstrSql = lstrSql & " WHERE ((referencia_ini >= '" & VB6.Format(adteLAnterior, "yyyy-MM-dd") & " '"
        lstrSql = lstrSql & "   AND referencia_fim >= '" & VB6.Format(adteLAnterior, "yyyy-MM-dd") & " ') OR "
        lstrSql = lstrSql & "        (referencia_ini <= '" & VB6.Format(adteLAtual, "yyyy-MM-dd") & " '"
        lstrSql = lstrSql & "   AND referencia_fim <= '" & VB6.Format(adteLAtual, "yyyy-MM-dd") & " ')) "
        lstrSql = lstrSql & "   AND grupo = '" & astrGrupo & "' "
        lstrSql = lstrSql & "   AND " & CInt(astrClasse) & " BETWEEN classe_ini AND classe_fim "
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    ldblVlr = IIf(IsDBNull(.Fields("valor").Value), 0, .Fields("valor").Value)
                End If
                Call .Close()
            End If
        End With
        If ldblVlr > 0 Then
            lstrMsg = "Cfe.R.H.ANEEL n. 2.214/2017, de 1 a 30/04 a tarifa será reduzida em " & VB6.Format(ldblVlr, "#,#####0.00000") & " R$/kWh " & "para reverter a previsão do encargo de Energia de Reserva (EER) da Usina Angra III. O efeito na fatura se dará de acordo com seu ciclo de leitura. " & "Mais informações no site wwww.aneel.gov.br ou pelos canais convencionais de comunicação."
        End If
        GetMensagemTarifaAjuste = lstrMsg
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
    End Function

    Public Function GetValorTabela(ByVal astrTabela As String, ByVal astrCampo As String, Optional ByVal astrCriterio As String = "", Optional ByRef astrValorPadrao As String = "") As String
        Dim lstrRet As String
        Dim lstrSql As String
        Dim lrstAux As ADODB.Recordset
        lrstAux = New ADODB.Recordset
        lstrRet = astrValorPadrao
        lstrSql = "SELECT " & astrCampo & " FROM " & astrTabela & IIf(astrCriterio <> "", " WHERE ", "") & astrCriterio
        Call Conectar(lstrSql, lrstAux)
        With lrstAux
            If .State = ADODB.ObjectStateEnum.adStateOpen Then
                If .RecordCount > 0 Then
                    'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
                    lstrRet = IIf(IsDBNull(.Fields(0).Value), "", .Fields(0).Value)
                End If
                Call .Close()
            End If
        End With
        'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        lrstAux = Nothing
        GetValorTabela = lstrRet
    End Function

    Public Function GetCFOP(ByVal astrClasse As String, ByVal astrGrupo As String) As Integer
        Dim lintCla As Object
        Dim llngRet As Integer
        If astrGrupo = "B" Then
            If IsNumeric(astrClasse) Then
                'UPGRADE_WARNING: Couldn't resolve default property of object lintCla. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                lintCla = CShort(Left(astrClasse, 1))
                Select Case lintCla
                    Case Is < 4
                        llngRet = 5252
                    Case Is = 4
                        llngRet = 5253
                        If CDbl(Left(astrClasse, 2)) = 42 Then
                            llngRet = 5254
                        ElseIf CDbl(Left(astrClasse, 2)) = 43 Then
                            llngRet = 5255
                        End If
                    Case Is = 5
                        llngRet = 5256
                    Case Is = 8
                        llngRet = 5253
                    Case Else
                        llngRet = 5258
                End Select
            Else
                llngRet = 5258
            End If
        ElseIf astrGrupo = "A" Then
            llngRet = 5257
        Else
            llngRet = 5258
        End If
        GetCFOP = llngRet
    End Function
End Module