好多天都没人能解决的问题:怎样用vb实现像windows那样的"新建"--文件夹及快捷方式

Question

例如:在桌面上点右键,新建的级联菜单下有:文件夹和快捷方式
又例如:击我的电脑,击c盘后,在"文件"的"新建"中的文件夹和快捷方式
怎么实现呢?
恳请赐教

Answer 1

The MakeSureDirectoryPathExists function creates all the directories in the specified DirPath, beginning with the root.BOOL MakeSureDirectoryPathExists(
  PCSTR DirPath  
);VB中如何創建多層目錄：比如說，你的程序需要創建這樣的目錄："c:\Demo\Sub1\Sub2\Sub3\Sub4\Sub5\Sub6\Sub7\Sub8"，但是你不知道上一層目錄是否存在，你會怎麼做呢？你可能會用ChDir，MkDir來一個一個建立，並且要加上錯誤處理。幸運地，和大部分的事情一樣，我們可以用WinAPI來把這個任務最大程度地簡化掉。這個例子來自Internet，如果你有更簡單的方法（我想一定有，因為qianqian以前也寫了一個沒這麼長，不過找不到了，不高興重寫了——越來越懶了），請投稿給我。Public Const INVALID_HANDLE_VALUE = -1
Public Const MAX_PATH = 260Public Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End TypePublic Declare Function CreateDirectory Lib "kernel32" _
    Alias "CreateDirectoryA" _
   (ByVal lpPathName As String, _
    lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongPrivate Function CreateNestedFolders(ByVal _
                        completeDirectory As String) As Integer
   Dim r As Long
   Dim SA As SECURITY_ATTRIBUTES
   Dim drivePart As String
   Dim newDirectory  As String
   Dim item As String
   Dim sfolders() As String
   Dim pos As Integer
   Dim x As Integer
  
   If Right$(completeDirectory, 1) <> "\" Then
      completeDirectory = completeDirectory & "\"
   End If
  
  '判斷是否有驅動器號，如果沒有默認當前驅動器 
   pos = InStr(completeDirectory, ":")   If pos Then
         drivePart = GetPart(completeDirectory, "\")
   Else: drivePart = ""
   End If  '循環開始，分析路徑到數組
   Do Until completeDirectory = ""     item = GetPart(completeDirectory, "\")     ReDim Preserve sfolders(0 To x) As String     If x = 0 Then item = drivePart & item
     sfolders(x) = item     x = x + 1   Loop  '開始創建目錄.
   x = -1
   
   Do
   
      x = x + 1
      newDirectory = newDirectory & sfolders(x)
      
      SA.nLength = LenB(SA)
      
      Call CreateDirectory(newDirectory, SA)
      
   Loop Until x = UBound(sfolders)
   
   CreateNestedFoldersByPath = x + 1End Function
Function GetPart(startStrg As String, delimiter As String) As String'獲得字符串用delimiter分割的一部分
  Dim c As Integer
  Dim item As String
  
  c = 1
  
  Do    If Mid$(startStrg, c, 1) = delimiter Then
      
      item = Mid$(startStrg, 1, c)
      startStrg = Mid$(startStrg, c + 1, Len(startStrg))
      GetPart = item
      Exit Function
    
    End If    c = c + 1  LoopEnd Function

Answer 2

http://www.china-askpro.com/msg2/qa54.shtml