把当前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/