Ir para conteúdo

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Rogério Orlando

[Resolvido] Verifcar nome do usuário do PC

Recommended Posts

TIra isso do seu form e poe em um módulo.

    Public Declare Function fCreateShellLink Lib "vb6stkit.DLL" (ByVal _
        lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
        lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long

Deixe como Public.

 

Veja se dá segunda vez que você executa, o caminho do desktop ainda é recuperado.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Scorpio, não adiantou.

 

Mudei até meu form para testar com botões, mas não deu.

 

Se puder analise meu código, está tudo como você ensinou:

 

Option Explicit

Dim Caminho_Desktop As String

Private Sub Command1_Click()
Caminho_Desktop = "C:\Documents and Settings\Administrador\Desktop"
        Call fCreateShellLink(Caminho_Desktop, _
        "Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
        
        MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."

End Sub

Private Sub Command2_Click()
Caminho_Desktop = "C:\Documents and Settings\Administrador\Desktop"
        Call fCreateShellLink(Caminho_Desktop, _
        "Reconhecimento Fotográfico", "C:\Arquivos de programas\Assuntos Internos\fotos\PrjRecoFoto.exe", "")
        
        MsgBox "Atalho do aplicativo <Reconhecimento Fotográfico> criado com sucesso."

End Sub

Private Sub Command3_Click()
Caminho_Desktop = "C:\Documents and Settings\Administrador\Desktop"
        Call fCreateShellLink(Caminho_Desktop, _
        "Disque Denúncia - (181)", "C:\Arquivos de programas\Disque Denúncia\Disque Denúncia - 181.exe", "")
        
        MsgBox "Atalho do aplicativo <Disque Denúncia - (181)> criado com sucesso."

End Sub

E num módulo modulo constei como disse:

 


Public Declare Function fCreateShellLink Lib "vb6stkit.DLL" (ByVal _
        lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
        lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long

 

Pergunta: Não teria uma forma de "zerar" o valor de "fCreateShellLink"?

 

Valeu novamente.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Não sei mais o que pode ser.

 

Tenta criar o atalho de outra maneira.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Scorpio valeu por todas as dicas que me passou, foram de grande valor, só que meu projeto verifica quais aplicativos, entre os 5 possíveis, o cliente intalou e quer adicionar o atalho, então fica difícil individualizar os formulários para as perguntas sobre o atalho.

 

O tópico em si foi resolvido, portanto creio que pode constar como tal, entretanto vou abrir outro para verificar se alguém sabe como "zerar" a função

fCreateShellLink
, a fim de utilizá-la no mesmo formulário para instalar outro aplicativo.

 

Valeu por enquanto, pois é certo que novas dúvidas surgiram, inclusive esta.

 

Um abraço, valeu.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Não há necessidade de abrir outro tópico.

 

Quanto a limpar a função, não conheço nada que o faça e nem nada que impeça de executar a função.

 

 

Tente fazer o restart de forma automatica se não ficar lento.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Scorpio, voltei!

 

Agora para participar que "inventei" uma solução para a impossibilidade de criar mais de um atalho num mesmo projeto.

 

Quando o usuário pede para instalar um aplicativo, direciono-o para o formAtalho, que através do Shell abre e fecha um executável(visible=false) que faz a função "fCreateShellLink", assim sucessivamente com todos os outros aplicativos, ou seja, abre e fecha seu respectivo executável, como nas fórmulas abaixo.

 

Private Sub Image1_Click()
    AbrePrograma = Shell(App.Path & "\Executável AI\Setup.exe", vbMaximizedFocus)
    Image1.Enabled = False
    AI = "AI"
    frmAtalho.lblTipo.Caption = "AI"
    frmAtalho.Show 1
End Sub
Private Sub Image2_Click()
    AbrePrograma = Shell(App.Path & "\Executável DD\Setup.exe", vbMaximizedFocus)
    DD = "DD"
    Image2.Enabled = False
    frmAtalho.lblTipo.Caption = "DD"
    frmAtalho.Show 1
End Sub
Private Sub Image3_Click()
    AbrePrograma = Shell(App.Path & "\Executável PS\Setup.exe", vbMaximizedFocus)
    PS = "PS"
    Image3.Enabled = False
    frmAtalho.lblTipo.Caption = "PS"
    frmAtalho.Show 1
End Sub
Private Sub Image4_Click()
    AbrePrograma = Shell(App.Path & "\Executável BFC\Setup.exe", vbMaximizedFocus)
    BFC = "BFC"
    Image4.Enabled = False
    frmAtalho.lblTipo.Caption = "BFC"
    frmAtalho.Show 1
End Sub

Private Sub Image5_Click()
    Image5.Enabled = False
    frmAtalho.lblTipo.Caption = "Reco"
    frmAtalho.Show 1

End Sub

Abre o frmAtalho:

Private Sub cmdSim_Click()

Select Case lblTipo.Caption
    Case Is = "AI"
        AbrePrograma = Shell(App.Path & "\Atalhos\AI_atalho.exe", vbNormalFocus)
        frmDistribuidor.cmdAtalhoAI.Visible = True
        frmDistribuidor.Image1.Enabled = False
    Case Is = "Reco"
        AbrePrograma = Shell(App.Path & "\Atalhos\RECO_atalho.exe", vbNormalFocus)
        frmDistribuidor.cmdAtalhoReco.Visible = True
        frmDistribuidor.Image5.Enabled = False
    Case Is = "DD"
        AbrePrograma = Shell(App.Path & "\Atalhos\DD_atalho.exe", vbNormalFocus)
        frmDistribuidor.cmdAtalhoDD.Visible = True
        frmDistribuidor.Image2.Enabled = False
    Case Is = "PS"
        AbrePrograma = Shell(App.Path & "\Atalhos\PS_atalho.exe", vbNormalFocus)
        frmDistribuidor.cmdAtalhoPS.Visible = True
        frmDistribuidor.Image3.Enabled = False
    Case Is = "BFC"
        AbrePrograma = Shell(App.Path & "\Atalhos\BFC_atalho.exe", vbNormalFocus)
        frmDistribuidor.cmdAtalhoBFC.Visible = True
        frmDistribuidor.Image4.Enabled = False
End Select
    Unload Me
End Sub

Que abre e instala seu respectivo atalho.

 

 

Valeu cara, muito obrigado pelas informações e tentativas de auxiliar-me.

 

Pode carimbar como resolvido.

 

Valeu...

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.