主頁 > 知識庫 > 直接保存URL圖像或網(wǎng)頁到服務(wù)器本地的類

直接保存URL圖像或網(wǎng)頁到服務(wù)器本地的類

熱門標簽:萊西電子地圖標注 修改地圖標注 外呼系統(tǒng)API接口 金昌電話機器人價格 縣域地圖標注打印店 個人可以辦理400電話么 怎么在地圖標注自己 武夷山旅游地圖標注 鳳臺百度地圖標注店
復(fù)制代碼 代碼如下:

% @ 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數(shù)據(jù)
            fsize=clng(lenb(fdata))        '取得數(shù)據(jù)尺寸

            
            if fsize=0 then 
                exit function 
                R_write "無有效數(shù)據(jù)保存",0
            end if

            ADOS.Write fdata    
            ADOS.Position=0

            SaveName=iSaveName
            SavePath=iSavePath
            SaveMode=iSaveMode

            '寫文本對象讀取圖像長寬和類型

            ADOS.Position=0 '重置數(shù)據(jù)開始位置 
            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 p1196 then exit do else ADOS.read(binval2(ADOS.Read(2))-2)
                do:p1=binVal(ADOS.Read(1)):loop while p1255 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(SavePathSaveName)
                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>"+"傳輸圖像數(shù)據(jù)不存在,請確定你的URL是否正確"
        end if
    case else 
        chkInfo="li>無效的傳輸格式,允許圖像數(shù)據(jù)格式為 ""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 '檢查上傳圖像數(shù)據(jù)合格后,則保存之
            call tform()
            R_Write chkInfo,0
    else
        Server.ScriptTimeOut=5000
        imgUp.saveImg imgUp.DiskPath     
    end if
'-------------
            R_write "b>===處理結(jié)果部分資料===/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%>> 二進制數(shù)據(jù)
nbsp;nbsp;nbsp;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 等為取得發(fā)送結(jié)果的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

'=================調(diào)用過程 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    '要獲取的圖像或網(wǎng)頁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>

標簽:赤峰 上海 南京 清遠 通遼 楚雄 涼山 邢臺

巨人網(wǎng)絡(luò)通訊聲明:本文標題《直接保存URL圖像或網(wǎng)頁到服務(wù)器本地的類》,本文關(guān)鍵詞  直接,保存,URL,圖像,或,網(wǎng)頁,;如發(fā)現(xiàn)本文內(nèi)容存在版權(quán)問題,煩請?zhí)峁┫嚓P(guān)信息告之我們,我們將及時溝通與處理。本站內(nèi)容系統(tǒng)采集于網(wǎng)絡(luò),涉及言論、版權(quán)與本站無關(guān)。
  • 相關(guān)文章
  • 下面列出與本文章《直接保存URL圖像或網(wǎng)頁到服務(wù)器本地的類》相關(guān)的同類信息!
  • 本頁收集關(guān)于直接保存URL圖像或網(wǎng)頁到服務(wù)器本地的類的相關(guān)信息資訊供網(wǎng)民參考!
  • 推薦文章