如何读取收藏夹文件的URL（眩晕中..） VB / API - CSDN社区 commun...

Option   Explicit  
   
  Private   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   SubTop

2 楼shhzhf（）回复于 2006-09-19 00:07:56 得分 0

FileSystemObject是什么  
  Top

3 楼Hassle（）回复于 2006-09-19 00:11:16 得分 0

工程-〉引用Microsoft   Scripting   RuntimeTop

4 楼zcsor（偶业余的虽然星星了，但是水平依然是非常业余的。）回复于 2006-09-19 14:17:40 得分 0

这个东西，我先给你一个分析：  
  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来的实际。  
  Top

5 楼zcsor（偶业余的虽然星星了，但是水平依然是非常业余的。）回复于 2006-09-19 18:29:16 得分 0

哎呀，从下班玩到现在。。。。把我玩的给楼主看看。。  
  Option   Explicit  
  Private   Declare   Function   GetTickCount   Lib   "kernel32"   ()   As   Long  
   
  Private   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   #1  
   
  mTmpStr()   =   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   Sub  
   
  Private   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  
   
  '改和没改没什么太大差异麻~~~