Seite 1 von 1

Ordnerverknüpfungen - shares, webdav u. ftp (virtuelles Lfw)

Verfasst: 14.03.2007 14:02
von uweb
Mit den Ordnerverknüpfungen kann man u.a. über einen eigenen FTP-Server relativ einfach ein "virtuelles Laufwerk" realisieren, dass eben nicht nur real existierende Dateien bereitstellen kann.

Programmiertechnisch ist das Anlegen der Ordnerverknüpfungen (Dank der Vorarbeit von ts-soft) sehr einfach.
Für das "wie" habe ich mir aber einen Wolf gesucht. Ich hoffe nun jemandem kann es gebrauchen.

Code: Alles auswählen

 ; 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 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/", "Ordnerverknüpfung")
CreateFolderShortcut ("test2", "\\P1500\x", "Ordnerverknüpfung", #CSIDL_DESKTOPDIRECTORY)

Verfasst: 14.03.2007 14:25
von ts-soft
Anmerkung: CreateShortcut stammt von Danilo, habs lediglich für PB4
angepaßt, so das bis auf 2 Parameter, alle anderen Optional sind, was aber in
obiger Version sowieso fehlt :wink:
http://www.purebasic.fr/german/viewtopi ... teshortcut