Registrar DLL/OCX pelo VB

[MRMB]

Olá pessoal,

Estou com o seguinte problema. Tenho a necessidade de registrar DLL/OCX pelo VB6. No caso, seria um executável para atualizar as DLL/OCX do sistema e é necessário desregistrar as DLL/OCX (Antigas) e registrar novas DLL/OCX nas máquinas dos usuários.

Estou fazendo teste com a função ShellExecute e utilizando "runas" para executar como administrador.

Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

' variáveis de controle de erros.
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Private Const SE_ERR_ACCESSDENIED = 5          
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const SE_ERR_DDETIMEOUT = 28
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_OOM = 8                     
Private Const SE_ERR_SHARE = 26

Private Sub Command1_Click()

    Dim lngAux As Long
  
    lngAux = ShellExecute( _
        Me.hwnd, "runas", _
        "C:\WINDOWS\system32\regsvr32.exe", "/u C:\EXTributacaoIPI.dll", _
        "C:\", 0)
        
    If lngAux <= 32 Then
      Select Case lngAux
        Case 0
          MsgBox "Out of memory or resources", vbOKOnly Or vbExclamation, "Error"
        Case ERROR_FILE_NOT_FOUND
          MsgBox "File not found", vbOKOnly Or vbExclamation, "Error"
        Case ERROR_PATH_NOT_FOUND
          MsgBox "Path not found", vbOKOnly Or vbExclamation, "Error"
        Case ERROR_BAD_FORMAT
          MsgBox "Invalid .EXE file", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_ACCESSDENIED      '  access denied
          MsgBox "File access denied", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_ASSOCINCOMPLETE
          MsgBox "Invalid file name association", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_DDEBUSY
          MsgBox "DDE busy", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_DDEFAIL
          MsgBox "DDE transaction failed", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_DDETIMEOUT
          MsgBox "DDE timeout", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_DLLNOTFOUND
          MsgBox "DLL not found", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_NOASSOC
          MsgBox "No associated application", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_OOM                  '  out of memory
          MsgBox "Out of memory", vbOKOnly Or vbExclamation, "Error"
        Case SE_ERR_SHARE
          MsgBox "Sharing violation", vbOKOnly Or vbExclamation, "Error"
        Case Else
          MsgBox "Unknown error " & lngAux, vbOKOnly Or vbExclamation, "Error"
      End Select
      
    End If
    
End Sub

Ao executar o código acima é exibida a tela pedindo a senha de administrador. No caso preciso que não seja solicitado essa senha.

Caso alguém saiba como passar senha de determinado usuário pelo código também ajudaria.

Desde já agradeço atenção!

Editado Setembro 6, 2010 por Crispim

[kuroi]

crispim, ele abre a janela do dos pedindo senha, não é isso??

você poderia usar o sendkeys pra escrever a senha, como foi feito nesse tópico: http://scriptbrasil.com.br/forum/index.php?showtopic=124445

[MRMB]

Obrigado pela dica esta ajudando e muito.

contudo aparece a tela abaixo e não o DOS:

' Tela acima aparece ao executar a linha abaixo

    lngAux = ShellExecute( _
        Me.hwnd, "runas", _
        "C:\WINDOWS\system32\regsvr32.exe", "C:\EXTributacaoIPI.dll", _
        "C:\", 0)
        

    ' Ao chegar neste ponto a janela já "fechou"

    Sleep 2000 ' Para "dormir" 2 segundos
    
    hWindow = FindWindow(vbNullString, "C:\WINDOWS\system32\regsvr32.exe")
    SetForegroundWindow hWindow
    SendKeys "123456"
    SendKeys "{ENTER}"

No caso não consegui informar a senha. Verificando a imagem da tela precisaria selecionar o "Administrador" e informar a senha.

Editado Setembro 6, 2010 por Crispim

[kuroi]

crispim, a imagem q ta aparecendo é "403 forbidden".

mas acho q deve ser a janela do windows mesmo q aparece, com dois campos, certo??

você não poderia primero escrever o nome do administrador no primeiro campo, e depois usar um SendKeys "{TAB}", pra passar de campo e depois escrever o login??

[MRMB]

Então kuroi vou verificar a opção do TAB que comentou.

Estou fazendo outros testes também.

Por exemplo o comando abaixo esta registrando/desregistrando as DLL no dominio caso o "Usuario Dominio" tenha permissão.

Contudo tem dois problemas ainda:

1 - Ao executar o código abaixo abre algumas janelas do cmd.exe (2 janelas)

2 - Utilizando a opção vbHide na execução do cmd.exe "parece" que o registro não funciona.

Private Sub Command1_Click()

    Dim dblAux As Double
    
    dblAux = Shell("cmd.exe", vbMinimizedFocus) ' vbHide
    
    Sleep 2000
    
    hWindow = FindWindow(vbNullString, "cmd.exe")
    SetForegroundWindow hWindow
    
    
    SendKeys "runas /user:""Usuario Dominio"" ""regsvr32.exe /u C:\TesteDLLReg.dll"""
    SendKeys "{ENTER}"
    Sleep 1000
    SendKeys "123456"
    SendKeys "{ENTER}"
    Sleep 1000
    
    
End Sub

teria alguma opinião/dica para melhorar o código acima?

[kuroi]

você podia tentar esconder a janela usando a api ShowWindow(), de uma olhada naquele tópico q passei q falo sobre isso la.

[MRMB]

kuroi, realizei alguns testes com sucesso usando uma ferramenta gratuita CPAU. Até o momento realizei teste com Windows XP, vou verificar no Windows 7 (32/64) também.

É bem pratico logar com usuário e senha em uma máquina no domínio.

http://www.joeware.net/freetools/tools/cpau/index.htm

Exemplos:

http://www.novell.com/coolsolutions/tip/15659.html

Abaixo utilização do CPAU pelo VB6

Private Sub cmdUnRegDLL_Click()

  ' Desregistrar - DLL
  Dim teste As Double
  
  teste = Shell("C:\CPAU.EXE -u ""Usuario"" -p 123456 -ex ""regsvr32.exe /u /s C:\Teste.dll"" -profile -wait", vdHide)
End Sub

Private Sub cmdRegDLL_Click()
  
  ' Registrar - DLL
  Dim teste As Double
  
  teste = Shell("C:\CPAU.EXE -u ""Usuario"" -p 123456 -ex ""regsvr32.exe /s C:\Teste.dll"" -profile -wait", vdHide)

End Sub

Private Sub cmdUnRegComponente_Click()
  
  ' Desregistrar - Componente
  Dim teste As Double
  
  teste = Shell("C:\CPAU.EXE -u ""Usuario"" -p 123456 -ex ""regsvr32.exe /u C:\componente.ocx"" -profile -wait", vdHide)

End Sub

Private Sub cmdRegComponente_Click()

  ' Registrar - Componente
  Dim teste As Double
  
  teste = Shell("C:\CPAU.EXE -u ""Usuario"" -p 123456 -ex ""regsvr32.exe C:\componente.ocx"" -profile -wait", vdHide)

End Sub

Editado Setembro 9, 2010 por Crispim

[kuroi]

legal, não conhecia esse programa.

mas parece q ele não é atualizado há muito tempo, veja ai se vai funcionar no windows 7.

[MRMB]

Então kuroi o programa é fino! Até o momento 100%

Realizei testes com Windows 7 32 bits, registro de DLL's e OCX e funcionou!

Caso ocorra algum problema coloco aqui no fórum. Falta realizar testes com Windows 64 bits.

T+

Editado Setembro 10, 2010 por Crispim