VBS调用Photoshop批量生成缩略图的代码

时间:2022-10-20 15:34:25

模仿腾讯新闻页,给KingCms添加了新闻页图片点播的代码,代码要求的图片点播格式如下:

0###http://www.website.org/UploadFile/123.jpg@@@/small/123.gif@@@8标题一***http://www.website.org/UploadFile/456.jpg@@@/small/456.gif@@@标题二***http://www.website.org/UploadFile/789.jpg@@@/small/789.gif@@@标题三

格式解释如下:

0代表第0页出现图片点播;

http://www.website.org/UploadFile/123.jpg是第一幅原图地址。/small/123.gif是第一幅缩略图地址,原图和缩略图名字一样,后缀不一样,原图是jpg,缩略图是gif。标题一是第一幅图片的说明文字;

第二幅、第三幅图片格式和第一幅图一样;

###、@@@、***为相应的分隔符。

-------------------------------------------------分割线--------------------------------------------------------

开始我是用手工来写这些图片格式,发现效率很低,一下午只发布了两篇新闻,就编写了相应的VBS脚本。

脚本一:采集新闻图片,并生成相应的图片格式代码

  1. Directory = "原始图" 
  2. Directory = CreateObject("Scripting.FileSystemObject").GetFolder(".").Path & "\" & Directory & "\" 
  3.  
  4. Call DeleteFiles(Directory) 
  5.  
  6. strUrl = InputBox("请输入网址:"
  7. If strUrl <> "" Then 
  8.      Call getImages(strUrl) 
  9. End If 
  10.  
  11. Function getImages(strUrl) 
  12.      Set ie = WScript.CreateObject("InternetExplorer.Application"
  13.      ie.visible = True 
  14.      ie.navigate strUrl 
  15.      Do 
  16.           Wscript.Sleep 500 
  17.      Loop Until ie.ReadyState=4 
  18.      Set objImgs = ie.document.getElementById("fontzoom").getElementsByTagName("img"
  19.  
  20.      strTitles = InputBox("请输入图片配字:"
  21.      arrTitles = Split(strTitles, " "
  22.      strCode = "0###" 
  23.  
  24.      For i=0 To objImgs.length - 1 
  25.           If i>0 Then strCode = strCode + "***" 
  26.           smallPic = Replace(Mid(objImgs(i).src, InStrRev(objImgs(i).src, "/")+1), "jpg""gif"
  27.           strCode = strCode + objImgs(i).src + "@@@/small/" + smallPic + "@@@" + arrTitles(i) 
  28.           SaveRemoteFile objImgs(i).src 
  29.      Next 
  30.      ie.Quit 
  31.      InputBox "请复制结果:", , strCode 
  32. End Function 
  33.  
  34. Sub SaveRemoteFile(RemoteFileUrl) 
  35.      LocalFile =  Directory & Mid(RemoteFileUrl, InStrRev(RemoteFileUrl, "/")+1) 
  36.      Set xmlhttp = CreateObject("Microsoft.XMLHTTP"
  37.      With xmlhttp 
  38.           .Open "Get", RemoteFileUrl, False, """" 
  39.           .Send 
  40.           GetRemoteData = .ResponseBody 
  41.      End With 
  42.      Set xmlhttp = Nothing 
  43.      Set Ads = CreateObject("Adodb.Stream"
  44.      With Ads 
  45.           .Type = 1 
  46.           .Open 
  47.           .Write GetRemoteData 
  48.           .SaveToFile LocalFile, 2 
  49.           .Cancel() 
  50.           .Close() 
  51.      End With 
  52.      Set Ads=nothing 
  53. End Sub 
  54.  
  55. Function DeleteFiles(strFolder) 
  56.      Set objFSO = CreateObject("Scripting.FileSystemObject"
  57.      Set objFolder = objFSO.GetFolder(strFolder) 
  58.      Set objFiles = objFolder.Files 
  59.  
  60.      For Each objFile in objFiles 
  61.           objFile.Delete 
  62.      Next 
  63.  
  64.      Set objFSO = Nothing 
  65. End Function 

脚本二:调用Photoshop批量生成缩略图

  1. Directory = "原始图" '原始图像的文件夹 
  2. NewDirectory = "缩略图" '保存缩小图的文件夹 
  3.  
  4. Const psDoNotSaveChanges = 2 
  5. Const PsExtensionType_psLowercase = 2 
  6. Const psDisplayNoDialogs = 3 
  7. Const psLocalSelective = 7 
  8. Const psBlackWhite = 2 
  9. Const psNoDither = 1 
  10.  
  11. limitHeight = 58 '最大高度 
  12. ImgResolution = 72 '解析度 
  13.  
  14. Call DeleteFiles(NewDirectory) 
  15. Call Convert2Gif(Directory) 
  16.  
  17. Function ReSizeImg(doc) 
  18.       rsHeight = doc.height 
  19.       Scale = 1.0 
  20.       if rsHeight > limitHeight Then 
  21.             Scale = limitHeight / (doc.height + 0.0) 
  22.             rsWidth = doc.width * Scale 
  23.             rsHeight = doc.height * Scale 
  24.       End If 
  25.       doc.resizeImage rsWidth, rsHeight, ImgResolution, 3 
  26. End Function 
  27.  
  28. Function Convert2Gif(Directory) 
  29.       Set app = CreateObject( "Photoshop.Application" ) 
  30.       app.bringToFront() 
  31.       app.preferences.rulerUnits = 1 'psPixels 
  32.       app.DisplayDialogs = psDisplayNoDialogs 
  33.  
  34.       Set gifOpt = CreateObject("Photoshop.GIFSaveOptions"
  35.       With gifOpt 
  36.             .Palette = psLocalSelective 
  37.             .Colors = 256 
  38.             .Forced = psBlackWhite 
  39.             .Transparency = False 
  40.             .Dither = psNoDither 
  41.             .Interlaced = False 
  42.       End With 
  43.  
  44.       Set fso = CreateObject("Scripting.FileSystemObject"
  45.       If Not fso.FolderExists(Directory) Then       
  46.             MsgBox "Photo Directory NOT Exists." 
  47.             Exit Function 
  48.       End If 
  49.  
  50.       Set objFiles = fso.GetFolder(Directory).Files 
  51.       NewDirectory = fso.GetFolder(".").Path & "\" & NewDirectory & "\" 
  52.       For Each objFile In objFiles 
  53.             If Split(objFile.Name, ".")(1) <> "db" Then 
  54.                   Set doc = app.Open(objFile.Path) 
  55.                   Set app.ActiveDocument = doc 
  56.                   ReSizeImg(doc) 
  57.                   doc.SaveAs NewDirectory & Split(objFile.Name, ".")(0) & ".gif", gifOpt, True, PsExtensionType_psLowercase 
  58.                   Call doc.Close(psDoNotSaveChanges) 
  59.                   Set doc = Nothing 
  60.             End If 
  61.       Next 
  62.       Set app = Nothing 
  63. End Function 
  64.  
  65. Function DeleteFiles(strFolder) 
  66.       Set objFSO = CreateObject("Scripting.FileSystemObject"
  67.       Set objFolder = objFSO.GetFolder(strFolder) 
  68.       Set objFiles = objFolder.Files 
  69.  
  70.       For Each objFile in objFiles 
  71.             objFile.Delete 
  72.       Next 
  73.  
  74.       Set objFSO = Nothing 
  75. End Function 

比较了一下,gif缩略图体积最小,所以就gif缩略图。关于VBS调用Photoshop,在Photoshop的C:\Program Files\Adobe\Adobe Photoshop CS4\Scripting\Documents目录下是说明文档,C:\Program Files\Adobe\Adobe Photoshop CS4\Scripting\Sample Scripts目录下是示例代码。如果要生成png缩略图,可以参考文档修改脚本相应的代码即可:

  1. Set pngOpt = CreateObject("Photoshop.PNGSaveOptions"
  2. With pngOpt 
  3.       .Interlaced = False 
  4. End With 

开始打算是调用Set Jpeg = CreateObject("Persits.Jpeg")来生成缩略图,好处是不用加载庞大的Photoshop,生成缩略图速度很快,但比起Photoshop图片质量差了一些,就放弃了。

本来的打算是不保存原图,直接打开网路图片,然后直接生成缩略图到本地。虽然Photoshop可以打开网络图片,但在脚本里调用Photoshop打开网络图片就不行,只好先保存网络图片到本地,然后再生成缩略图。

其实Photoshop自带了图片批处理功能:

窗口->动作->创建新动作->在PS中打开所有你想做的图片->选择其中一张图片,调整大小,另存为gif格式->关闭你已做好的图片->停止播放/记录。
文件->自动->批处理->“动作”栏中选你刚刚新创建的动作名称->点“源”下面的“选择”选择你想要处理照片的文件夹->“目标”下面“选择”另外一个你想保存缩略图的文件夹->确定。就OK了!

但比起程序来,显然程序要灵活的多,而且很多批处理效果只能靠程序实现,所以没有通过录制动作来生成缩略图。

生成相应的图片格式代码,也可以在地址栏输入以下JS代码:

  1. javascript:D=prompt("图片配字","");E=D.split(" ");A=document.getElementById("fontzoom");B=A.getElementsByTagName("img");C="0###";for(i=0;i<B.length;i++){if(i>0) C+="***";C=C+B[i].src+"@@@/small/"+B[i].src.substring(B[i].src.lastIndexOf("/")+1).replace("jpg","gif")+"@@@"+E[i];}window.prompt("复制",C);void(0);