Foro de elhacker.net

Hola alguien sabe comopeudo crear un acceso directo, se qeu se peude con whs pero no se como gracias

estos son unos ejemplos que vienen el la pag de "El Guille" (http://www.elguille.info/vb/ejemplos/crear_links.htm)


' Crear accesos directos usando DDE ------
Option Explicit

Private Sub cmdCrear_Click()
    ' Crear el acceso directo                                       
   ' Se creará dentro de Programas del Menú de Inicio
    '
    CrearIconoEnProgMan Me, Text2.Text, Text1.Text
End Sub

Private Sub cmdSalir_Click()
    ' Salir del programa
    Unload Me
End Sub


'----------------------------------------------------------
' Procedure: CrearIconoEnProgMan
'
' Arguments: X           The form where Label1 exists
'
'            CmdLine$    A string that contains the command
'                        line for the item/icon.
'                        ie 'c:\myapp\setup.exe'
'
'            IconTitle$  A string that contains the item's
'                        caption
'----------------------------------------------------------
Private Sub CrearIconoEnProgMan(X As Form, CmdLine$, IconTitle$)
   
    Dim i As Integer, z As Integer
   
    Screen.MousePointer = 11
    ' Poner la primera letra en mayúsculas
    IconTitle$ = Left$(IconTitle$, 1) & LCase$(Mid$(IconTitle$, 2))
   
    '----------------------------------------------------------------------
    ' Windows requires DDE in order to create a program group and item.
    ' Here, a Visual Basic label control is used to generate the DDE messages
    '----------------------------------------------------------------------
    On Error Resume Next
   
    '---------------------------------
    ' Set LinkTopic to PROGRAM MANAGER
    '---------------------------------
    X.Label1.LinkTopic = "ProgMan|Progman"
    X.Label1.LinkMode = 2
    For i = 1 To 10         ' Loop to ensure that there is enough time to
      z = DoEvents()        ' process DDE Execute.  This is redundant but needed
    Next                    ' for debug windows.
    X.Label1.LinkTimeout = 100
   
    '------------------------------------------------
    ' Create Program Item, one of the icons to launch
    ' an application from Program Manager
    '------------------------------------------------
    X.Label1.LinkExecute "[AddItem(" & CmdLine$ & Chr$(44) & IconTitle$ & Chr$(44) & ",,)]"
   
    '-----------------
    ' Reset properties
    '-----------------
    X.Label1.LinkTimeout = 50
    X.Label1.LinkMode = 0
   
    Screen.MousePointer = 0
End Sub



'-----------------------------------------------------------------------' Crear accesos directos usando WHS                                 Option Explicit

Private m_wsShell As Variant

Private Sub cmdCrear_Click()
    Dim sLnkPath As String
    Dim sLink As String
    Dim sAppPath As String
    Dim vLnk As Variant
   
    sAppPath = Text2
    sLink = Text1
    If InStr(sLink, ".lnk") = 0 Then
        sLink = sLink & ".lnk"
    End If
    ' Crearlo en el escritorio:
    'sLnkPath = m_wsShell.SpecialFolders("Desktop")
    '
    ' Crearlo en el indicado en el listbox
    ' Aunque siempre lo crea en el mismo sitio:
    ' C:\WINDOWS\All Users\Desktop
    ' es decir en el escritorio.
    '
    ' Pero eso era usando TEXT3 a secas,
    ' añadiendo el .Text ya si que sale lo que debe salir...
    '
    sLnkPath = m_wsShell.SpecialFolders(Text3.Text)
    sLnkPath = sLnkPath & "\" & sLink
   
    ' Crear el acceso directo
    Set vLnk = m_wsShell.CreateShortcut(sLnkPath)
    vLnk.Targetpath = sAppPath
   
   
    ' definir directorio de trabajo
    vLnk.WorkingDirectory = "D:\gsCodigo" ' Escribe aquí el directorio
    '--------------------------------------------------------------------------
    '
    vLnk.Save
End Sub

Private Sub cmdSalir_Click()
    ' Salir del programa
    Unload Me
End Sub

Private Sub Form_Load()
    Set m_wsShell = CreateObject("WScript.Shell")
   
    List1.Clear
   
    ' Llenar el listbox con los "folders" de SpecialFolders
    '
    'Dim vName As Variant

    ' (Este método es preferible si quieres mostrar todos las carpetas especiales)

    'For Each vName In m_wsShell.SpecialFolders
    '    List1.AddItem vName
    'Next
    '
    '
    ' Estos no son válidos para el W95
    List1.AddItem "AllUsersDesktop= " & m_wsShell.SpecialFolders("AllUsersDesktop")
    'List1.AddItem "AllUsersStartMenu= " & m_wsShell.SpecialFolders("AllUsersStartMenu")
    'List1.AddItem "AllUsersPrograms= " & m_wsShell.SpecialFolders("AllUsersPrograms")
    'List1.AddItem "AllUsersStartup= " & m_wsShell.SpecialFolders("AllUsersStartup")
    '
    List1.AddItem "Desktop= " & m_wsShell.SpecialFolders("Desktop")
    List1.AddItem "Programs= " & m_wsShell.SpecialFolders("Programs")
    List1.AddItem "StartMenu= " & m_wsShell.SpecialFolders("StartMenu")
    List1.AddItem "Startup= " & m_wsShell.SpecialFolders("Startup")
    List1.AddItem "MyDocuments= " & m_wsShell.SpecialFolders("MyDocuments")
    List1.ListIndex = 0
    '
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set m_wsShell = Nothing
End Sub

Private Sub List1_Click()
    ' Mostrar el destino del acceso directo
    Dim sTmp As String
    Dim i As Long
   
    sTmp = List1.List(List1.ListIndex)
    i = InStr(sTmp, "= ")
    If i Then
        Text3 = Left$(sTmp, i - 1)
    Else
        Text3 = "Desktop"
    End If
End Sub

Gracias celaya, ya lo habi encontrado y no se porque no me funca rebisare liena por linea

me he dado cuenta que muchas de las api's necesitan que manejes los paths cortos (ejem: c:\misdoc~1\algo~2\archiv~.ico) tal vez ese sea el problema