[Resolvido] Verifcar nome do usuário do PC

Rogério Orlando · Agosto 14, 2009

Boa noite.

Estou necessitando descobrir o nome do usuário do Computador, pois meu aplicativo instala um atalho na área de trabalho, sendo assim, cada computador tem um usuário diferente e não consegui achar uma solução para o problema.

O código que uso para criar o atalho é o que demonstro abaixo:

Select Case lblTipo.Caption

Case Is = "AI"

lReturn = fCreateShellLink("C:\Documents and Settings\All Users ou Administrador\Desktop", _

"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")

MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."

scorpio · Agosto 15, 2009

Tenta colocar

lReturn = fCreateShellLink("%USERPROFILE%\Desktop", _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")

Rogério Orlando · Agosto 15, 2009

Tenta colocar

lReturn = fCreateShellLink("%USERPROFILE%\Desktop", _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")

Obrigado novamente pelas respostas, entretanto não funcionou.

Será que não há a necessidade de declarar alguma variável?

O código e as declarações estão como abaixo:

Option Explicit

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

Private Sub cmdNao_Click()
    Unload Me
End Sub

Private Sub cmdSim_Click()
Select Case lblTipo.Caption
    Case Is = "AI"
        lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
        "Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
        MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."
        
        frmDistribuidor.cmdAtalhoAI.Visible = True
        frmDistribuidor.Image1.Enabled = False
    Case Is = "Reco"
        lReturn = fCreateShellLink("%USERPROFILE%\Desktop", _
        "Reconhecimento Fotográfico", "C:\Arquivos de programas\Assuntos Internos\fotos\PrjRecoFoto.exe", "")
        MsgBox "Atalho do aplicativo <Reconhecimento Fotográfico> criado com sucesso."
        
        frmDistribuidor.cmdAtalhoReco.Visible = True
        frmDistribuidor.Image5.Enabled = False
    Case Is = "DD"
        lReturn = fCreateShellLink("C:\Documents and Settings\All Users\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."

        frmDistribuidor.cmdAtalhoDD.Visible = True
        frmDistribuidor.Image2.Enabled = False

    Case Is = "PS"
        lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
        "Político Social", "C:\Arquivos de programas\Banco de Dados Político Social\BDPS Politico Social.exe", "")
        MsgBox "Atalho do aplicativo <Político Social> criado com sucesso."

        frmDistribuidor.cmdAtalhoPS.Visible = True
        frmDistribuidor.Image3.Enabled = False
        
    Case Is = "BFC"
        lReturn = fCreateShellLink("C:\Documents and Settings\Administrador\Desktop", _
        "Base Fotográfica Criminal", "C:\Arquivos de programas\PrjBasFCrim\Cadastro Criminal.exe", "")
        MsgBox "Atalho do aplicativo <Base Fotográfica Criminal> criado com sucesso."

        frmDistribuidor.cmdAtalhoBFC.Visible = True
        frmDistribuidor.Image4.Enabled = False
    
End Select

Obs: Utilizei sua sugestão no CASE Reco.

valeu.

scorpio · Agosto 15, 2009

Digite %USERPROFILE% no executar e dê enter. Veja para qual pasta te manda.

Rogério Orlando · Agosto 15, 2009

Ele me mandou para:

"C:\Documents and Settings\Administrador".

O que pode estar errado?

scorpio · Agosto 15, 2009

O nome do usuário é Administrador. Não é isso que você quer ?

Rogério Orlando · Agosto 15, 2009

Desculpe não ter sido preciso na resposta.

Constando no executar sou remetido para o local certo, entretanto quando utilizo no código (lReturn = fCreateShellLink("%USERPROFILE%\Desktop") não tenho retorno.

scorpio · Agosto 15, 2009

Tenta isso.

Dim fso
Dim Wshshell

 Set WshShell = Wscript.CreateObject("Wscript.Shell")
 Set fso = CreateObject("Scripting.FileSystemObject")

Dim Win, UPD,Syst

Win = fso.GetSpecialFolder(0)
UPD = Wshshell.SpecialFolders("Desktop")
MsgBox UPD

Rogério Orlando · Agosto 15, 2009

1º deu erro informando que a variável não havia sido definida (Wscript).

Eu a defini junto com a outra (Dim Wshshell, Wscript).

Daí deu " Objeto requerido, erro 424, setando para: Set Wshshell = Wscript.CreateObject("Wscript.Shell").

não faço a menor idéia do que fazer.

agradeço.

PS>: no executável o erro é o mesmo (424)

scorpio · Agosto 16, 2009

Esse código é de VBS. Também não sei o que é WScript.

Esperimenta tirar o "WScript.".

Se não der certo veja isso:

Vai em um módulo.

Attribute VB_Name = "mod_SpecialFolders"
Option Explicit
''
Private Const CSIDL_DESKTOP                     As Long = &H0
Private Const CSIDL_INTERNET                    As Long = &H1
Private Const CSIDL_PROGRAMS                    As Long = &H2
Private Const CSIDL_CONTROLS                    As Long = &H3
Private Const CSIDL_PRINTERS                    As Long = &H4
Private Const CSIDL_PERSONAL                    As Long = &H5
Private Const CSIDL_FAVORITES                   As Long = &H6
Private Const CSIDL_STARTUP                     As Long = &H7
Private Const CSIDL_RECENT                      As Long = &H8
Private Const CSIDL_SENDTO                      As Long = &H9
Private Const CSIDL_BITBUCKET                   As Long = &HA
Private Const CSIDL_STARTMENU                   As Long = &HB
Private Const CSIDL_MYDOCUMENTS                 As Long = &HC
Private Const CSIDL_MYMUSIC                     As Long = &HD
Private Const CSIDL_MYVIDEO                     As Long = &HE
Private Const CSIDL_DESKTOPDIRECTORY            As Long = &H10
Private Const CSIDL_DRIVES                      As Long = &H11
Private Const CSIDL_NETWORK                     As Long = &H12
Private Const CSIDL_NETHOOD                     As Long = &H13
Private Const CSIDL_FONTS                       As Long = &H14
Private Const CSIDL_TEMPLATES                   As Long = &H15
Private Const CSIDL_COMMON_STARTMENU            As Long = &H16
Private Const CSIDL_COMMON_PROGRAMS             As Long = &H17
Private Const CSIDL_COMMON_STARTUP              As Long = &H18
Private Const CSIDL_COMMON_DESKTOPDIRECTORY     As Long = &H19
Private Const CSIDL_APPDATA                     As Long = &H1A
Private Const CSIDL_PRINTHOOD                   As Long = &H1B
Private Const CSIDL_LOCAL_APPDATA               As Long = &H1C
Private Const CSIDL_ALTSTARTUP                  As Long = &H1D
Private Const CSIDL_COMMON_ALTSTARTUP           As Long = &H1E
''
Private Const CSIDL_COMMON_FAVORITES            As Long = &H1F
Private Const CSIDL_INTERNET_CACHE              As Long = &H20
Private Const CSIDL_COOKIES                     As Long = &H21
Private Const CSIDL_HISTORY                     As Long = &H22
Private Const CSIDL_COMMON_APPDATA              As Long = &H23
Private Const CSIDL_WINDOWS                     As Long = &H24
Private Const CSIDL_SYSTEM                      As Long = &H25
Private Const CSIDL_PROGRAM_FILES               As Long = &H26
Private Const CSIDL_MYPICTURES                  As Long = &H27
Private Const CSIDL_PROFILE                     As Long = &H28
Private Const CSIDL_PROGRAM_FILES_COMMON        As Long = &H2B
Private Const CSIDL_COMMON_TEMPLATES            As Long = &H2D
Private Const CSIDL_COMMON_DOCUMENTS            As Long = &H2E
Private Const CSIDL_COMMON_ADMINTOOLS           As Long = &H2F
Private Const CSIDL_ADMINTOOLS                  As Long = &H30
Private Const CSIDL_CONNECTIONS                 As Long = &H31
Private Const CSIDL_COMMON_MUSIC                As Long = &H35
Private Const CSIDL_COMMON_PICTURES             As Long = &H36
Private Const CSIDL_COMMON_VIDEO                As Long = &H37
Private Const CSIDL_RESOURCES                   As Long = &H38
Private Const CSIDL_RESOURCES_LOCALIZED         As Long = &H39
Private Const CSIDL_COMMON_OEM_LINKS            As Long = &H3A
Private Const CSIDL_CDBURN_AREA                 As Long = &H3B
Private Const CSIDL_COMPUTERSNEARME             As Long = &H3D
''
Public Enum SpecialFolders
    ''
    Desktop = CSIDL_DESKTOP
    Internet = CSIDL_INTERNET
    Programs = CSIDL_PROGRAMS
    Controls = CSIDL_CONTROLS
    Printers = CSIDL_PRINTERS
    Personal = CSIDL_PERSONAL
    Favorites = CSIDL_FAVORITES
    Startup = CSIDL_STARTUP
    Recent = CSIDL_RECENT
    SendTo = CSIDL_SENDTO
    BitBucket = CSIDL_BITBUCKET
    StartMenu = CSIDL_STARTMENU
    MyDocuments = CSIDL_MYDOCUMENTS
    MyMusic = CSIDL_MYMUSIC
    MyVideo = CSIDL_MYVIDEO
    DesktopDirectory = CSIDL_DESKTOPDIRECTORY
    Drives = CSIDL_DRIVES
    Network = CSIDL_NETWORK
    NetHood = CSIDL_NETHOOD
    Fonts = CSIDL_FONTS
    Templates = CSIDL_TEMPLATES
    Common_StartMenu = CSIDL_COMMON_STARTMENU
    Common_Programs = CSIDL_COMMON_PROGRAMS
    Common_Startup = CSIDL_COMMON_STARTUP
    Common_DesktopDirectory = CSIDL_COMMON_DESKTOPDIRECTORY
    AppData = CSIDL_APPDATA
    PrintHood = CSIDL_PRINTHOOD
    Local_AppData = CSIDL_APPDATA
    AltStartup = CSIDL_ALTSTARTUP
    Common_AltStartup = CSIDL_COMMON_ALTSTARTUP
    ''
    Common_Favorites = CSIDL_COMMON_FAVORITES
    Internet_Cache = CSIDL_INTERNET_CACHE
    Cookies = CSIDL_COOKIES
    History = CSIDL_HISTORY
    Common_ApPData = CSIDL_COMMON_APPDATA
    Windows = CSIDL_WINDOWS
    System = CSIDL_SYSTEM
    Program_Files = CSIDL_PROGRAM_FILES
    MyPictures = CSIDL_MYPICTURES
    Profile = CSIDL_PROFILE
    Program_Files_Common = CSIDL_PROGRAM_FILES_COMMON
    Common_Program_Files = CSIDL_PROGRAM_FILES_COMMON
    Common_Templates = CSIDL_COMMON_TEMPLATES
    Common_Documents = CSIDL_COMMON_DOCUMENTS
    Common_AdminTools = CSIDL_COMMON_ADMINTOOLS
    AdminTools = CSIDL_ADMINTOOLS
    Connections = CSIDL_CONNECTIONS
    Common_Music = CSIDL_COMMON_MUSIC
    Common_Pictures = CSIDL_COMMON_PICTURES
    Common_Video = CSIDL_COMMON_VIDEO
    Resources = CSIDL_RESOURCES
    Resources_Localized = CSIDL_RESOURCES_LOCALIZED
    Common_OEM_Links = CSIDL_COMMON_OEM_LINKS
    CDBurn_Area = CSIDL_CDBURN_AREA
    ComputersNearMe = CSIDL_COMPUTERSNEARME
    ''
End Enum
''
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
''
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
''

Public Function GetSpecialfolder(CSIDL As Long) As String
    ''
    Dim r As Long
    Dim IDL As ITEMIDLIST
    Dim strPath As String
    ''
    Const NOERROR = 0
    'Const MAX_LENGTH = 260'
    ''
    r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If r = NOERROR Then
        strPath = Space$(512)
        r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal strPath)
        GetSpecialfolder = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
    End If
    ''
End Function

Rogério Orlando · Agosto 16, 2009

Valeu Scorpio, mas desta vez não deu.

Está ficando muito complicado por pouco.

Vou alterar meu aplicativo, solicitando que o usuário digite o nome do usuário do PC em um determinado campo,

assim posso atravéz de variável colocar o nome dele no lugar que necessito.

Um abraço e muito obrigado pelas tentativas.

scorpio · Agosto 16, 2009

Testou esse ultimo código ?

Coloca em um módulo.

Quando quiser o desktop coloca :

Msgbox GetSpecialfolder(SpecialFolders.Desktop)

Rogério Orlando · Agosto 16, 2009

Testou esse ultimo código ?

Coloca em um módulo.

Quando quiser o desktop coloca :
Msgbox GetSpecialfolder(SpecialFolders.Desktop)

Não entendi! Está ficando complicado demais.

Não creio que apenas copiando o último código em um módulo e

Msgbox GetSpecialfolder(SpecialFolders.Desktop)

, onde necessito fará com que o atalho de meu programa apareça no desktop. Deve estar faltando alguma coisa.

Option Explicit

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

Private Sub cmdNao_Click()
    Unload Me
End Sub

Private Sub cmdSim_Click()

Msgbox GetSpecialfolder(SpecialFolders.Desktop)

Select Case lblTipo.Caption
    Case Is = "AI"
        lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
        "Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
        MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."
        
        frmDistribuidor.cmdAtalhoAI.Visible = True
        frmDistribuidor.Image1.Enabled = False
    Case Is = "Reco"
        lReturn = fCreateShellLink("%USERPROFILE%\Desktop", _
        "Reconhecimento Fotográfico", "C:\Arquivos de programas\Assuntos Internos\fotos\PrjRecoFoto.exe", "")
        MsgBox "Atalho do aplicativo <Reconhecimento Fotográfico> criado com sucesso."
        
        frmDistribuidor.cmdAtalhoReco.Visible = True
        frmDistribuidor.Image5.Enabled = False
    Case Is = "DD"
        lReturn = fCreateShellLink("C:\Documents and Settings\All Users\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."

        frmDistribuidor.cmdAtalhoDD.Visible = True
        frmDistribuidor.Image2.Enabled = False

    Case Is = "PS"
        lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
        "Político Social", "C:\Arquivos de programas\Banco de Dados Político Social\BDPS Politico Social.exe", "")
        MsgBox "Atalho do aplicativo <Político Social> criado com sucesso."

        frmDistribuidor.cmdAtalhoPS.Visible = True
        frmDistribuidor.Image3.Enabled = False
        
    Case Is = "BFC"
        lReturn = fCreateShellLink("C:\Documents and Settings\Administrador\Desktop", _
        "Base Fotográfica Criminal", "C:\Arquivos de programas\PrjBasFCrim\Cadastro Criminal.exe", "")
        MsgBox "Atalho do aplicativo <Base Fotográfica Criminal> criado com sucesso."

        frmDistribuidor.cmdAtalhoBFC.Visible = True
        frmDistribuidor.Image4.Enabled = False
    
End Select

scorpio · Agosto 16, 2009

Você quem sabe.

Só copiar não fará do nada aparecer no desktop mesmo. Não é mágica.

Com isso você terá o caminho do Desktop do usuário. Certo?

Não é isso que você precisa para criar o atalho ?

Vou explicar de novo.

Cria um módulo e coloca o seguinte código:

Option Explicit

''
Private Const CSIDL_DESKTOP                     As Long = &H0
Private Const CSIDL_INTERNET                    As Long = &H1
Private Const CSIDL_PROGRAMS                    As Long = &H2
Private Const CSIDL_CONTROLS                    As Long = &H3
Private Const CSIDL_PRINTERS                    As Long = &H4
Private Const CSIDL_PERSONAL                    As Long = &H5
Private Const CSIDL_FAVORITES                   As Long = &H6
Private Const CSIDL_STARTUP                     As Long = &H7
Private Const CSIDL_RECENT                      As Long = &H8
Private Const CSIDL_SENDTO                      As Long = &H9
Private Const CSIDL_BITBUCKET                   As Long = &HA
Private Const CSIDL_STARTMENU                   As Long = &HB
Private Const CSIDL_MYDOCUMENTS                 As Long = &HC
Private Const CSIDL_MYMUSIC                     As Long = &HD
Private Const CSIDL_MYVIDEO                     As Long = &HE
Private Const CSIDL_DESKTOPDIRECTORY            As Long = &H10
Private Const CSIDL_DRIVES                      As Long = &H11
Private Const CSIDL_NETWORK                     As Long = &H12
Private Const CSIDL_NETHOOD                     As Long = &H13
Private Const CSIDL_FONTS                       As Long = &H14
Private Const CSIDL_TEMPLATES                   As Long = &H15
Private Const CSIDL_COMMON_STARTMENU            As Long = &H16
Private Const CSIDL_COMMON_PROGRAMS             As Long = &H17
Private Const CSIDL_COMMON_STARTUP              As Long = &H18
Private Const CSIDL_COMMON_DESKTOPDIRECTORY     As Long = &H19
Private Const CSIDL_APPDATA                     As Long = &H1A
Private Const CSIDL_PRINTHOOD                   As Long = &H1B
Private Const CSIDL_LOCAL_APPDATA               As Long = &H1C
Private Const CSIDL_ALTSTARTUP                  As Long = &H1D
Private Const CSIDL_COMMON_ALTSTARTUP           As Long = &H1E
''
Private Const CSIDL_COMMON_FAVORITES            As Long = &H1F
Private Const CSIDL_INTERNET_CACHE              As Long = &H20
Private Const CSIDL_COOKIES                     As Long = &H21
Private Const CSIDL_HISTORY                     As Long = &H22
Private Const CSIDL_COMMON_APPDATA              As Long = &H23
Private Const CSIDL_WINDOWS                     As Long = &H24
Private Const CSIDL_SYSTEM                      As Long = &H25
Private Const CSIDL_PROGRAM_FILES               As Long = &H26
Private Const CSIDL_MYPICTURES                  As Long = &H27
Private Const CSIDL_PROFILE                     As Long = &H28
Private Const CSIDL_PROGRAM_FILES_COMMON        As Long = &H2B
Private Const CSIDL_COMMON_TEMPLATES            As Long = &H2D
Private Const CSIDL_COMMON_DOCUMENTS            As Long = &H2E
Private Const CSIDL_COMMON_ADMINTOOLS           As Long = &H2F
Private Const CSIDL_ADMINTOOLS                  As Long = &H30
Private Const CSIDL_CONNECTIONS                 As Long = &H31
Private Const CSIDL_COMMON_MUSIC                As Long = &H35
Private Const CSIDL_COMMON_PICTURES             As Long = &H36
Private Const CSIDL_COMMON_VIDEO                As Long = &H37
Private Const CSIDL_RESOURCES                   As Long = &H38
Private Const CSIDL_RESOURCES_LOCALIZED         As Long = &H39
Private Const CSIDL_COMMON_OEM_LINKS            As Long = &H3A
Private Const CSIDL_CDBURN_AREA                 As Long = &H3B
Private Const CSIDL_COMPUTERSNEARME             As Long = &H3D
''
Public Enum SpecialFolders
    ''
    Desktop = CSIDL_DESKTOP
    Internet = CSIDL_INTERNET
    Programs = CSIDL_PROGRAMS
    Controls = CSIDL_CONTROLS
    Printers = CSIDL_PRINTERS
    Personal = CSIDL_PERSONAL
    Favorites = CSIDL_FAVORITES
    Startup = CSIDL_STARTUP
    Recent = CSIDL_RECENT
    SendTo = CSIDL_SENDTO
    BitBucket = CSIDL_BITBUCKET
    StartMenu = CSIDL_STARTMENU
    MyDocuments = CSIDL_MYDOCUMENTS
    MyMusic = CSIDL_MYMUSIC
    MyVideo = CSIDL_MYVIDEO
    DesktopDirectory = CSIDL_DESKTOPDIRECTORY
    Drives = CSIDL_DRIVES
    Network = CSIDL_NETWORK
    NetHood = CSIDL_NETHOOD
    Fonts = CSIDL_FONTS
    Templates = CSIDL_TEMPLATES
    Common_StartMenu = CSIDL_COMMON_STARTMENU
    Common_Programs = CSIDL_COMMON_PROGRAMS
    Common_Startup = CSIDL_COMMON_STARTUP
    Common_DesktopDirectory = CSIDL_COMMON_DESKTOPDIRECTORY
    AppData = CSIDL_APPDATA
    PrintHood = CSIDL_PRINTHOOD
    Local_AppData = CSIDL_APPDATA
    AltStartup = CSIDL_ALTSTARTUP
    Common_AltStartup = CSIDL_COMMON_ALTSTARTUP
    ''
    Common_Favorites = CSIDL_COMMON_FAVORITES
    Internet_Cache = CSIDL_INTERNET_CACHE
    Cookies = CSIDL_COOKIES
    History = CSIDL_HISTORY
    Common_ApPData = CSIDL_COMMON_APPDATA
    Windows = CSIDL_WINDOWS
    System = CSIDL_SYSTEM
    Program_Files = CSIDL_PROGRAM_FILES
    MyPictures = CSIDL_MYPICTURES
    Profile = CSIDL_PROFILE
    Program_Files_Common = CSIDL_PROGRAM_FILES_COMMON
    Common_Program_Files = CSIDL_PROGRAM_FILES_COMMON
    Common_Templates = CSIDL_COMMON_TEMPLATES
    Common_Documents = CSIDL_COMMON_DOCUMENTS
    Common_AdminTools = CSIDL_COMMON_ADMINTOOLS
    AdminTools = CSIDL_ADMINTOOLS
    Connections = CSIDL_CONNECTIONS
    Common_Music = CSIDL_COMMON_MUSIC
    Common_Pictures = CSIDL_COMMON_PICTURES
    Common_Video = CSIDL_COMMON_VIDEO
    Resources = CSIDL_RESOURCES
    Resources_Localized = CSIDL_RESOURCES_LOCALIZED
    Common_OEM_Links = CSIDL_COMMON_OEM_LINKS
    CDBurn_Area = CSIDL_CDBURN_AREA
    ComputersNearMe = CSIDL_COMPUTERSNEARME
    ''
End Enum
''
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
''
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
''

Public Function GetSpecialfolder(CSIDL As Long) As String
    ''
    Dim r As Long
    Dim IDL As ITEMIDLIST
    Dim strPath As String
    ''
    Const NOERROR = 0
    'Const MAX_LENGTH = 260'
    ''
    r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If r = NOERROR Then
        strPath = Space$(512)
        r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal strPath)
        GetSpecialfolder = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
    End If
    ''
End Function

Daí, no seu botão cmdSim, faz:

Dim Caminho_Desktop as String
Caminho_Desktop = GetSpecialfolder(SpecialFolders.Desktop)

Se quiser, use como quiser o caminho.

Usuário odeia digitar.

Abraços!!

Rogério Orlando · Agosto 16, 2009

Acho que funcionou, porém tenho que testar o programa em máquina com usuário diferente do meu.

Por enquanto agradeço novamente, e compreendo como deve ser difícil lidar com a falta de conhecimento dos usuários.

Damos graças por existirem pessoas gabaritadas para nos auxiliar nas horas mais difíceis, e imagino como deve ser gratificante poder divulgar aos "sete cantos", nosso dom.

PS.: não sei falar chinês, quanto mais escrever, ou seja, não sou preguiçoso, apenas não tenho conhecimento suficiente para interpretar algo que não fui instruido a compreender.

Novamente Muito obrigado, e não pense que será minha última dúvida.

Sou Brasileiro e não desisto nunca.

PS II: Se funcionar retorno para postar.

scorpio · Agosto 16, 2009

OK.

Espero retornar para colocar resolvido.

Abraços!

Rogério Orlando · Agosto 17, 2009

Ainda não testei em outra máquina e já surgiu mais um problema.

Meu aplicativo pergunta ao usuário, para quais programas que ele está instalando, deseja criar um atalho na área de trabalho, da seguinte forma:

1) Num form principal existem ícones que quando clicados, além de instalar o programa, remete a outro form (frmAtalho):

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

2)Com o frmAtalho aberto, isto após abrir e instalar o respectivo aplicativo, pergunta se o usuário quer ou não instalar o atalho. Se sim o atalho é instalado;

Private Sub cmdSim_Click()
Dim Caminho_Desktop As String
Caminho_Desktop = GetSpecialfolder(SpecialFolders.Desktop)

Select Case lblTipo.Caption
    Case Is = "AI"
        lReturn = fCreateShellLink(Caminho_Desktop, _
        "Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
        Text1 = lReturn
        
        frmDistribuidor.cmdAtalhoAI.Visible = True
        frmDistribuidor.Image1.Enabled = False
        MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."
    Case Is = "Reco"
        lReturn = fCreateShellLink(Caminho_Desktop, _
        "Reconhecimento Fotográfico", "C:\Arquivos de programas\Assuntos Internos\fotos\PrjRecoFoto.exe", "")
        Text1 = lReturn
        
        frmDistribuidor.cmdAtalhoReco.Visible = True
        frmDistribuidor.Image5.Enabled = False
        MsgBox "Atalho do aplicativo <Reconhecimento Fotográfico> criado com sucesso."
    
    Case Is = "DD"
        lReturn = fCreateShellLink(Caminho_Desktop, _
        "Disque Denúncia - (181)", "C:\Arquivos de programas\Disque Denúncia\Disque Denúncia - 181.exe", "")
        Text1 = Caminho_Desktop
        
        frmDistribuidor.cmdAtalhoDD.Visible = True
        frmDistribuidor.Image2.Enabled = False
        MsgBox "Atalho do aplicativo <Disque Denúncia - (181)> criado com sucesso."

    Case Is = "PS"
        lReturn = fCreateShellLink(Caminho_Desktop, _
        "Político Social", "C:\Arquivos de programas\Banco de Dados Político Social\BDPS Politico Social.exe", "")
        Text1 = Caminho_Desktop
        
        frmDistribuidor.cmdAtalhoPS.Visible = True
        frmDistribuidor.Image3.Enabled = False
        MsgBox "Atalho do aplicativo <Político Social> criado com sucesso."
       
    Case Is = "BFC"
        lReturn = fCreateShellLink(Caminho_Desktop, _
        "Base Fotográfica Criminal", "C:\Arquivos de programas\PrjBasFCrim\Cadastro Criminal.exe", "")
        Text1 = Caminho_Desktop
        
        frmDistribuidor.cmdAtalhoBFC.Visible = True
        frmDistribuidor.Image4.Enabled = False
        MsgBox "Atalho do aplicativo <Base Fotográfica Criminal> criado com sucesso."
   
End Select
    Unload Me
End Sub

QUAL O PROBLEMA QUE SURGIU.

O form fica aberto enquanto o usuário clica em cada programa para instalação, abre o formAtalho e o fecha.

Ocorre porém que só instá-la o 1º atalho os demais não.

Só consigo instalar os outros atalhos fechando o programa e abrindo-o para instalar cada aplicativo.

Talvez tenha que fazer com que a variável ou a função seja resetada da memória antes de pedir para instalar o outro atalho, entretanto não sei como fazer isto.

Teriamos alguma sugestão para este caso?

Obrigado novamente e novamente.

Rogério Orlando · Agosto 17, 2009

Scorpio, funcionou perfeitamente em outro computador, porém como disse no recado anterior, não

consigo instalar mais de um aplicativo por vez, ou seja tenho que reiniciar o meu executável.

Se não for pedir demais tem como resolver este problema também?

Agradeço.

scorpio · Agosto 18, 2009

Tenta isso, logo que depois que criar um atalho:

Unload Me
Load Me
Me.Show

Rogério Orlando · Agosto 18, 2009

Scorpio.

Não funcionou.

Só consigo instalar outro atalho fechando o aplicativo e iniciando-o novamente.

Relembrando:

No 1º form clico na imagem1. ela instala o aplicativo e abre o formAtalho, onde clico em cmdSim para instalar

o respectivo atalho.

O formAtalho fecha e retorna ao 1º form para a instalação de outro aplicativo e consequentemente abre o formAtalho

que pergunta se quero instalar o atalho deste outro aplicativo, assim sucessivamente até o último.

Não seria alguma variavel ou função que necessita ser "zerada" para ganhar outro valor?

Valeu, estou no aguardo de auxílio, pois meus conhecimentos são insuficientes.

um abraço.

PS: gostaria de mostras as fotos dos forms, mas não sei como fazer.

Arquivado

[Resolvido] Verifcar nome do usuário do PC

Recommended Posts

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Rogério Orlando 0