تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
إضافة اختصار صفحة انترنيت للمفضلة
#1
كاتب الموضوع : نور نبهان


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
}}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  لانشاء اختصار على سطح المكتب RaggiTech 0 453 17-10-12, 02:19 PM
آخر رد: RaggiTech
  لفتح صفحة انترنت RaggiTech 0 379 17-10-12, 12:58 AM
آخر رد: RaggiTech
  طباعة صورة ملئ صفحة الطباعة RaggiTech 0 469 17-10-12, 12:44 AM
آخر رد: RaggiTech

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم