Private 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
Public Function CreatLinkAtDesktop(strName As String, strFile As String, Optional strPro As String) As Boolean
CreatLinkAtDesktop = True
Dim lReturn
As Long
'win2000下
lReturn = OSfCreateShellLink("..\..\桌面", strUnQuoteString(strName), strUnQuoteString(strFile), strPro & vbNullChar, True, "$(Programs)")
If lReturn Then Exit Function
'win98下
lReturn = OSfCreateShellLink("..\..\Desktop", strUnQuoteString(strName), strUnQuoteString(strFile), strPro & vbNullChar, True, "$(Programs)")
If lReturn Then Exit Function
CreatLinkAtDesktop = FalseEnd FunctionPublic Function strUnQuoteString(ByVal strQuotedString As String)'' This routine tests to see if strQuotedString is wrapped in quotation' marks, and, if so, remove them.'
strQuotedString = Trim(strQuotedString)
If Mid$(strQuotedString, 1, 1) = gstrQUOTE And Right$(strQuotedString, 1) = gstrQUOTE Then
'
' It's quoted.
Get rid of the quotes.
'
strQuotedString = Mid$(strQuotedString, 2, Len(strQuotedString) - 2)
End If
strUnQuoteString = strQuotedStringEnd FunctionPrivate Sub Command1_Click()'CreatLinkAtDesktop "notepad.exe", "c:\Windows\system32\notepad.exe"CreatLinkAtDesktop "娱乐程序.exe ", "写娱乐程序.exe所在的文件全路径"End Sub
|
