DefiniteUrl asp将相对地址转换为绝对地址的代码_应用技巧

'==================================================
'函数名：DefiniteUrl
'作  用：将相对地址转换为绝对地址
'参  数：PrimitiveUrl ------要转换的相对地址
'参  数：ConsultUrl ------当前网页地址
'==================================================
Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
   Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray
   If PrimitiveUrl="" or ConsultUrl="" or PrimitiveUrl="$False$" or ConsultUrl="$False$" Then
      DefiniteUrl="$False$"
      Exit Function
   End If
   If Left(Lcase(ConsultUrl),7)<>"http://" Then
      ConsultUrl= "http://" & ConsultUrl
   End If
   ConsultUrl=Replace(ConsultUrl,"\","/")
   ConsultUrl=Replace(ConsultUrl,"://",":\\")
   PrimitiveUrl=Replace(PrimitiveUrl,"\","/")

   If Right(ConsultUrl,1)<>"/" Then
      If Instr(ConsultUrl,"/")>0 Then
         If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then   
         Else
            ConsultUrl=ConsultUrl & "/"
         End If
      Else
         ConsultUrl=ConsultUrl & "/"
      End If
   End If
   ConArray=Split(ConsultUrl,"/")

   If Left(LCase(PrimitiveUrl),7) = "http://" then
      DefiniteUrl=Replace(PrimitiveUrl,"://",":\\")
   ElseIf Left(PrimitiveUrl,1) = "/" Then
      DefiniteUrl=ConArray(0) & PrimitiveUrl
   ElseIf Left(PrimitiveUrl,2)="./" Then
      PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-2)
      If Right(ConsultUrl,1)="/" Then   
         DefiniteUrl=ConsultUrl & PrimitiveUrl
      Else
         DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
      End If
   ElseIf Left(PrimitiveUrl,3)="../" then
      Do While Left(PrimitiveUrl,3)="../"
         PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
         Pi=Pi+1
      Loop            
      For Ci=0 to (Ubound(ConArray)-1-Pi)
         If DefiniteUrl<>"" Then
            DefiniteUrl=DefiniteUrl & "/" & ConArray(Ci)
         Else
            DefiniteUrl=ConArray(Ci)
         End If
      Next
      DefiniteUrl=DefiniteUrl & "/" & PrimitiveUrl
   Else
      If Instr(PrimitiveUrl,"/")>0 Then
         PriArray=Split(PrimitiveUrl,"/")
         If Instr(PriArray(0),".")>0 Then
            If Right(PrimitiveUrl,1)="/" Then
               DefiniteUrl="http:\\" & PrimitiveUrl
            Else
               If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then 
                  DefiniteUrl="http:\\" & PrimitiveUrl
               Else
                  DefiniteUrl="http:\\" & PrimitiveUrl & "/"
               End If
            End If      
         Else
            If Right(ConsultUrl,1)="/" Then   
               DefiniteUrl=ConsultUrl & PrimitiveUrl
            Else
               DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
            End If
         End If
      Else
         If Instr(PrimitiveUrl,".")>0 Then
            If Right(ConsultUrl,1)="/" Then
               If right(LCase(PrimitiveUrl),3)=".cn" or right(LCase(PrimitiveUrl),3)="com" or right(LCase(PrimitiveUrl),3)="net" or right(LCase(PrimitiveUrl),3)="org" Then
                  DefiniteUrl="http:\\" & PrimitiveUrl & "/"
               Else
                  DefiniteUrl=ConsultUrl & PrimitiveUrl
               End If
            Else
               If right(LCase(PrimitiveUrl),3)=".cn" or right(LCase(PrimitiveUrl),3)="com" or right(LCase(PrimitiveUrl),3)="net" or right(LCase(PrimitiveUrl),3)="org" Then
                  DefiniteUrl="http:\\" & PrimitiveUrl & "/"
               Else
                  DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl
               End If
            End If
         Else
            If Right(ConsultUrl,1)="/" Then
               DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"
            Else
               DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"
            End If         
         End If
      End If
   End If
   If Left(DefiniteUrl,1)="/" then
     DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
   End if
   If DefiniteUrl<>"" Then
      DefiniteUrl=Replace(DefiniteUrl,"//","/")
      DefiniteUrl=Replace(DefiniteUrl,":\\","://")
   Else
      DefiniteUrl="$False$"
   End If
End Function

时间： 2024-10-03 19:09:33

DefiniteUrl asp将相对地址转换为绝对地址的代码_应用技巧的相关文章

DefiniteUrl asp将相对地址转换为绝对地址的代码

'================================================== '函数名:DefiniteUrl '作  用:将相对地址转换为绝对地址 '参  数:PrimitiveUrl ------要转换的相对地址 '参  数:ConsultUrl ------当前网页地址 '================================================== Function DefiniteUrl(Byval PrimitiveUrl,Byval 

FormatRemoteUrl函数之asp实现格式化成当前网站完整的URL-将相对地址转换为绝对地址的代码_应用技巧

'================================================ '函数名:FormatRemoteUrl '作  用:格式化成当前网站完整的URL-将相对地址转换为绝对地址 '参  数: url ----Url字符串 '参  数: CurrentUrl ----当然网站URL '返回值:格式化取后的Url '================================================     Public Function FormatRe

JavaScript将相对地址转换为绝对地址示例代码

本文为大家详细介绍下JavaScript怎么将相对地址转换为绝对地址,具体的示例如下,感兴趣的朋友可以参考下哈,希望对大家有所帮助   在看LABjs源代码时,发现里面有个将相对地址转为绝对地址的函数,将其拿出纪录如下: 复制代码 代码如下: function canonical_uri(src, base_path) { var root_page = /^[^?#]*//.exec(location.href)[0], root_domain = /^w+:///?[^/]+/.exec(r

JavaScript将相对地址转换为绝对地址示例代码_javascript技巧

在看LABjs源代码时,发现里面有个将相对地址转为绝对地址的函数,将其拿出纪录如下: 复制代码 代码如下: function canonical_uri(src, base_path) { var root_page = /^[^?#]*\//.exec(location.href)[0], root_domain = /^\w+\:\/\/\/?[^\/]+/.exec(root_page)[0], absolute_regex = /^\w+\:\/\//; // is `src` is p

asp.net导出EXCEL的功能代码_实用技巧

复制代码 代码如下: //由gridviw导出为Excel public static void ToExcel(System.Web.UI.Control ctl) { HttpContext.Current.Response.AppendHeader("Content-Disposition", "attachment;filename=Excel.xls"); HttpContext.Current.Response.Charset = "UTF-8

ASP 三层架构 Convert类实现代码_应用技巧

这个类主要解决在类型转换时,如果直接使用类型转换函数,会因为变量为空或者格式不对而导致程序报错,而这种报错在大多数情况下是允许的.例如要转换一个字符串变量为数字,如果变量为空,则一般需要自动返回0. 另外一个重要功能就是封装变量格式化操作,可以保持整个网站的输出格式统一,例如时间格式,货币格式等等. 日期和货币格式化的时候,极易遇到因空值报错的情况,一般都不得不写个预判断空值的逻辑,再格式化变量. 使用这个类负责类型转换和格式化输出后,就不用操心这些琐碎的细节了,可以让编程的心情得到大大改善啊.

asp 通用修改和增加函数代码_应用技巧

接下来我利用一点空余时间发一个函数里面包含和添加和删除功能.实验的架构可以使用IIS.5WEB服务器ACCESS数据库.这个我其实不用说的很详细了,因为大家都应该知道的.我就直接把函数贴出来.大家只要稍微修改即可使用. 复制代码 代码如下: <% sub AdminEdit() dim Action,rsCheckAdd,rs,sql Action=request.QueryString("Action") if Action="SaveEdit" then

asp.net保存远程图片的代码_实用技巧

注意:并没有实现CSS中的图片采集,且图片的正则还有待完善. 复制代码 代码如下: using System; using System.Data; using System.Configuration; using System.Web; using System.Web.Security; using System.Web.UI; using System.Web.UI.WebControls; using System.Web.UI.WebControls.WebParts; using

ASP+ajax注册即时提示程序代码_应用技巧

1.注册时验证数据库用户名是否存在. 2.输入密码时提示密码强度和验证2次密码输入是否一样. 3.注册时验证数据库联系邮箱是否存在. 4.注册时验证用户输入的验证码和系统产生的验证码是否一致. 5.对输入中文验证 6.QQ号码验证 7.身份证号码验证 复制代码 代码如下: <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtm