none
Converter Módulo VB6 para Vb.net RRS feed

  • Pergunta

  • Gostaria se possível que alguém me ajudasse a converter esse módulo em VB6 para VB.net. Para que eu possa importar para um proeto no Visual Studio 2010... 
    Attribute VB_Name = "TaskReport"
    Option Explicit                                   'requer declaração de variáveis
    DefInt A-Z                                        'estabelece todas inteiras, por default
    
    
    'Chamadas para o menu
      Private pMenus(200) As Long
      Private Type POINTAPI
        x As Long
        y As Long
      End Type
        
      Private Const MF_INSERT As Long = &H0&
      Private Const MF_CHANGE As Long = &H80&
      Private Const MF_APPEND As Long = &H100&
      Private Const MF_DELETE As Long = &H200&
      Private Const MF_REMOVE As Long = &H1000&
      Private Const MF_BYCOMMAND As Long = &H0&
      Private Const MF_BYPOSITION As Long = &H400&
      Private Const MF_SEPARATOR As Long = &H800&
      Private Const MF_ENABLED As Long = &H0&
      Private Const MF_GRAYED As Long = &H1&
      Private Const MF_DISABLED As Long = &H2&
      Private Const MF_UNCHECKED As Long = &H0&
      Private Const MF_CHECKED As Long = &H8&
      Private Const MF_USECHECKBITMAPS As Long = &H200&
      Private Const MF_STRING As Long = &H0&
      Private Const MF_BITMAP As Long = &H4&
      Private Const MF_OWNERDRAW As Long = &H100&
      Private Const MF_POPUP As Long = &H10&
      Private Const MF_MENUBARBREAK As Long = &H20&
      Private Const MF_MENUBREAK As Long = &H40&
      Private Const MF_UNHILITE As Long = &H0&
      Private Const MF_HILITE As Long = &H80&
      Private Const MF_SYSMENU As Long = &H2000&
      Private Const MF_HELP As Long = &H4000&
      Private Const MF_MOUSESELECT As Long = &H8000&
    
    
      Private Const TPM_RETURNCMD As Long = &H100&
    
      'API do Windows
      Private Declare Function CreatePopupMenu Lib "user32" () As Long
      Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu&) As Long
      Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpNewItem$) As Long
      Private Declare Function ClientToScreen& Lib "user32" (ByVal hWnd&, lpPoint As POINTAPI)
      Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu&, ByVal wFlags&, ByVal x&, ByVal y&, ByVal nReserved&, ByVal hWnd&, ByVal lpRect&) As Long
      Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu&, ByVal wIDEnableItem&, ByVal wEnable&) As Long
      Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
      Private Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
      
      Private Conn As Object
      Private MnDesejado As String
      Private MnCodigo As Integer
      Private MnGrupo As String
      Private MnGrupoUsuarios  As String
    
    '********* Chamadas para DLL do gerador de relatórios *******
    Public Declare Function P_ConfiguraBaseDados Lib "TaskReport.dll" (ByVal StringConexao As String, ByVal TipoBanco As Integer, ByVal NomeDoSistema As String, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_AbreGerador Lib "TaskReport.dll" (ByVal GrupoUsuarios As String, ByVal InformacaoAdicional As String, ByVal ArquivoINI As String, ByVal Serial As Long) As Boolean
    Public Declare Function P_CadastraModulos Lib "TaskReport.dll" (ByVal ModulosSistema As String, ByVal Tipo As Integer, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_ConfiguraModulos Lib "TaskReport.dll" (ByVal GrupoUsuarios As String, ByVal InformacaoAdicional As String, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_ExecutaModulos Lib "TaskReport.dll" (ByVal NomeDoModulo As String, ByVal GrupoUsuarios As String, ByVal Filtro As String, ByVal InformacaoAdicional As String, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_EnCryptaString Lib "TaskReport.dll" (ByVal Source As String, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_AbreRelatorioArquivado Lib "TaskReport.dll" () As Boolean
    
    '--NOVAS
    
    Public Declare Function P_AcessoRelatorios Lib "TaskReport.dll" (ByVal GrupoUsuarios As String, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_ImportaRelatorios Lib "TaskReport.dll" (ByVal GrupoUsuarios As String, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_DefineIDRelatorio Lib "TaskReport.dll" (ByVal GrupoUsuarios As String, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_ExecutaConsulta Lib "TaskReport.dll" (ByVal SQL As String, ByVal NomeConsulta As String, ByVal ArquivoINI As String) As Boolean
    Public Declare Function P_ExecutaEmail Lib "TaskReport.dll" (ByVal IdRelatorio As String, ByVal GrupoUsuarios As String, ByVal CampoFiltro As String, ByVal SQL As String, ByVal Arquivo As String, ByVal smtp As String, ByVal Origem As String, ByVal CampoDestino As String, ByVal Assunto As String, ByVal Mensagem As String, ByVal usuario As String, ByVal senha As String, ByVal ArquivoINI As String, ByVal Autentica As Boolean) As Boolean
    
    Public Declare Function P_MontaMenu Lib "TaskReport.dll" (ByVal GrupoUsuarios As String, ByVal InformacaoAdicional As String, ByVal ArquivoINI As String, ByVal Pontox As Long, ByVal PontoY As Long) As Boolean
    
    Public Declare Function P_AbreAgenda Lib "TaskReport.dll" () As Boolean
    
    '--funcao incluida em 15-02-08
    Public Declare Function P_AbreAgenda_AutoOpen Lib "TaskReport.dll" () As Boolean
    
    '--funcao para setar o diretorio corrente
    
    Public Declare Function P_SetaDiretorioCorrente Lib "TaskReport.dll" (ByVal Diretorio as String) As Boolean
    Public Declare Function P_UtilizaBancoAlternativo Lib "TaskReport.dll" () As Boolean
    
    
    
    #If False Then
     'Gerador de relatórios
     Public Declare Sub NadaFaz Lib "TaskReport.exe" ()
     Public Declare Sub NadaFaz Lib "TaskReport.dll" ()
     Public Declare Sub NadaFaz Lib "Relatorios.mdb" ()
    #End If
    
    '********* Chamadas para taskReport *******
    'Adicione esta função, para configurar a base de dados e informar o banco que ira utilizar
    Public Sub TR_ConfiguraBaseDados(Optional ByVal StringConexao As String = "", Optional ByVal TipoBanco As Integer = 1, Optional ByVal ArquivoINI As String = "")
     On Error GoTo TR_ConfiguraBaseDados_Erro
    
     P_SetaDiretorioCorrente(App.Path)
    
     P_ConfiguraBaseDados StringConexao, TipoBanco, App.ProductName, ArquivoINI
    
     On Error GoTo 0
     Exit Sub
    
    TR_ConfiguraBaseDados_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_ConfiguraBaseDados de Módulo TaskReport"
    End Sub
    
    
    '//**********************************************************************************************
    '//abre o explorer dos relatorios onde se cria, exclui ou altera os relatorios
    '// usar a funcao em um menu ou botao no formulario principal
    Public Sub TR_AbreGerador(Optional ByVal GrupoUsuarios As String, Optional ByVal InformacaoAdicional As String = "", Optional ByVal ArquivoINI As String = "", Optional ByVal Serial As Long)
     On Error GoTo TR_AbreGerador_Erro
    
     If GrupoUsuarios = "" Then
        GrupoUsuarios = vgPWGrupo
     End If
    
     P_SetaDiretorioCorrente(App.Path)
    
     P_AbreGerador GrupoUsuarios, InformacaoAdicional, ArquivoINI, Serial
    
     On Error GoTo 0
     Exit Sub
    
    TR_AbreGerador_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_AbreGerador de Módulo TaskReport"
    End Sub
    
    
    '////////////////////////////////////////////////////////////////////////////////////////////
    '//cadastra os modulos que o sistema possui no banco relatorios na tabela RelatoriosModulos
    '//pode ser chamada no show do sistema, nao da mensagem caso ja exista os registros no banco
    '//e so inclui os que nao foram encontrados!
    Public Sub TR_CadastraModulos(ByVal ModulosSistema As String, Optional ByVal Tipo As Integer = 1, Optional ByVal ArquivoINI As String = "")
     On Error GoTo TR_CadastraModulos_Erro
    
     P_SetaDiretorioCorrente(App.Path)
    
     P_CadastraModulos ModulosSistema, Tipo, ArquivoINI
    
     On Error GoTo 0
     Exit Sub
    
    TR_CadastraModulos_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_CadastraModulos de Módulo TaskReport"
    End Sub
    
    
    '//**********************************************************************************************
    '//funcao para o usuario final definir QUANDO ou ONDE os relatorios iram ser mostrados, executados
    '//usar a funcao em um menu ou botao no formulario principal
    '//os modulos disponiveis sao cadastrados pela funcao anterior
    Public Sub TR_ConfiguraModulos(ByVal GrupoUsuarios As String, Optional ByVal InformacaoAdicional As String = "", Optional ByVal ArquivoINI As String = "")
     On Error GoTo TR_ConfiguraModulos_Erro
    
     If GrupoUsuarios = "" Then
        GrupoUsuarios = vgPWGrupo
     End If
    
     P_SetaDiretorioCorrente(App.Path)
    
     P_ConfiguraModulos GrupoUsuarios, InformacaoAdicional, ArquivoINI
    
     On Error GoTo 0
     Exit Sub
    
    TR_ConfiguraModulos_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_ConfiguraModulos de Módulo TaskReport"
    End Sub
    
    
    
    '//**********************************************************************************************
    '//abre tela para definir acesso aos relatorios, nao e obrigatoria, pois ja tem um botão no explorer
    '// usar a funcao em um menu ou botao no formulario principal
    Public Sub TR_AcessoRelatorios(Optional ByVal GrupoUsuarios As String, Optional ByVal ArquivoINI As String = "")
     On Error GoTo TR_AcessoRelatorios_Erro
    
     If GrupoUsuarios = "" Then
        GrupoUsuarios = vgPWGrupo
     End If
    
     P_SetaDiretorioCorrente(App.Path)
    
     P_AcessoRelatorios GrupoUsuarios, ArquivoINI
    
     On Error GoTo 0
     Exit Sub
    
    TR_AcessoRelatorios_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_AcessoRelatorios de Módulo TaskReport"
    End Sub
    
    
    '//**********************************************************************************************
    '//abre tela para importar relatorios, nao e obrigatoria, pois ja tem um botão no explorer
    '// usar a funcao em um menu ou botao no formulario principal
    Public Sub TR_ImportaRelatorios(Optional ByVal GrupoUsuarios As String, Optional ByVal ArquivoINI As String = "")
     On Error GoTo TR_ImportaRelatorios_Erro
    
     If GrupoUsuarios = "" Then
        GrupoUsuarios = vgPWGrupo
     End If
    
     P_SetaDiretorioCorrente(App.Path)
    
     P_ImportaRelatorios GrupoUsuarios, ArquivoINI
    
     On Error GoTo 0
     Exit Sub
    
    TR_ImportaRelatorios_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_ImportaRelatorios de Módulo TaskReport"
    End Sub
    
    
    
    '//mostra ao usuario final os relatorios cadastrados no modulo
    '//passa como parametro um ou mais modulos
    '//o parametro  InformacaoAdicional pode ser utilizado dentro dos relatorios, para capturar essa informação para
    '//utilizar no relatorio utilizando a funcao PegaInformacaoAdicional
    
    Public Sub TR_ExecutaModulos(ByVal NomeDoModulo As String, Optional ByVal GrupoUsuarios As String = "", Optional ByVal Filtro As String = "", Optional ByVal InformacaoAdicional As String = "", Optional ByVal ArquivoINI As String = "")
    Dim x As String, inicio As Integer, Fim As Integer, i As Integer
     On Error GoTo TR_ExecutaModulos_Erro
    
     Filtro = TR_MontaFiltro(Filtro)
     If GrupoUsuarios = "" Then 
        GrupoUsuarios = vgPWGrupo
     End if
    
     P_SetaDiretorioCorrente(App.Path)
    
     P_ExecutaModulos NomeDoModulo, vgPWGrupo, Filtro, InformacaoAdicional, ArquivoINI
     
     'Forçar foco no TaskReport
     BringWindowToTop (ProcuraJanela("TaskReport - Gerador de Relatorios - MODULO"))
     
     On Error GoTo 0
     Exit Sub
    
    TR_ExecutaModulos_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_ExecutaModulos de Módulo TaskReport"
    End Sub
    
    
    Public Sub TR_EnCryptaString(ByVal Source As String, Optional ByVal ArquivoINI As String = "")
     On Error GoTo TR_EnCryptaString_Erro
    
     P_EnCryptaString Source, ArquivoINI
    
     On Error GoTo 0
     Exit Sub
    
    TR_EnCryptaString_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_EnCryptaString de Módulo TaskReport"
    End Sub
    
    Public Sub TR_Relatorio(IdRelatorio As String, Filtro As String, Destino As Integer, vgNomeArquivo As String, Optional ByVal InformacaoAdicional As String = "", Optional ByVal ArquivoINI As String = "")
    Dim x As String
     On Error GoTo TR_Relatorio_Erro
    
     x = "{" & IdRelatorio & "|" ' vgDestino & "|" & vgFormatoSaida & "|" & XvgArquivo.Value
    Select Case Destino
    Case 0
     x = x & "2"
    Case 1
     x = x & "6"
    Case 2
     x = x & "7"
    Case 3
     x = x & "8"
    End Select
    x = x & "|" & vgNomeArquivo & "}"
    TR_ExecutaModulos x, "", Filtro, InformacaoAdicional, ArquivoINI
    
     On Error GoTo 0
     Exit Sub
    
    TR_Relatorio_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_Relatorio de Módulo TaskReport"
    End Sub
    
    '*************************************************************
    'Funçao interna para tratar filtro ao executar modulo
    'Ao chamar TR_ExecutaModulos(,,Filtro), No Filtro caso queira imprimir um registro respectio de uma janela de dados
    'Basta informar "{CampoTal}" desta forma, a função abaixo irá montar a expressão correta.
    'Se tiver mais de um campo, use: "{CampoTal1,CampoTal2,}"
    'Se quiser passar todos os campos use": "{*}"
    
    Private Function TR_MontaFiltro(Filtro As String) As String
    Dim x As String, y As String, i As Integer, F As Form
     On Error GoTo TR_MontaFiltro_Erro
    
     If InStr(Filtro, "{") > 0 Then
      For i = 0 To Forms.Count - 1
       If TypeOf Forms(i) Is MDIForm Then
        Set F = Forms(i)
        i = Forms.Count
       End If
      Next
     Else
      TR_MontaFiltro = Filtro
     End If
    
    If Filtro = "{*}" Then
     For i = 0 To F.ActiveForm.vgTb.Fields.Count - 1
      y$ = F.ActiveForm.vgTb.Fields(i).Name
      GoSub MontaTxtFiltro
     Next
    Else
     If InStr(Filtro, "{") > 0 Then
      i = InStr(Filtro, "{") + 1
      y$ = Mid(Filtro, i, InStr(i, Filtro, "}") - i)
      x$ = y$
      Filtro = Substitui(Filtro, "{" & x$ & "}", "", SO_UM)
      Do While Len(x$) > 0
       y$ = Parse(x$, ",")
       GoSub MontaTxtFiltro
      Loop
     End If
    End If
    Exit Function
    
    PreparaTxt:
     TR_MontaFiltro = TR_MontaFiltro & IIf(Len(TR_MontaFiltro) > 0, "|", "") & y$ & "|"
    Return
    
    MontaTxtFiltro:
      Select Case F.ActiveForm.vgTb.Fields(y$).Type
       Case 200, 201, 202, 5, 4, 10, 3, 11, 2
        GoSub PreparaTxt
        TR_MontaFiltro = TR_MontaFiltro & F.ActiveForm.vgTb.Fields(y$).Value
       Case 135, 8
        GoSub PreparaTxt
        TR_MontaFiltro = TR_MontaFiltro & Format(F.ActiveForm.vgTb.Fields(y$).Value, "dd/mm/yyyy")
       Case 7
        GoSub PreparaTxt
        TR_MontaFiltro = TR_MontaFiltro & Substitui(F.ActiveForm.vgTb.Fields(y$).Value, ",", ".", UM_A_UM)
       Case Else
        Debug.Print "não montado para -> " & F.ActiveForm.vgTb.Fields(y$).Name
      End Select
    Return
    
     On Error GoTo 0
     Exit Function
    
    TR_MontaFiltro_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_MontaFiltro de Módulo TaskReport"
    End Function
    
    
    'funcao preparada apenas para banco de relatorios gravados em access, para outros bancos fazer os devidos ajustes!
    
    Public Sub TR_menu(Optional GrupoUsuarios As String, Optional MenuDesejado As String, Optional MostraMenuSair As Boolean)
    
      Dim pt As POINTAPI
      Dim Relatorios As Recordset
      Dim rsFilho As Recordset
      Const ID_SEPERATOR As Long = &H6001
      Const ID_DISABLED As Long = &H6002&
    
      Const ID_EDIT As Long = 1
      Const ID_PASTE As Long = 2
      Dim i As Long
      Dim ii As Long
     On Error GoTo TR_menu_Erro
    
      Set Conn = CreateObject("ADODB.Connection")
      Conn.Provider = "Microsoft.Jet.OLEDB.4.0"
      Conn.Open PegaStrDoIni("GERAL", "BANCO RELATORIOS", App.Path & "\TaskReport.ini")
      MnDesejado = MenuDesejado
      MnGrupoUsuarios = IIf(GrupoUsuarios = "", vgPWGrupo, GrupoUsuarios)
      MontaArvoreMenu 0, MostraMenuSair, True
      With pt  '
        ' pega as coordenadas do mouse
        GetCursorPos pt
        ' Chama api para mostrar o menu e retornar um valor
        i = TrackPopupMenu(pMenus(MnCodigo), TPM_RETURNCMD, .x, .y, 0&, Forms(0).hWnd, 0&)
        Select Case i
          Case 0
            'MsgBox "Cancelou", vbExclamation
          Case Else
            TR_Relatorio Str(i), "", 0, ""
        End Select
      End With
      DestroiMenus
      
      Conn.Close
      Set Conn = Nothing
      
     On Error GoTo 0
     Exit Sub
    
    TR_menu_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função TR_menu de Módulo TaskReport"
    End Sub
    
    Private Function MontaArvoreMenu(id As Integer, Optional AddMenuSair As Boolean = False, Optional PrimeiraVez As Boolean = False)
    Dim rs As Object, Relatorios As Object
     On Error GoTo MontaArvoreMenu_Erro
    
    Set rs = CreateObject("ADODB.recordset")
    Set Relatorios = CreateObject("ADODB.recordset")
    If PrimeiraVez Then
     rs.Open "select * from RelatoriosAcessos where Grupo = '" & MnGrupoUsuarios & "'", Conn
     If Not rs.EOF Then MnGrupo = rs.Fields("RELATORIOS")
     rs.Close
    End If
    
      'Cria as Pastas onde estarao posicionados os relatorios
       rs.Open "select * from Pastas where parentId=" & id, Conn
      'If pMenus(0) = 0 Then pMenus(0) = CreatePopupMenu()
       Do While Not rs.EOF
        MontaArvoreMenu (rs.Fields(0).Value)
        If pMenus(rs.Fields(2).Value) = 0 Then pMenus(rs.Fields(2).Value) = CreatePopupMenu()
        If ((InStr(MnDesejado, rs.Fields(1).Value) > 0 Or MnDesejado = "") And rs.Fields(2).Value = 0) Or rs.Fields(2).Value <> 0 Then
         If TemPastaRel(Rs.Fields(0).Value) Then
          Call AppendMenu(pMenus(rs.Fields(2).Value), MF_STRING Or MF_POPUP, pMenus(rs.Fields(0).Value), ByVal rs.Fields(1).Value)
         End If
         If InStr(MnDesejado, "|") > 0 Or MnDesejado = "" Then
          MnCodigo = 0
         Else
          MnCodigo = rs.Fields(0).Value
         End If
         Debug.Print rs.Fields(0).Value, rs.Fields(1).Value
        End If
        rs.MoveNext
       Loop
      
       'Cria relatorios nas devidas pastas
       Relatorios.Open "select * from relatorios where FolderID = " & id & " and InStr('" & MnGrupo & "', Format(ItemID, '0000S')) > 0", Conn
       
       If Not Relatorios.EOF Then If pMenus(Relatorios.Fields("FolderID").Value) = 0 Then pMenus(Relatorios.Fields("FolderID").Value) = CreatePopupMenu()
       Do While Not Relatorios.EOF
        Call AppendMenu(pMenus(Relatorios.Fields("FolderID").Value), MF_STRING, Relatorios.Fields("ItemID").Value, ByVal Relatorios.Fields("ItemName").Value)
        Debug.Print Relatorios.Fields("ItemName").Value
        Relatorios.MoveNext
       Loop
       
       If AddMenuSair = True Then
        Call AppendMenu(pMenus(0), MF_SEPARATOR Or MF_POPUP, 0, 0)
        Call AppendMenu(pMenus(0), MF_STRING Or MF_POPUP, 0, "Sair")
       End If
       Relatorios.Close
       Set Relatorios = Nothing
    
       rs.Close
       Set rs = Nothing
    
     On Error GoTo 0
     Exit Function
    
    MontaArvoreMenu_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função MontaArvoreMenu de Módulo TaskReport"
    End Function
    
    
    Private Function TemPastaRel(id As String) As Boolean
    Dim Rs As Object, subRs As Object
    Set Rs = CreateObject("ADODB.recordset")
    Set subRs = CreateObject("ADODB.recordset")
    Rs.Open "select * from Pastas where parentId=" & id, Conn
    If Not Rs.EOF Then
     TemPastaRel = TemPastaRel(Rs.Fields("FolderId"))
     Rs.Close
     Rs.Open "select * from relatorios where FolderID = " & id & " and InStr('" & MnGrupo & "', Format(ItemID, '0000S')) > 0", Conn
     If Not Rs.EOF Then
      TemPastaRel = True
     End If
    Else
     Rs.Close
     Rs.Open "select * from relatorios where FolderID = " & id & " and InStr('" & MnGrupo & "', Format(ItemID, '0000S')) > 0", Conn
     If Not Rs.EOF Then
      TemPastaRel = True
     Else
      TemPastaRel = False
     End If
    End If
    Rs.Close
    Set Rs = Nothing
    End Function
    Private Sub DestroiMenus()
    Dim i As Integer
      ' Vamos destruir o menu, caso exista ainda...
     On Error GoTo DestroiMenus_Erro
    
    For i = 0 To UBound(pMenus)
      If pMenus(i) Then
        Call DestroyMenu(pMenus(i))
        pMenus(i) = 0
      End If
    Next
    
     On Error GoTo 0
     Exit Sub
    
    DestroiMenus_Erro:
     MsgBox "Erro " & Err.Number & " (" & Err.Description & ") na função DestroiMenus de Módulo TaskReport"
    End Sub
    
    
    'verifica se a aplicação já está rodando
    Private Function ProcuraJanela(vgTit As String) As Long
     Dim vgTitForm As String * 256, x As String, vgTamaTit As Long, wnd As Long
     wnd = FindWindow(0&, 0&)                         'diz ao windows a tarefa que queremos
     wnd = GetWindow(wnd, 0)               'pega handle da 1a. janela aberta
     While wnd <> 0                                   'a janela existe?
      vgTamaTit = GetWindowText(wnd, vgTitForm, 256)  'titulo da janela
      If vgTamaTit > 0 Then                           'se existe título
       x$ = Left$(vgTitForm, vgTamaTit)               'ajeita o título lido
       If UCase$(x$) = UCase$(vgTit$) Then            'procura nome da aplicação no título
        ProcuraJanela = wnd                           'achou rodando
        Exit Function                                 'não precisa testar mais...
       End If
      End If
      wnd = GetWindow(wnd, 2)               'pega a próxima janela que está rodando
     Wend
     ProcuraJanela = 0                                'correu todas janelas e não achou a aplicação
    End Function

    quinta-feira, 30 de abril de 2015 16:18

Respostas

  • Bom dia usuário,

    Sugiro que tente utilizar algum conversor de código online para solucionar seu problema. Segue alguns links para você tentar converter seu código.

    https://www.varycode.com/converter.html

    http://www.developerfusion.com/tools/convert/csharp-to-vb/

    Qualquer nova dúvida, estamos à disposição.

    Obrigado,

    Abraço!


    Eduardo Romero

    Esse conteudo e fornecido sem garantias de qualquer tipo, seja expressa ou implicita.

    MSDN Community Support

    Por favor, lembre-se de Marcar como Resposta as respostas que resolveram o seu problema. Essa e uma maneira comum de reconhecer aqueles que o ajudaram e fazer com que seja mais facil para os outros visitantes encontrarem a resolucao mais tarde.

    segunda-feira, 4 de maio de 2015 18:12
    Moderador

Todas as Respostas