把当前web页面上的所有图片复制到特定目录VBS完全修正版

把当前web页面上的所有图片复制到特定目录,比如C:/imgs/

转载请注明:作者:糯米糊糊(huyoo353),来源:http://blog.csdn.net/huyoo/

 CpyCachePic.htm文件

-------------------------------------------------------------------------------------

<Script language="VBScript">
'
' ***************请保留此版权信息,不影响您的使用***************
' *                                                            *
' *    由GB爱好者论坛的Edward倾情制作于2004年11月29日          *
' *    最新修改2007年7月9日                                    *
' *    有问题请联系huyoo353@126.com                            *
' *    希望所有的GB爱好者使用方便!!!!                          *
' *    转载请注明:                                             *
' *         作者:糯米糊糊(huyoo353)(糯米糊糊就是Edward)        *
' *         来源:http://blog.csdn.net/huyoo/                   *
' *                                                            *
' ***************请保留此版权信息,不影响您的使用***************

alert "开始复制图片,可能需要花费几分钟,请耐心等待。。。"

Set objFSO = CreateObject("Scripting.FileSystemObject")
'alert objFSO.GetFolder("%USERPROFILE%/Local Settings/Temporary Internet Files")
'设置图像对象集合
set imgs = external.menuArguments.document.images

Dim counter
Dim logfile '定义记录文件对象
logfilename=""

Dim cachefolder,tempimgs     '定义JPG文件所在的IE缓存文件夹,要复制到的临时目标文件夹
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'设置文件夹路径
'严重注意:这是你有必要修改的两个地方!!!
'一般这两个文件夹是IE存放临时文件的地方,如下:
cachefolder1="C:/Documents and Settings/Administrator/Local Settings/Temporary Internet Files/"   '我的IE临时文件夹地址,请改为你自己的
'cachefolder1="%USERPROFILE%/Local Settings/Temporary Internet Files" ' 注意这一句经测验无效
cachefolder2="C:/Documents and Settings/Administrator/Local Settings/Temp/Temporary Internet Files/"   '我的IE临时文件夹地址,请改为你自己的
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
tempimgs="C:/Imgs/"   '我把JPG图像复制到我自己的C:/imgs/,请改为你自己喜欢的
counter=0
call CreateLogFileAndTempFolder()'创建记录文件和临时文件夹
call CopyCachePicToTempFolder()'把缓存中的图片复制到临时文件夹tempimgs

Sub CreateLogFileAndTempFolder()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
'如果临时文件夹不存在,就创建它

ForReading = 1
ForWriting = 2
ForAppending = 8
if objFSO.FolderExists(tempimgs) then
 ' 什么也不做 
else
 objFSO.CreateFolder(tempimgs)     
end if

 '如果记录文件zcopylog.txt不存在,就创建记录文件
 logfilename=tempimgs & "zcopylog.txt"
 if objFSO.FileExists(logfile) then
  set logfile=objFSO.OpenTextFile(logfilename,ForAppending,False)'在文件末尾追加
 else
  set logfile=objFSO.CreateTextFile(logfilename,true)
 end if
 logfile.writeline Now() & " 开始复制 " 
 ' 下面取网页标题在2K下能工作,XP不能工作,所以注释了
 'logfile.WriteLine Now() & " 网页名称: " & external.menuArguments.document.title
 logfile.WriteLine Now() & " 起始页面: " & external.menuArguments.location
 logfile.WriteLine Now() & " JPG/GIF等图像总数: " & external.menuArguments.document.images.length
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
end Sub


Sub CopyCachePicToTempFolder()
On Error Resume Next
set imgs = external.menuArguments.document.images
If err<>0 then
 logfile.WriteLine  "发生错误,原因为:"& Error.Description
else
  dim objDir,objFolder, objFile

  Set objFolder = objFSO.GetFolder(cachefolder2)
  call SearchIETemp(objFolder.Path)

  Set objFolder = objFSO.GetFolder(cachefolder1)
  call SearchIETemp(objFolder.Path)

  logfile.WriteLine now() & " 复制完成,本次任务共复制了 " & Counter &" 张 JPG 图片"
  alert "复制完成!本次任务共复制了" & Counter &" 张JPG图片" & vbnewline &"请到" & tempimgs &"目录下查看复制的文件"

 
End If   
   
end Sub

Sub SearchIETemp(strIETempPath)
   
    Dim objFolder   '文件夹对象
    Dim objFile    '文件对象
    Dim objSubdirs   '文件夹集合对象
    Dim objLoopFolder    '文件夹对象

    Set objFolder = objFSO.GetFolder(strIETempPath)
   
    logfile.writeline Now()&" 搜索文件夹: "+ objFolder.ShortPath
    For Each objFile In objFolder.Files
 'logfile.WriteLine objFile.ShortPath
        If UCase(Right(objFile.ShortPath, 4)) = ".JPG" Then
           
            For i=0 to imgs.length-1

                'logfile.WriteLine imgs.length
                pos=InstrRev(imgs(i).src,"/")
  filename=Mid(imgs(i).src,pos+1,Len(imgs(i).src)-pos)
  finalname=filename
  pos=Instr(filename,".")
  filename=Left(filename,pos-1)+"[1]"+Right(filename,Len(filename)-pos+1)
                'logfile.WriteLine filename

              IF filename=objFile.Name then
                objFSO.CopyFile objFile.Path, tempimgs & finalname
                counter=counter+1
              logfile.WriteLine Now()&" +------复制文件: " & imgs(i).src
              End If
          Next
          
        End If
    Next

    Set objSubdirs = objFolder.SubFolders
   
    For Each objLoopFolder In objSubdirs
        SearchIETemp objLoopFolder.Path
    Next
End Sub

</script>

-------------------------------------------------

注册到右键的CpyCachePic.reg

-------------------------------------------

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/保存当前网页所有图片]
"contexts"=dword:000000f3
@="C://Program Files//CpyCachePic//CpyCachePic.htm"

--------------------------------------------------

安装脚本setup.bat

---------------------------------------------------

echo off
echo ...开始安装CpyCachePic
echo ...CpyCachePic是一个用VBScript编写的网页工具,可以将当前浏览的网页中的所有JPG图片保存到C:/Imgs/目录中
echo ...CpyCachePic适合IE内核的浏览器,提供IE右键菜单供操作,GreenBrowser同样适用。
echo ...CpyCachePic作者:糯米糊糊(huyoo353),http://blog.csdn.net/huyoo,GreenBrowser爱好者(Edward/huyoo)
pause
echo ...创建图片存储目录C:/Imgs/
if not exist C:/Imgs/ md C:/Imgs/
echo ...创建安装目录C:/Program Files/CpyCachePic
if not exist "C:/Program Files/CpyCachePic" md "C:/Program Files/CpyCachePic"
echo ...复制文件CpyCachePic.htm
copy CpyCachePic.htm "C:/Program Files/CpyCachePic"
echo ...复制文件ReadMe_huyoo.txt
copy ReadMe_huyoo.txt "C:/Program Files/CpyCachePic"
echo ...复制文件 图片保存目录.lnk 到桌面快捷方式
copy 图片保存目录.lnk "%USERPROFILE%/桌面/"
echo 注册IE鼠标右键
CpyCachePic.reg
echo 安装完成
pause

---------------------------------------------

说明文件:ReadMe_Huyoo.txt

--------------------------------------------------------------------------

CpyCachePic是一个用VBScript编写的网页工具,可以将当前浏览的网页中的所有JPG图片保存到C:/Imgs/目录中
CpyCachePic适合IE内核的浏览器,提供IE右键菜单供操作,GreenBrowser同样适用。
CpyCachePic作者:糯米糊糊(huyoo353),http://blog.csdn.net/huyoo,GreenBrowser爱好者(Edward/huyoo)

 

CpyCachePic.htm 中的
cachefolder1="C:/Documents and Settings/Administrator/Local Settings/Temporary Internet Files/"   '我的IE临时文件夹地址,请改为你自己的
'cachefolder1="%USERPROFILE%/Local Settings/Temporary Internet Files"
cachefolder2="C:/Documents and Settings/Administrator/Local Settings/Temp/Temporary Internet Files/"   '我的IE临时文件夹地址,请改为你自己的

这段中Administrator请改成你自己的登录用户名,并确认操作系统在C:/

---------------------------------------------------------------

另外有一个快捷方式,放到桌面的。

所有文件打包下载:后天发到GreenBrowser的论坛去。

【更新2007/8/2】压缩包打包请到 http://www.5igb.com/bbs/viewthread.php?tid=5118&page=1&extra=page%3D1#pid22555 下载

运行setup.bat时,希望创建目录的时候,杀毒软件不要报错!!

右键菜单中,运行此htm中的vbs脚本时,可能杀毒软件会提示IE或GreenBrowser要执行什么恶意脚本(以前我的诺顿就提示过),选择允许此脚本运行,并勾上不再提示之类的选项就行。

用setup.bat安装的图片:

最后,还是那句话:转载请注明:作者:糯米糊糊(huyoo353),来源:http://blog.csdn.net/huyoo/

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值