folder-shortcuts for shares, webdav and ftp (virtual drive)

[uweb]

With a folder-shortcut you are among others relative easy able to realize via a own ftp-server a "virtual drive" whereby you can provide not real existing files.

The coding was (because of the preparatory work from Danilo and ts-soft) verry simple. To find the "how" was not so easy. I hope its useful for anybody.

Code: Select all

 ; made by ts-soft
Procedure.s GetSpecialeFolder(folder.l)
  *itemid.ITEMIDLIST = #Null
  If SHGetSpecialFolderLocation_ (0, folder, @*itemid) = #NOERROR
    location.s = Space (#MAX_PATH)
    If SHGetPathFromIDList_ (*itemid, @location)
      If Right(location, 1) <> "\" : location + "\" : EndIf
      ProcedureReturn location
    EndIf
  EndIf
EndProcedure

; made by Danilo, changed for easy use in PB 4.0 by ts-soft
Procedure CreateShortcut(Path.s, Link.s, WorkingDir.s, Argument.s, ShowCommand.l, Description.s, HotKey.l, IconFile.s, IconIndex.l)
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl.IShellLinkA) = 0
    Set_ShellLink_preferences:
    psl\SetPath(@Path)
    psl\SetArguments(@Argument)
    psl\SetWorkingDirectory(@WorkingDir)
    psl\SetDescription(@Description)
    psl\SetShowCmd(ShowCommand)
    psl\SetHotkey(HotKey)
    psl\SetIconLocation(@IconFile, IconIndex)
    ShellLink_SAVE:
    If psl\QueryInterface(?IID_IPersistFile,@ppf.IPersistFile) = 0
      mem.s = Space(1000)
      MultiByteToWideChar_(#CP_ACP, 0, Link, -1, mem, 1000)
      hres = ppf\Save(@mem,#True)
      Result = 1
      ppf\Release()
    EndIf
    psl\Release()
  EndIf
  CoUninitialize_()
  ProcedureReturn Result
  DataSection
  CLSID_ShellLink:
  Data.l $00021401
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  IID_IShellLink:
  Data.l $000214EE
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  IID_IPersistFile:
  Data.l $0000010B
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  EndDataSection
EndProcedure

 ; made by uweb
Procedure CreateFolderShortcut (ShortcutName.s, Shortcut.s, Description.s, SpecialFolder=#CSIDL_NETHOOD)
  SpecialPath.s=GetSpecialeFolder(SpecialFolder)+ShortcutName.s
  If CreateDirectory(SpecialPath.s)
    SetCurrentDirectory(SpecialPath.s)
    CreateShortcut(Shortcut.s, SpecialPath.s+"\target.lnk", "", "", 0, Description.s, 0, "", 0)
    CreatePreferences("Desktop.ini")
    PreferenceGroup(".ShellClassInfo")
    WritePreferenceString("CLSID2", "{0AFACED1-E828-11D1-9187-B532F1E9575D}")
    WritePreferenceString("Flags", "2")
    WritePreferenceString("ConfirmFileOp", "1")
    ClosePreferences()
    SetFileAttributes("Desktop.ini", #PB_FileSystem_System|#PB_FileSystem_Hidden)
    SetFileAttributes(SpecialPath.s, #PB_FileSystem_ReadOnly)
  EndIf
EndProcedure

CreateFolderShortcut ("test1", "ftp://a:b@127.0.0.1/", "FolderShortcut")
CreateFolderShortcut ("test2", "\\P1500\x", "FolderShortcut", #CSIDL_DESKTOPDIRECTORY)