你说的对,CSDN上回答的都是用安装盘中的DLL,
应该有API函数调用,见下:
-----------------------以下再BAS中定义-------------------
Public Const ERROR_SUCCESS As Long = 0
Public Const CSIDL_DESKTOP As Long = &H0
Public Const CSIDL_PROGRAMS As Long = &H2
Public Const CSIDL_STARTMENU As Long = &HB
Public Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Public Const FO_COPY As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Public Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
pidl As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Sub CreateDesktopLink(sSource As String, sDestination As String)
'working variables
Dim sFiles As String
Dim SHFileOp As SHFILEOPSTRUCT
'terminate passed strings with a null
sSource = sSource & Chr$(0)
sDestination = sDestination & Chr$(0)
'set up the options
With SHFileOp
.wFunc = FO_COPY
.pFrom = sSource
.pTo = sDestination
.fFlags = FOF_SILENT Or FOF_NOCONFIRMATION
End With
'and perform the copy
Call SHFileOperation(SHFileOp)
End Sub
Public Function GetSpecialFolder(hWnd As Long, CSIDL As Long) As String
Dim pidl As Long
Dim pos As Long
Dim sPath As String
'fill the pidl with the specified folder item
If SHGetSpecialFolderLocation(hWnd, CSIDL, pidl) = ERROR_SUCCESS Then
'initialize & get the path
sPath = Space$(260)
If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
Declare Function OSfCreateShellLink Lib "vb6stkit.dll" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String, ByVal fPrivate As Long, ByVal sParent As String) As Long