17-10-12, 04:39 PM
كاتب الموضوع : نور نبهان
Create an internet shortcut
Create an internet shortcut
في الموديول
كود :
Public Const NOERROR = 0
Public Const CSIDL_FAVORITES = &H6
Public Const CSIDL_DESKTOPDIRECTORY = &H10
في الفورم
كود :
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Function GetSpecialPath(CSIDL As Long) As String
Dim r As Long
Dim path As String
Dim IDL As ITEMIDLIST
'fill the idl structure with the specified folder item
r = SHGetSpecialFolderLocation(Me.hWnd, CSIDL, IDL)
If r = NOERROR Then
path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal path$)
GetSpecialPath = Left$(path, InStr(path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialPath = ""
End Function
Private Sub Command1_Click()
Dim URLpath As String
Dim CSIDLpath As String
Dim nameofLink As String
Dim ff As Integer
URLpath = "http://www.vb4arab.com"
CSIDLpath = GetSpecialPath(CSIDL_FAVORITES) & "\"
nameofLink = "vb4arab.url"
ff = FreeFile
Open CSIDLpath & nameofLink For Output As #ff
Print #ff, "[InternetShortcut]"
Print #ff, "URL=" & URLpath
Close #ff
End Sub
Create an internet shortcut
في الموديول
كود :
Public Const NOERROR = 0
Public Const CSIDL_FAVORITES = &H6
Public Const CSIDL_DESKTOPDIRECTORY = &H10
في الفورم
كود :
Private Type SHITEMID cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Function GetSpecialPath(CSIDL As Long) As String
Dim r As Long
Dim path As String
Dim IDL As ITEMIDLIST
'fill the idl structure with the specified folder item
r = SHGetSpecialFolderLocation(Me.hWnd, CSIDL, IDL)
If r = NOERROR Then
path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal path$)
GetSpecialPath = Left$(path, InStr(path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialPath = ""
End Function
Private Sub Command1_Click()
Dim URLpath As String
Dim CSIDLpath As String
Dim nameofLink As String
Dim ff As Integer
URLpath = "http://www.vb4arab.com"
CSIDLpath = GetSpecialPath(CSIDL_FAVORITES) & "\"
nameofLink = "vb4arab.url"
ff = FreeFile
Open CSIDLpath & nameofLink For Output As #ff
Print #ff, "[InternetShortcut]"
Print #ff, "URL=" & URLpath
Close #ff
End Sub