<% @ LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
Option Explicit
Class BoxInfoImg
????'傳輸類的使用方法
????'圖象上傳和上傳信息獲取CLASS
????'用法:
????'dim imgUp
????'set imgUp=new BoxInfoImg
????
????'屬性:
????'imgUp.width????'寬
????'imgUp.height????'高
????'imgUp.imgSize????'大小
????'imgUp.imgType????'類型
????'imgUp.imgName????'文件名
????'imgUp.imgName '圖像文件名:"&
????'imgUp.filename '文件名"&
????'imgUp.extName '擴展名"
????'imgUp.DiskPath '保存位置"
????'imgUp.XuPath '虛擬路徑"
????'imgUp.NewUrl '保存后url"
????'imgUp.SaveMode '保存后url"
????
????'方法:
????'imgUp.saveImg(fullpath)????'保存圖像文件
????
????dim ADOS
????dim width,height,imgSize,imgType,imgName,fileName
????dim preName,extName
????dim SavePath,SaveName,SaveMode
????dim DiskPath,XuPath,NewUrl
????dim textStr
????dim i
????
????Private Sub Class_Initialize
????????set ADOS=Server.CreateObject("Adodb.Stream")
????????????ADOS.Type=1
????????????ADOS.Mode=3
????????????ADOS.Open
????????????getImageSize
????End Sub
????
????Private Sub Class_Terminate
????????ADOS.close
????????set ADOS=nothing
????End Sub
????Public Function getImageSize()
????????
????????????dim ret(3),bFlag,fdata,fsize
????????????fdata=GetWebData(GetStrUrl) '取得XmlHttp數據
????????????fsize=clng(lenb(fdata))????????'取得數據尺寸
????????????
????????????if fsize=0 then
????????????????exit function
????????????????R_write "無有效數據保存",0
????????????end if
????????????
????????????ADOS.Write fdata????
????????????ADOS.Position=0
????????????
????????????SaveName=iSaveName
????????????SavePath=iSavePath
????????????SaveMode=iSaveMode
????????
????????????'寫文本對象讀取圖像長寬和類型
????????????ADOS.Position=0 '重置數據開始位置
????????????bFlag=ADOS.read(3)
????????????
????????????if isNull(bFlag) then
????????????????width=0
????????????????height=0
????????????????imgSize=0
????????????????imgType="unknow"
????????????????ret(0)=imgType:ret(1)=width:ret(2)=height:ret(3)=""
????????????????getimagesize=ret
????????????????exit function
????????????end if
????????
????????????'取文件類型和長寬
????????????select case hex(binVal(bFlag))
????????????case "4E5089":
????????????????ADOS.read(15)
????????????????ret(0)="png"
????????????????ret(1)=BinVal2(ADOS.read(2))
????????????????ADOS.read(2)
????????????????ret(2)=BinVal2(ADOS.read(2))
????????????case "464947":
????????????????ADOS.read(3)
????????????????ret(0)="gif"
????????????????ret(1)=BinVal(ADOS.read(2))
????????????????ret(2)=BinVal(ADOS.read(2))
????????????case "FFD8FF":
????????????????dim p1
????????????????do
????????????????do: p1=binVal(ADOS.Read(1)): loop while p1=255 and not ADOS.EOS
????????????????if p1>191 and p1<196 then exit do else ADOS.read(binval2(ADOS.Read(2))-2)
????????????????do:p1=binVal(ADOS.Read(1)):loop while p1<255 and not ADOS.EOS
????????????loop while true
????????????????ADOS.Read(3)
????????????????ret(0)="jpg"
????????????????ret(2)=binval2(ADOS.Read(2))
????????????????ret(1)=binval2(ADOS.Read(2))
????????????case else:
????????????????if left(Bin2Str(bFlag),2)="BM" then
????????????????????ADOS.Read(15)
????????????????????ret(0)="bmp"
????????????????????ret(1)=binval(ADOS.Read(4))
????????????????????ret(2)=binval(ADOS.Read(4))
????????????????else
????????????????????ret(0)=""
????????????????end if
????????????end select
????????????'
????????????dim tempStr
????????????dim nameStr
????????????dim defaultName
????????????dim ln
????????????tempStr=split(GetStrUrl,"/")
????????????nameStr=tempStr(ubound(tempStr))
????????????if nameStr="" then
????????????????r_write "錯誤的URL,請輸入可訪問的URL",0
????????????????exit function
????????????end if
????????????fileName=split(nameStr,"?")(0)
????????????ln=inStrRev(fileName,".")
????????????if ln>0 then
????????????????preName=left(fileName,inStrRev(fileName,".")-1)
????????????else
????????????????preName=fileName
????????????end if
????????????'R_write fileName,1
????????????'R_write inStrRev(fileName,"."),1
????????????'R_write fileName,0
????????????extName=right(fileName,len(fileName)-inStrRev(fileName,"."))
????
????????????Select case ret(0)
????????????case "png","jpg","bmp","gif","swf"
????????????????width=ret(1)
????????????????height=ret(2)
????????????????imgSize=fsize
????????????????imgType=ret(0)
????????????????imgName=preName&"."&ret(0)
????????????case else
????????????????width=0
????????????????height=0
????????????????imgSize=fsize
????????????????imgName="unknow"
????????????????imgType=".unknow"
????????????end select
????????????
????????????if SaveMode="1" then
????????????????defaultName=imgName
????????????????if SaveName="" then
????????????????????SaveName=defaultName
????????????????else
????????????????????if lcase(right(SaveName,4))<>"."&imgType then
????????????????????????SaveName=SaveName&"."&imgType
????????????????????end if
????????????????end if
????????????else
????????????????defaultName=filename
????????????end if
????????????if SaveName="" then SaveName=defaultName
????????????SavePath=replace(SavePath,"http://","/")
????????????if right(SavePath,1)<>"/" then SavePath=SavePath&"/"
????????????if SavePath="" then SavePath="./"
????????????????DiskPath=server.mappath(SavePath&SaveName)
????????????????XuPath=replace(replace(DiskPath,server.mappath("/"),""),"\","/")
????????????NewUrl="http://"&Request.ServerVariables("SERVER_NAME")&XuPath
????????????
????????????getimagesize=ret
????End Function
????Public function SaveImg(FullPath)
????????SaveImg=false
????????if SaveMode="1" then
????????????if trim(fullpath)="" or _
????????????????width=0 or _
????????????????height=0 or _
????????????????imgSize=0 or _
????????????????imgType=".unknow" then exit function end if
????????end if
????????ADOS.Position=0
????????if SaveMode="2" then
????????????ADOS.Type=2
????????????ADOS.Charset ="gb2312"
????????????ADOS.SaveToFile FullPath,2
????????????textStr=ADOS.readtext()
????????else
????????????ADOS.SaveToFile FullPath,2
????????end if
????????SaveImg=true
????End function
????Private Function Bin2Str(Bin)
????????Dim I,Str,clow
????????For I=1 to LenB(Bin)
????????????clow=MidB(Bin,I,1)
????????if ASCB(clow)<128 then
????????????Str = Str & Chr(ASCB(clow))
????????else
????????????I=I+1
????????????if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
????????end if
????????Next
????????????Bin2Str = Str
????End Function
????Private Function Num2Str(num,base,lens)
????????dim ret:ret = ""
????????while(num>=base)
????????????ret=(num mod base) & ret
????????????num=(num - num mod base)/base
????????wend
????????????Num2Str = right(string(lens,"0") & num & ret,lens)
????End Function
????Private Function Str2Num(str,base)
????????dim ret:ret = 0
????????for i=1 to len(str)
????????????ret = ret *base + cint(mid(str,i,1))
????????next
????????????Str2Num=ret
????End Function
????Private Function BinVal(bin)
????????dim ret:ret = 0
????????for i = lenb(bin) to 1 step -1
????????????ret = ret *256 + ascb(midb(bin,i,1))
????????next
????????????BinVal=ret
????End Function
????Private Function BinVal2(bin)
????????dim ret:ret = 0
????????for i = 1 to lenb(bin)
????????????ret = ret *256 + ascb(midb(bin,i,1))
????????next
????????????BinVal2=ret
????End Function
????Private????Function GetWebData(byval StrUrl)
????????if StrUrl="" then
????????????r_write "無效",1
????????????exit function
????????end if
????????dim tempStr
????????tempStr=split(GetStrUrl,"/")
????????if tempStr(ubound(tempStr))="" or inStr(StrUrl,"/")=0 then
????????????R_Write "未指定有效的URL",0
????????????exit function
????????end if
????????dim Retrieval
????????Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
????????With Retrieval
????????.Open "Get", StrUrl, False, "", ""
????????.Send
????????GetWebData =.ResponseBody
????????End With
????????Set Retrieval = Nothing
????End Function????????????
End Class
%>
<%
SUB saveUpload(GetUrl,SavePath,SaveName,mode)
????dim chkInfo
????if GetUrl="" then
????????call tform()
????????R_Write "<br>傳輸文件欄沒有填寫!",0
????end if
????set imgUp=new BoxInfoImg
????
????if mode="1" and imgUp.imgName="unknow" then
????????call tform()
????????set imgUp=nothing
????????R_Write "<br>傳輸文件欄沒有填寫有效的圖像URL!",0
????end if
????chkInfo=""
????dim i,testStr,showStr
????'限定格式
????select case imgUp.imgType
????case "png","jpg","bmp","gif"
????????if imgUp.width=0 or imgUp.height=0 or imgUp.imgSize=0 then
????????????chkInfo="<li>"+"傳輸圖像數據不存在,請確定你的URL是否正確"
????????end if
????case else
????????chkInfo="<li>無效的傳輸格式,允許圖像數據格式為 ""png"",""jpg"",""bmp"",""gif""</li>"
????end select
????'R_Write SavePath,1
????'R_Write mode,1
????'R_Write imgUp.imgName,1
????'R_Write imgUp.filename,1
????'R_Write "SaveName="&SaveName,1
????
????if mode="1" and chkInfo<>"" then '檢查上傳圖像數據合格后,則保存之
????????????call tform()
????????????R_Write chkInfo,0
????else
????????Server.ScriptTimeOut=5000
????????imgUp.saveImg imgUp.DiskPath ????
????end if
'-------------
????????????R_write "<b>===處理結果部分資料===</b><br>",1
????????????R_write " 寬:"&imgUp.width&" pix",1
????????????R_write " 高:"&imgUp.height&" pix",1
????????????R_write " 大小:"&formatnumber(imgUp.imgSize/1024,2,-1)&" KB",1
????????????R_write " 格式:"&imgUp.imgType,1
????????????R_write "圖像文件名:"&imgUp.imgName,1
????????????R_write "文件名:"&imgUp.filename,1
????????????R_write "擴展名:"&imgUp.extName,1
????????????R_write "保存位置:"&imgUp.DiskPath,1
????????????R_write "虛擬路徑:"&imgUp.XuPath,1
????????????R_write "保存后url:"&imgUp.NewUrl,1
????????call tform()
????????set imgUp=nothing
????????????R_write "------------------------<br>傳輸完畢",0
End SUB
SUB tform()
%>
<FORM METHOD=POST name=form2 style="margin:0px;">
獲取 URL：<INPUT TYPE="text" size=50 NAME="GetStrUrl" value="http://www.blueidea.com/img/common/logo.gif"><br>
保存路徑：<INPUT TYPE="text" size=50 NAME="SavePath" value="./"><br>
保存文件名：<INPUT TYPE="text" size=50 NAME="SaveName" value=""><br>
保存類型：
<INPUT TYPE="radio" NAME="SaveMode" value=1 <%if iSaveMode="1" or iSaveMode="" then response.write "checked" end if%>> Web圖像
<INPUT TYPE="radio" NAME="SaveMode" value=2 <%if iSaveMode="2" then response.write "checked" end if%>> 文本文件
<INPUT TYPE="radio" NAME="SaveMode" value=0 <%if iSaveMode="0" then response.write "checked" end if%>> 二進制數據
<INPUT TYPE="submit" value="確定提交">
<hr size=1>
<%
if GetStrUrl<>"" then
????if iSaveMode="2" then
????????R_write "<button name=""Previews"" title=""頁面快照"" onclick=""runCode(0);"">Run this code</button>",1
????????R_write "<textarea cols=100 name=content rows=10 style="" width:90%;fixed;word-break:break-all;"">"&server.htmlencode(imgUp.textStr)&"</textarea>",1
????else
????????R_write "<img src="""&imgUp.XuPath&"?"&timer()&""" width="&imgUp.width&" height="&imgUp.height&" alt="&imgUp.imgName&">",1
????end if
end if
%>
</FORM>
<hr size=1>
<br>如果保存為圖像，不要加擴展名，自動識別加上，如果加的擴展名不合也回自動加上
<br>保存文件路徑為空則保存在當前路徑
<br>保存文件名為空則使用自動識別取得的文件名
<br>保存為其他任意方式，對asp html 等為取得發送結果的Html
<%End SUB
Sub R_write(str,num)
????dim istr:istr=str
????dim inum:inum=num
????response.write str&"<br>"
????if inum=0 then response.end
end sub
'=================調用過程 Execute========================
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<TITLE> New Document </TITLE>
<META NAME="Generator" CONTENT="EditPlus">
<META NAME="Author" CONTENT="V37">
<META NAME="Keywords" CONTENT="">
<META NAME="Description" CONTENT="">
<SCRIPT LANGUAGE="JavaScript">
<!--
/*function runCode()
{
var code=event.srcElement.parentElement.children[0].value;
var newwin=window.open('','','');
newwin.opener = null
newwin.document.write(code);
newwin.document.close();
}
function setsmiley(what)
{
document.PostForm.comment.value += " "+what;
document.PostForm.comment.focus();
} */
????function runCode(num) //運行代碼HTML
????????{
???????? // var code=event.srcElement.parentElement.children[0].value;
???????? if(num==1){var code=window.form2.code.innerText;}
???????? if(num==0){var code=window.form2.content.innerText;}
???????? var newwin=window.open('','','');
???????? newwin.opener = null
???????? newwin.document.write(code);
???????? newwin.document.close();
????????}
//-->
</SCRIPT>
</HEAD>
<BODY>
<%
dim imgUp????????'傳輸對象
dim GetStrUrl????'要獲取的圖像或網頁URL
dim iSaveName????'要保存的名字
dim iSavePath????'要保存的虛擬路徑
dim iSaveMode????'保存的模式 1 為圖像 0 為任意文件
????iSavePath=trim(request.form("SavePath"))
????iSaveName=trim(request.form("SaveName"))
????GetStrUrl=trim(request.form("GetStrUrl"))
????iSaveMode=trim(request.form("SaveMode"))
if GetStrUrl<>"" then
????CALL saveUpload(GetStrUrl,iSavePath,iSaveName,iSaveMode)
????call tform()
else
????call tform()
end if
%>
</BODY>
</HTML>