1. 论坛系统升级为Xenforo,欢迎大家测试!
    排除公告

远程引用163网易相册的代码【ASP+PHP】

本帖由 小叶2006-04-14 发布。版面名称:后端开发

  1. 小叶

    小叶 New Member

    注册:
    2005-09-04
    帖子:
    17,941
    赞:
    33
    使用方法:

    例如你的163相册里有张图片地址是 http://img306.photo.163.com/t9913085/38410833/1041527229.jpg
    如果直接在其他网站或者论坛的贴图框框的地址里填http://img306.photo.163.com/t9913085/38410833/1041527229.jpg 这样发出来,肯定显示红叉叉
    但只要在图片地址前面加上 http://程序URL/showpic.asp?url=

    即,贴图图片的地址中填 http://程序URL/showpic.asp?url=http://img306.photo.163.com/t9913085/38410833/1041527229.jpg

    OK 大功告成,你的网易相册中的图片就可以显示在其他网站了

    注:php版的使用方法也类似:在图片地址前面加上 http://程序URL/getimg.php?url=
     

    附件文件:

  2. 小叶

    小叶 New Member

    注册:
    2005-09-04
    帖子:
    17,941
    赞:
    33
    PHP:
    <%@ codepage=65001%>

    <%

    Response.Buffer=False

    re_url 
    Lcase(Request.ServerVariables("HTTP_REFERER"))

    '获得来源页面的url

    mydomain = Lcase(Request.ServerVariables("SERVER_NAME"))

    '
    获得本页面域名 也可以直接指定

    if mid(re_url,8,len(mydoain)) <> mydomian then

    response
    .write "URL wrong"

    'or redirect

    response.end()

    end if





    dim file_url

    file_url=request.querystring("imgsrc")

    Set objXMLHTTP = Server.CreateObject("Msxml2.ServerXMLHTTP")

    objXmlHttp.open "GET",file_url,false

    objXmlHttp.send()

    Response.ContentType = "image/jepg"

    Response.BinaryWrite objXMLHTTP.responseBody

    set objXMLHTTP=nothing

    %> 
     
  3. 老林

    老林 New Member

    注册:
    2005-09-06
    帖子:
    10,580
    赞:
    36
  4. 小叶

    小叶 New Member

    注册:
    2005-09-04
    帖子:
    17,941
    赞:
    33
    附件中的缓存控制的不错。

    PHP:
    <%
    Dim urlbodymyCache

    url 
    Request.QueryString("url")

      
    Set myCache = new cache
      myCache
    .name "picindex"&url
      
    If myCache.valid Then
              body 
    myCache.value
      
    Else
              
    body GetWebData(url)
              
    myCache.add body,dateadd("d",1,now)
      
    End If

      If 
    Err.Number 0 Then
            Response
    .CharSet "UTF-8"
            
    Response.ContentType "application/octet-stream"
            
    Response.BinaryWrite body
            Response
    .Flush
      
    Else
            
    Wscript.Echo Err.Description
      End 
    if

    '取得数据
    Public Function GetWebData(ByVal strUrl)
    Dim curlpath
    curlpath = Mid(strUrl,1,Instr(8,strUrl,"/"))
    Dim Retrieval
    Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
    With Retrieval
    .Open "Get", strUrl, False,"",""
    .setRequestHeader "Referer", curlpath
    .Send
    GetWebData =.ResponseBody
    End With
    Set Retrieval = Nothing
    End Function


    '
    cache类

    class Cache
            
    private obj                                'cache内容
            private expireTime                '
    过期时间
            
    private expireTimeName        '过期时间application名
            private cacheName                '
    cache内容application名
            
    private path                        'url
            
            private sub class_initialize()
                    path=request.servervariables("url")
                    path=left(path,instrRev(path,"/"))
            end sub
            
            private sub class_terminate()
            end sub
            
            public property get blEmpty
                    '
    是否为空
                    
    if isempty(objthen
                            blEmpty
    =true
                    
    else
                            
    blEmpty=false
                    end 
    if
            
    end property
            
            
    public property get valid
                    
    '是否可用(过期)
                    if isempty(obj) or not isDate(expireTime) then
                            valid=false
                    elseif CDate(expireTime)<now then
                                    valid=false
                    else
                            valid=true
                    end if
            end property
            
            public property let name(str)
                    '
    设置cache名
                    cacheName
    =str path
                    obj
    =application(cacheName)
                    
    expireTimeName=str "expires" path
                    expireTime
    =application(expireTimeName)
            
    end property
            
            
    public property let expires(tm)
                    
    '重设置过期时间
                    expireTime=tm
                    application.lock
                    application(expireTimeName)=expireTime
                    application.unlock
            end property
            
            public sub add(var,expire)
                    '
    赋值
                    
    if isempty(var) or not isDate(expirethen
                            
    exit sub
                    end 
    if
                    
    obj=var
                    
    expireTime=expire
                    application
    .lock
                    application
    (cacheName)=obj
                    application
    (expireTimeName)=expireTime
                    application
    .unlock
            end sub
            
            
    public property get value
                    
    '取值
                    if isempty(obj) or not isDate(expireTime) then
                            value=null
                    elseif CDate(expireTime)<now then
                            value=null
                    else
                            value=obj
                    end if
            end property
            
            public sub makeEmpty()
                    '
    释放application
                    application
    .lock
                    application
    (cacheName)=empty
                    
    application(expireTimeName)=empty
                    
    application.unlock
                    obj
    =empty
                    
    expireTime=empty
            
    end sub
            
            
    public function equal(var2)
                    
    '比较
                    if typename(obj)<>typename(var2) then
                            equal=false
                    elseif typename(obj)="Object" then
                            if obj is var2 then
                                    equal=true
                            else
                                    equal=false
                            end if
                    elseif typename(obj)="Variant()" then
                            if join(obj,"^")=join(var2,"^") then
                                    equal=true
                            else
                                    equal=false
                            end if
                    else
                            if obj=var2 then
                                    equal=true
                            else
                                    equal=false
                            end if
                    end if
            end function
    end class
    %>
     
  5. hopol

    hopol New Member

    注册:
    2005-09-26
    帖子:
    148
    赞:
    2
    :ghost: :ghost: :ghost: :ghost: :ghost:

    $text=substr($Content,$pos+4);
    header($head);
    echo $text;

    最后的 header($head); 不觉得多余了吗?? 呵呵

    难道没有人在 运行的时候报错 (WIN 下不报错 FREEBSD 下看看 )

    :ghost: :ghost: :ghost: :ghost: :ghost:
     
    #5 hopol, 2006-04-14
    最后编辑: 2006-04-14
  6. comic

    comic New Member

    注册:
    2006-03-05
    帖子:
    302
    赞:
    2
    在新视听早看过,只是以为163快完了哈哈