'===========================================================================
' Subject: Short Cuts without COM             Date: 06-14-02 (  :  )       
'  Author: Fred Buffington                    Code: PBDLL                  
'  Origin: oasys@sbcglobal.net              Packet: PBDLL.ABC
'===========================================================================
'--------------------------------------------------------------------------------
'Fred Buffington - oasys@sbcglobal.net 
'--------------------------------------------------------------------------------

#Compile Exe 
Option Explicit 
  
#Include "win32api.inc" 
  
Type ShortItemId 
   cb As Long 
   abID As Byte 
End Type 
  
Type ITEMIDLIST 
   mkid As ShortItemId 
End Type 
  
Function GetSpecialFolder( ByVal CSIDL As Long ) As String 
  
    Dim idlstr   As Long 
    Dim szPath   As Asciiz * %MAX_PATH 
    Dim IDL As ITEMIDLIST 
  
    idlstr = SHGetSpecialFolderLocation( 0, CSIDL, ByVal VarPtr( IDL ) ) 
    If idlstr = 0 Then 
   idlstr = SHGetPathFromIDList( ByVal IDL.mkid.cb, szPath ) 
   If idlstr Then szPath = Trim$( szPath ) 
    End If 
  
    If szPath = "" Then 
   Select Case CSIDL 
   Case %CSIDL_WINDOWS 
  GetWindowsDirectory szPath, SizeOf( szPath ) 
  szPath = Trim$( szPath ) 
   End Select 
    End If 
  
    If szPath > "" Then szPath = RTrim$( szPath, "\" ) & "\" 
    Function = szPath 
  
End Function 
  
Function CreateShortCut( ByVal sLinkFileName As String, ByVal sExeName As String ) As Long 
  
    Dim a As Long 
    Dim FF As Long 
    Dim sPath As String 
    Dim sFileName As String 
    Dim szTemp As Asciiz * %MAX_PATH 
  
    GetTempPath SizeOf( szTemp ), szTemp 
    If szTemp > "" Then szTemp = Trim$( szTemp, "\" ) & "\" 
  
    a = InStr( -1, sLinkFileName, Any ":\" ) 
    If a = 0 Then Exit Function 
    sPath = RTrim$( Left$( sLinkFileName, a ), "\" ) 
    sFileName = Trim$( Mid$( sLinkFileName, a + 1 ) ) 
  
    FF = FreeFile 
    Open szTemp & "setup.inf" For Output As #FF 
    Print #FF, "[version]" 
    Print #FF, "signature=" & Chr$( 34 ) & "$chicago$" & Chr$( 34 ) 
    Print #FF, "[Linknames]" 
    Print #FF, "UpdateInis=Addlink" 
    Print #FF, "[Addlink]" 
    Print #FF, "setup.ini, progman.groups,, " _ 
   & Chr$( 34 ) & "group0=" & sPath & Chr$( 34 ) 
    Print #FF, "setup.ini, group0,," _ 
   & Chr$( 34 ) & Chr$( 34 ) & sFileName & Chr$( 34 )  _ 
   & "," & Chr$( 34) & Chr$( 34 ) _ 
   & sExeName & Chr$( 34 ) & Chr$( 34 ) _ 
   & ",,0," & Chr$( 34 ) 
  
    Close #FF 
  
    Shell "rundll setupx.dll,InstallHinfSection Linknames 132 " & szTemp & "setup.inf" 
    Kill szTemp & "setup.inf" 
  
    ErrClear 
    a = GetAttr( sLinkFileName & ".lnk" ) 
    Function = IsFalse( Err ) 
  
End Function 
  
Function PbMain() 
  
'"My Notepad" seems to fail and get's "MyNotepad" instead, don't know why... 
  
    If CreateShortCut( _ 
     GetSpecialFolder( %CSIDL_DESKTOP ) & "MyNotepad" _ 
   , GetSpecialFolder( %CSIDL_WINDOWS ) & "NOTEPAD.EXE" _ 
   ) Then 
  
   MsgBox "OK" 
  
    End If 
  
End Function