/ Forside/ Teknologi / Udvikling / VB/Basic / Tip
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
VB/Basic
#NavnPoint
berpox 2425
pete 1435
CADmageren 1251
gibson 1230
Phylock 887
gandalf 836
AntonV 790
strarup 750
Benjamin... 700
10  tom.kise 610
Tilføj favoriter.
rean har modtaget 20 point for dette tip
Fra : rean
Vist : 623 gange

Dato : 27-11-00 14:58

Add din webadresse direkte til brugerens favoriter.


eks :AddFavorite "Min adresse", "http://minadress.dk/"


***************************************
Private Declare Function SHGetSpecialFolderLocation _
Lib "shell32.dll" (ByVal hwndOwner As Long, _
ByVal nFolder As SpecialShellFolderIDs, _
pidl As Long) As Long

Private Declare Function SHGetPathFromIDList _
Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
(ByVal pv As Long)

Public Enum SpecialShellFolderIDs
CSIDL_DESKTOP = &H0
CSIDL_INTERNET = &H1
CSIDL_PROGRAMS = &H2
CSIDL_CONTROLS = &H3
CSIDL_PRINTERS = &H4
CSIDL_PERSONAL = &H5
CSIDL_FAVORITES = &H6
CSIDL_STARTUP = &H7
CSIDL_RECENT = &H8
CSIDL_SENDTO = &H9
CSIDL_BITBUCKET = &HA
CSIDL_STARTMENU = &HB
CSIDL_DESKTOPDIRECTORY = &H10
CSIDL_DRIVES = &H11
CSIDL_NETWORK = &H12
CSIDL_NETHOOD = &H13
CSIDL_FONTS = &H14
CSIDL_TEMPLATES = &H15
CSIDL_COMMON_STARTMENU = &H16
CSIDL_COMMON_PROGRAMS = &H17
CSIDL_COMMON_STARTUP = &H18
CSIDL_COMMON_DESKTOPDIRECTORY = &H19
CSIDL_APPDATA = &H1A
CSIDL_PRINTHOOD = &H1B
CSIDL_ALTSTARTUP = &H1D
CSIDL_COMMON_ALTSTARTUP = &H1E
CSIDL_COMMON_FAVORITES = &H1F
CSIDL_INTERNET_CACHE = &H20
CSIDL_COOKIES = &H21
CSIDL_HISTORY = &H22
End Enum


Public Sub AddFavorite(SiteName As String, URL As String)

Dim pidl As Long
Dim intFile As Integer
Dim strFullPath As String

On Error GoTo Farvel

intFile = FreeFile
strFullPath = Space(255)

'Check the API for the folder existence and location

If SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl) = 0 Then

   If pidl Then

      If SHGetPathFromIDList(pidl, strFullPath) Then

         ' Trim any null characters

         If InStr(1, strFullPath, Chr(0)) Then
            strFullPath = Mid(strFullPath, 1, _
               InStr(1, strFullPath, Chr(0)) - 1)
         End If

         ' Add back slash, if none exists

         If Right(strFullPath, 1) <> "\" Then
            strFullPath = strFullPath & "\"
         End If

         ' Create the link

         strFullPath = strFullPath & SiteName & ".URL"
         Open strFullPath For Output As #intFile
         Print #intFile, "[InternetShortcut]"
         Print #intFile, "URL=" & URL
         Close #intFile

      End If

      CoTaskMemFree pidl

   End If

End If

Farvel:

End Sub

***************************************

 
 
Bedømmelse

Fra : stk


Dato : 16-03-01 13:01



Bedømmelse

Fra : gandalf


Dato : 20-06-01 11:44



Bedømmelse

Fra : gandalf


Dato : 20-06-01 11:44



Bedømmelse

Fra : gandalf


Dato : 20-06-01 11:44



Bedømmelse

Fra : gandalf


Dato : 20-06-01 11:44



Du har følgende muligheder
Eftersom du ikke er logget ind i systemet, kan du ikke lave en bedømmelse til dette tip.

Hvis du ikke allerede er registreret, kan du gratis blive medlem, ved at trykke på "Bliv medlem" ude i menuen.
Søg
Reklame
Statistik
Spørgsmål : 177551
Tips : 31968
Nyheder : 719565
Indlæg : 6408825
Brugere : 218887

Månedens bedste
Årets bedste
Sidste års bedste