標簽歸檔:image

ASP圖片小偷,批量下載格力全部圖片

ASP圖片小偷,批量下載格力全部圖片
請保存為VBS文件

今天寫完這篇,打開發現卡巴報病毒,汗,不知道的還以為我掛馬~

下面代碼需要將“。”替換成“.”,“”替換成“”(英文的雙引號)

'ASP圖片小偷,批量下載格力全部圖片
'Design By Miaoqiyuan。cn
function getHTTPPage(url)  
	dim Http  
	set Http=createobject(”MSXML2。XMLHTTP”)  
	Http。open ”GET”,url,false  
	Http。send()  
	if Http。readystate<>4 then  
		exit function  
	end if  
	getHTTPPage=bytesToBSTR(Http。responseBody,”GB2312”)  
	set http=nothing  
	if err。number<>0 then err。Clear  
end function  
 
Function BytesToBstr(body,Cset)  
	dim objstream  
	set objstream = CreateObject(”adodb。stream”)  
	objstream。Type = 1  
	objstream。Mode =3  
	objstream。Open  
	objstream。Write body  
	objstream。Position = 0  
	objstream。Type = 2  
	objstream。Charset = Cset  
	BytesToBstr = objstream。ReadText  
	objstream。Close  
	set objstream = nothing  
End Function 
 
Function ZZ(ustr,uexp)
	Set regEx=New RegExp
	regEx。Pattern=uexp
	regEx。IgnoreCase=False
	regEx。Global=True
	Set ZZ=regEx。Execute(ustr)
End Function
 
Function Mappath(v)
	Mappath=fso。getAbsolutePathName(v)
End Function
 
Function CreateFolder(n)
	if not fso。folderexists(mappath(replace(n,”/”,”_”))) then
		fso。createfolder mappath(replace(n,”/”,”_”))
		CreateFolder=True
	else
		CreateFolder=False
	end if
End Function
 
Sub SaveImage(url,path)
	set Http=createobject(”MSXML2。XMLHTTP”)  
	Http。open ”GET”,url,false  
	Http。send()  
	if Http。readystate<>4 then  
		exit sub
	end if  
	set objstream = CreateObject(”adodb。stream”)
	objstream。Type = 1
	objstream。Mode =3
	objstream。Open 
	objstream。Write Http。responseBody
	objstream。savetofile path
End Sub
 
Sub Echo(t)
	Wscript。echo t
End Sub
 
Sub GetImage(ustr,una,uuri)
	Set Rs=ZZ(ustr,”<img 。*src=””(。*)”””)
	i=0
	for each uurl in Rs
		i=i+1
		Set oMacs=uurl
		SaveImage uuri&oMacs。submatches(0),mappath(una&/&i&”。jpg”)
	next
End Sub
 
Sub getall(url,xurl,uri)
	Html = getHTTPPage(uri&Url)
	set Rs=ZZ(html,”(”&xurl&”?。*)[#””]。*/>(。*)< \/a”)
	for each uurl in Rs
		Set oMacs=uurl
		if CreateFolder(oMacs。SubMatches(1))=True then
			echo uri&oMacs。SubMatches(0)&-->&oMacs。SubMatches(1)
			getImage getHttpPage(uri&oMacs。SubMatches(0)),oMacs。SubMatches(1),uri
		end if
	next
End Sub
 
on error resume next
Set fso=CreateObject(”Scripting。FileSystemObject”)
urls=split(”ftgb|ftlg|zykt”,”|”)
xurls=split(”ftgbxx|ftlgxx|zyktcpxx”,”|”)
for i=0 to ubound(urls)
	getall urls(i)&”。jsp”,xurls(i)&”。jsp”,”http://gree。com。cn/gree_product/next

圖片批量轉換工具

實現功能:
1.預算剩余時間
2.預測剩余進度
3.轉換大小
4.自動調整比列
5.顯示轉換所有時間
6.顯示調整所用時間
7.顯示征途所有時間

下面給出程序源代碼(r.vbs)

oh=640	'最大高度
op=10	'運行完等待時間,默認1000,即1秒

Function Mappath(v)
	Mappath=fso.getAbsolutePathName(v)
End Function
 
Sub Convert
	imgnum=fpo.files.count
	wscript.echo "圖片批量轉換工具 1.0 By 苗啟源"&vbCrlf&String(60,"=")
	imgsta=timer()
	imgi=1
	for each file in fpo.files
	    if ucase(fso.getExtensionName(file))="JPG" Then
	    	imgedit=timer()
			wscript.echo "開始"&file.name&"轉換..."
	        jpeg.open file
	        owidth=jpeg.originalwidth
	        oheight=jpeg.originalheight
	        if owidth>oheight then
	        	whedit=timer()
	        	om=(owidth-oheight)/2
	        	jpeg.crop 0,0-om,owidth,oheight+om
	        	wscript.echo "調整長寬比完畢,用時"&(timer()-whedit)*1000&"毫秒。"
	        end if
            if jpeg.height>oh then
            	resizeedit=timer()
            	jpeg.width=oh*jpeg.width/jpeg.height
            	jpeg.height=oh
            	wscript.echo "壓縮圖片完畢,用時"&(timer()-resizeedit)*1000&"毫秒。"
            end if
            wscript.echo "原大小:"&oWidth&"x"&oHeight&",現大小:"&jpeg.width&"x"&jpeg.height
	        jpeg.save file
	        jpeg.close
	        wscript.echo file.name&"轉換完畢,用時"&(timer()-imgedit)*1000&"毫秒。"
	        wscript.echo "當前進度"&CLng((imgi/imgnum)*10000)/100&"%,已開始"&(timer-imgsta)&"秒,預計還剩"&cint((imgnum-imgi)*(timer-imgsta)/imgi)&"秒。"&vbCrlf
	        wscript.sleep op
	    end if
	    imgi=imgi+1
	next
	wscript.echo String(60,"=")&vbCrlf&"轉換完畢。"
	wscript.sleep 10000
End Sub
 
set fso=CreateObject("Scripting.FileSystemObject")
set jpeg=CreateObject("Persits.JPEG")
set fpo=fso.getFolder(Mappath(""))
Convert