'在模块输入以下代码。
Public Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As LongPublic Function ReadString(ByVal Section As String, ByVal key As String, filepath As String) As String
On Err GoTo err1
Dim X As Long, buff As String * 300, i As Integer
X = GetPrivateProfileString(Section, key, "", buff, 300, filepath)
i = InStr(buff, Chr(0))
ReadString = Trim(Left(buff, i - 1))
err1:
Exit Function
End Function
Public Sub geturl(folderpath As String)
On Error GoTo err1
Dim f, f1, f2, fc, S, nextfolder, f3, files
Dim fs As Object, file
Dim a As Long
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderpath)
Set fc = f.SubFolders
Set files = f.files
For Each file In files
If Right(file.Name, 3) = "url" Then
If Dir(apppath("url.txt")) <> "" Then
Kill apppath("url.txt")
End If
a = Form1.ListView1.ListItems.count + 1
FileCopy file.path, apppath(file.Name + ".txt")
Form1.Inet1.URL = ReadString("InternetShortcut", "URL", apppath(file.Name + ".txt"))
Form1.ListView1.ListItems.Add a, , file.Name
Form1.ListView1.ListItems(a).SubItems(1) = ReadString("InternetShortcut", "URL", apppath(file.Name + ".txt"))
Kill apppath(file.Name + ".txt")
End If
Next
For Each f1 In fc
If f1 <> "" Then
If Right(folderpath, 1) = "\" Then
geturl folderpath + f1.Name
Else
geturl folderpath + "\" + f1.Name
End If
End If
Next
err1:
Resume Next
End Sub
使用方法
geturl(收藏夹的路径)
Public Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As LongPublic Function ReadString(ByVal Section As String, ByVal key As String, filepath As String) As String
On Err GoTo err1
Dim X As Long, buff As String * 300, i As Integer
X = GetPrivateProfileString(Section, key, "", buff, 300, filepath)
i = InStr(buff, Chr(0))
ReadString = Trim(Left(buff, i - 1))
err1:
Exit Function
End Function
Public Sub geturl(folderpath As String)
On Error GoTo err1
Dim f, f1, f2, fc, S, nextfolder, f3, files
Dim fs As Object, file
Dim a As Long
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderpath)
Set fc = f.SubFolders
Set files = f.files
For Each file In files
If Right(file.Name, 3) = "url" Then
If Dir(apppath("url.txt")) <> "" Then
Kill apppath("url.txt")
End If
a = Form1.ListView1.ListItems.count + 1
FileCopy file.path, apppath(file.Name + ".txt")
Form1.Inet1.URL = ReadString("InternetShortcut", "URL", apppath(file.Name + ".txt"))
Form1.ListView1.ListItems.Add a, , file.Name
Form1.ListView1.ListItems(a).SubItems(1) = ReadString("InternetShortcut", "URL", apppath(file.Name + ".txt"))
Kill apppath(file.Name + ".txt")
End If
Next
For Each f1 In fc
If f1 <> "" Then
If Right(folderpath, 1) = "\" Then
geturl folderpath + f1.Name
Else
geturl folderpath + "\" + f1.Name
End If
End If
Next
err1:
Resume Next
End Sub
使用方法
geturl(收藏夹的路径)
解决方案 »
- VB 相对路径的上一级目录怎样表示??
- 发布我的作品,RobotTankForVB,一款类似于robocode的程序,不过是for VB的
- 如何实现:www.XX.com有MSSQL数据库DB(含表Tab),要求写一个客户端软件,当表Tab中有记录插入时,在客户端C盘记录下该记录
- 请问在VB里用SQL语句怎么创建一个表?
- 请问如何取得AMD CPU的 唯一序列号?
- 请问
- 请问date report 怎样生成新页而不打印,我现在是打印一次后生成下一个报表,不是连续的
- 我受不了msdn了,谁能告诉我有效的使用方法。
- 关于文本框的问题.急……请各位帮帮忙
- 紧急求助,请教各位如何能修复已经损坏的Access数据库,我使用Access97无法修复!
- 高分求解,在线等待,急、急、急!:关于project结构问题
- 关于frame?
谢谢!(不过GetUrl如果能够返回一个oUrl对象集合或者数组就好了!
我就能直接使用,嘻嘻!)