如何读取收藏夹文件的URL（眩晕中..）

Question

RT，各位帮帮忙～

Answer 1

Option ExplicitPrivate Sub Command1_Click()
    Dim FSO As FileSystemObject
    Dim FL As File
    Dim TS As TextStream
    Dim s As String
    Set FSO = New FileSystemObject
    
    Set FL = FSO.GetFile("C:\MSN.url")
    Set TS = FL.OpenAsTextStream(ForReading)
    s = TS.ReadAll
    MsgBox s
    Set TS = Nothing
    Set FL = Nothing
    Set FSO = Nothing
End Sub

Answer 2

工程-〉引用Microsoft Scripting Runtime

Answer 3

这个东西，我先给你一个分析：
1、把你收藏夹里的一个.URL文件复制到C：改名为1（实际上是1.URL，但即使你选择了不隐藏已知文件扩展名，它也不会显示为1.URL，所以你只要把显示的名字改成1就可以了）
2、在运行中输入CMD，回车：打开一个DOS窗口
3、在打开的DOS窗口里输入:type c:\1.url >> c:\1.txt
这将会把你1.URL里面的全部内容一文本方式显示出来，并保存到c:\1.txt内。然后你就可以观察这个1.txt了，看到什么？
例如我把名为“如何攔截API呼叫”地址为“http://cache.baidu.com/c?word=readprocessmemory%2Cwriteprocessmemory%2C%C4d%BAI%2C%A4U%B8%FC&url=http%3A//www%2Ehosp%2Encku%2Eedu%2Etw/%7Ecww/html/q00553%2Ehtml&b=0&a=4&user=baidu”的一个URL文件按以上操作，得到1.txt内容为：
[DEFAULT]
BASEURL=http://cache.baidu.com/c?word=readprocessmemory%2Cwriteprocessmemory%2C%C4d%BAI%2C%A4U%B8%FC&url=http%3A//www%2Ehosp%2Encku%2Eedu%2Etw/%7Ecww/html/q00553%2Ehtml&b=0&a=4&user=baidu
[InternetShortcut]
URL=http://cache.baidu.com/c?word=readprocessmemory%2Cwriteprocessmemory%2C%C4d%BAI%2C%A4U%B8%FC&url=http%3A//www%2Ehosp%2Encku%2Eedu%2Etw/%7Ecww/html/q00553%2Ehtml&b=0&a=4&user=baidu
Modified=30027094C5CCC6018E
发现什么了？
1、.URL文件的结构怎么和和INI文件结构看着有点
2、[DEFAULT]字段中BASEURL的值就是你的URL
3、把[InternetShortcut]中的URL值复制并粘贴到IE地址栏回车，也到了该地址。
4、用BASEURL进入的时候，导致IE占用大量CPU资源，而用URL进入时，直接打开了。于是呼，我冒出个想法：默认值里的这个地址，是用来在地址栏显示的，而快捷方式里的地址会直接连到。好了，问题就说到这里，具体实现，楼主自己弄吧，
想说两句
第一句，遇到问题多动动脑子，明显这个快捷方式里面包含你想要的内容，试着查看他的内容。自己解决问题可以锻炼思维，提高解决问题的能力，形成自己的风格。
第二句，象这个文件在WINDOWS下用记事本等等都打不开，就应该试试DOS命令，DOS在某些情况下还是我们的好帮手，从低处着想也许比遇见问题就考虑API来的实际。

Answer 4

哎呀，从下班玩到现在。把我玩的给楼主看看。。
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As LongPrivate Sub Form_Resize()
'用第一个
Dim s1 As String, s2 As String
GetUrl "C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url", s1, s2
Debug.Print "sub::::::::::" & s1 & vbCrLf & "sub::::::::::" & s2
'用第二个
Debug.Print "function::1::" & mGetUrl("C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url")
'用第三个
Debug.Print "function::2::" & mGetUrlStr("C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url")
'用第四个
Debug.Print "function::3::" & mGetUrlString("C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url")End Sub
'先写的这个
Public Sub GetUrl(UrlFile As String, BASEURL As String, URL As String)
Dim mUrlArray() As Byte, mFileLen As Long, mUrlStr As String, mTmpStr() As String, mUrlStrArr() As String
'读文件到数组
Open UrlFile For Binary As #1
    mFileLen = LOF(1)
    ReDim mUrlArray(mFileLen - 1)
    Get #1, , mUrlArray()
Close #1
'Debug.Print UBound(mUrlArray)
'将数组转化为字符串
mUrlStr = StrConv(mUrlArray(), vbUnicode)
'Debug.Print mUrlStr
'分离各行数据
mTmpStr() = Split(mUrlStr, vbCrLf)
'Debug.Print UBound(mTmpStr)
'再次分离=前后的字符,得到结果(这里用所有的,前面的字符作为分割,嘿嘿,那数组里第2个就是我们要的结果了)
mUrlStrArr() = Split(mTmpStr(1), "BASEURL=")
BASEURL = mUrlStrArr(1)
mUrlStrArr() = Split(mTmpStr(3), "URL=")
URL = mUrlStrArr(1)
End Sub
'根据上面的改了改,嘿嘿,由于上面返回结果相同,所以详细看了一下,NND,中午比较着急,结果没仔细看,原来呀!两个返回值是一样的
Public Function mGetUrl(UrlFile As String) As String
Dim mUrlArray() As Byte, mFileLen As Long, mUrlStr As String, mTmpStr() As String, mUrlStrArr() As String
Open UrlFile For Binary As #1
    mFileLen = LOF(1)
    ReDim mUrlArray(mFileLen - 1)
    Get #1, , mUrlArray()
Close #1
'Debug.Print UBound(mUrlArray)
mUrlStr = StrConv(mUrlArray(), vbUnicode)
'Debug.Print mUrlStr
mTmpStr() = Split(mUrlStr, vbCrLf)
'Debug.Print UBound(mTmpStr)
mUrlStrArr() = Split(mTmpStr(1), "BASEURL=")
mGetUrl = mUrlStrArr(1)
'或者用下面代码
'mUrlStrArr() = Split(mTmpStr(3), "URL=")
'mGetUrlStr = mUrlStrArr(1)
End Function'再用文本读读看看
Public Function mGetUrlStr(UrlFile As String) As String
Dim InputData As String, mUrlStr As String, mTmpStr() As String, mUrlStrArr() As String
Open UrlFile For Input As #1
    Do While Not EOF(1)
        Line Input #1, InputData
        mUrlStr = mUrlStr & InputData & vbCrLf
    Loop
Close #1mTmpStr() = Split(mUrlStr, vbCrLf)
'Debug.Print UBound(mTmpStr)
mUrlStrArr() = Split(mTmpStr(1), "BASEURL=")
mGetUrlStr = mUrlStrArr(1)
'或者用下面代码
'mUrlStrArr() = Split(mTmpStr(3), "URL=")
'mGetUrlStr = mUrlStrArr(1)
End Function'可以用文本读..那就直接分离吧
Public Function mGetUrlString(UrlFile As String) As String
Dim InputData As String
Open UrlFile For Input As #1
    Do While Not EOF(1)
        Line Input #1, InputData
        '在下面的判断中可以用URL=但是速度要慢的
        If InStr(1, InputData, "BASEURL=") Then
            mGetUrlString = LTrim(Replace(InputData, "BASEURL=", " "))
            Exit Do
        End If
    Loop
Close #1
End Function'成了,用mGetUrlString函数看起来不错哦...测试一下速度.每个过程调用1000次Public Sub 测试速度()
Dim i As Long
Dim s1 As String, s2 As String
Dim tTime As Long
tTime = GetTickCount
'测试第一个
For i = 1 To 1000
    GetUrl "C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url", s1, s2
Next
Debug.Print "第一个 ", Format(GetTickCount - tTime, "0.0000"): tTime = GetTickCount
'测试第二个
For i = 1 To 1000
    mGetUrl "C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url"
Next
Debug.Print "第二个 ", Format(GetTickCount - tTime, "0.0000"): tTime = GetTickCount
'测试第三个
For i = 1 To 1000
    mGetUrlStr "C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url"
Next
Debug.Print "第三个 ", Format(GetTickCount - tTime, "0.0000"): tTime = GetTickCount
'测试第四个
For i = 1 To 1000
    mGetUrlString "C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url"
Next
Debug.Print "第四个 ", Format(GetTickCount - tTime, "0.0000"): tTime = GetTickCount
'测试第五个
For i = 1 To 1000
    GetUrlEx "C:\Documents and Settings\zcsor.YY-91AKIFGD7A38\Favorites\如何攔截API呼叫.url", s1
Next
Debug.Print "第五个 ", Format(GetTickCount - tTime, "0.0000"): tTime = GetTickCount
End SubPrivate Sub Form_Paint()
测试速度
MsgBox "测试完毕,请检查调试窗口"
End Sub'呀,结果好象挺有意思...第四个最快...嘿嘿,最后再玩玩
'把第一个的改一下下.....加入到测试中
Public Sub GetUrlEx(UrlFile As String, URL As String)
Dim mUrlArray() As Byte, mFileLen As Long, mUrlStr As String, mTmpStr() As String, mUrlStrArr() As String
Open UrlFile For Binary As #1
    mFileLen = LOF(1)
    ReDim mUrlArray(mFileLen - 1)
    Get #1, , mUrlArray()
Close #1
'Debug.Print UBound(mUrlArray)
mUrlStr = StrConv(mUrlArray(), vbUnicode)
'Debug.Print mUrlStr
mTmpStr() = Split(mUrlStr, vbCrLf)
'Debug.Print UBound(mTmpStr)
mUrlStrArr() = Split(mTmpStr(1), "BASEURL=")
URL = mUrlStrArr(1)
End Sub'改和没改没什么太大差异麻~~~