微博短网址(ShortUrl)算法详解

PHP 2013年06月16日 , , ,

各大微博短网址(ShortUrl)的PHP版算法,模拟包含了网上的这两种算法:
1.为java版或c#版算法 2.为php算法
代码封装成了一个类了,集成于AspBox开源框架核心ab.url.asp中,具体请看代码:
双击代码进行复制

<%
'######################################################################
'## ab.url.asp
'## -------------------------------------------------------------------
'## Feature     :   AspBox Url Block (Plugin) @Single-Page-Version
'## Version     :   v1.0.0
'## Author      :   Furzoom(furzoommn@gmail.com)
'## Update Date :   2012/06/15 10:10 (Single-Page)
'## Description :   AspBox Url Block (Plugin).
'######################################################################

Class Cls_AB_URL

    Private s_prefix, s_suffix '用于短网址生成的混合KEY, 分别是:前缀 和 后缀
    Private s_by '用于短网址生成的指定算法
    Private m_lPower2(31)

    Private Sub Class_Initialize()
        s_prefix = ""
        s_suffix = ""
        s_by = ""
    End Sub

    Private Sub Class_Terminate()

    End Sub

    '@ ******************************************************************
    '@ 属性值:  oUrl.By [= s]  可读/写
    '@ 返  回:  String (字符串) "0" 或 "1"
    '@ 作  用:  设置/获取 用于短网址生成的指定算法
    '@  注:By值的默认值缺省为"0"(即采用java版或c#版算法)
    '==DESC=============================================================
    '@ 参数 s(可选): String (字符串) 用于短网址生成的指定算法,
    '@  值为 "", "0", "java", "c#", "csharp", "c" 这些值时,则算法By值自动转化为:"0"
    '@  值为 "1", "php" 这些值时,则算法By值自动转化为:"1"
    '==DEMO=============================================================
    '@ Dim oUrl : Set oUrl = New Cls_AB_URL
    '@ oUrl.By = "java" '采用java版(或c#)
    '@ Response.Write oUrl.By 'java版(或c#)对应的By值为"0"
    '@ *****************************************************************

    Public Property Get By()
        s_by = LCase(s_by)
        Select Case LCase(s_by)
            Case "","0","java","c#","csharp","c" : s_by = "0"
            Case "1","php" : s_by = "1"
            Case Else : s_by = "0"
        End Select
        By = s_by
    End Property

    Public Property Let By(byval s)
        If IsNull(s) Or trim(s)="" Then s = "0"
        Select Case LCase(Trim(s))
            Case "0","java","c#","csharp","c","" : s_by = "0"
            Case "1","php" : s_by = "1"
            Case Else : s_by = "0"
        End Select
    End Property

    '--------------------------------------------------------------------
    '# oUrl.Prefix 属性
    '# @syntax: oUrl.Prefix
    '# @return: String (字符串) 获取设置的用于短网址生成的混合前缀
    '# @dowhat: 设置和获取用于短网址生成的混合前缀,默认值""
    '--DESC--------------------------------------------------------------
    '# @param: 无参数
    '--DEMO--------------------------------------------------------------
    '@ Dim oUrl : Set oUrl = New Cls_AB_URL
    '# oUrl.Prefix = "Lajox"
    '--------------------------------------------------------------------

    Public Property Let Prefix(ByVal p)
        s_prefix = p
    End Property
    Public Property Get Prefix()
        Prefix = s_prefix
    End Property

    '--------------------------------------------------------------------
    '# oUrl.Suffix 属性
    '# @syntax: oUrl.Suffix
    '# @return: String (字符串) 获取设置的用于短网址生成的混合后缀
    '# @dowhat: 设置和获取用于短网址生成的混合后缀,默认值""
    '--DESC--------------------------------------------------------------
    '# @param: 无参数
    '--DEMO--------------------------------------------------------------
    '@ Dim oUrl : Set oUrl = New Cls_AB_URL
    '# oUrl.Suffix = "Nasrick"
    '--------------------------------------------------------------------

    Public Property Let Suffix(ByVal p)
        s_suffix = p
    End Property
    Public Property Get Suffix()
        Suffix = s_suffix
    End Property

    '-------------------------------------------------------------------
    '# oUrl.ShortUrl 方法
    '# @syntax: arrUrl = oUrl.ShortUrl(url)
    '# @return: Array (数组) 数组含有4个元素,各元素均包含6位串
    '# @dowhat: 实现短网址生成的算法
    '# 1.java版或c#版算法(此算法为缺省算法)
    '#   原理采用各大微博短网址(ShortUrl)的java版或c#版算法
    '#   返回值数组含有4个元素,各元素均包含6位串
    '# 2.php版算法
    '#   原理采用各大微博短网址(ShortUrl)的php版算法
    '#   返回值数组含有4个元素,各元素均包含6位串
    '#   思路:
    '#   a.将长网址md5生成32位签名串,分为4段, 每段8个字节;
    '#   b.对这四段循环处理, 取8个字节, 将他看成16进制串与0x3fffffff(30位1)与操作, 即超过30位的忽略处理;
    '#   c.这30位分成6段, 每5位的数字作为字母表的索引取得特定字符, 依次进行获得6位字符串;
    '#   d.总的md5串可以获得4个6位串; 取里面的任意一个就可作为这个长url的短url地址;
    '# 注:数组的4个元素包含6位串,取里面的任意一个就可作为这个长url的短url地址
    '# @author: Lajox (2012-06-14 9:25)
    '--DESC--------------------------------------------------------------
    '# @param url: String (字符串) 原网址URL
    '--DEMO--------------------------------------------------------------
    '# Dim oUrl : Set oUrl = New Cls_AB_URL
    '# dim urls
    '# '_______(JAVA或C#版算法的实现)_______________
    '# oUrl.prefix = "Leejor" '设置用于短网址生成的混合前缀
    '# oUrl.suffix = "" '设置用于短网址生成的混合后缀
    '# oUrl.by = "java" '算法采用java或c#算法(by值缺省为java)
    '# urls = oUrl.shorturl("http://furzoom.com")
    '# 'urls = oUrl.shorturl_java("http://furzoom.com")
    '# Response.Write "
" & urls(0) '得到值 fAVfui
    '# Response.Write "
" & urls(1) '得到值 3ayQry
    '# Response.Write "
" & urls(2) '得到值 UZzyUr
    '# Response.Write "
" & urls(3) '得到值 36rQZn
    '# '_______(php版算法的实现)_______________
    '# oUrl.prefix = "" '设置用于短网址生成的混合前缀
    '# oUrl.suffix = "" '设置用于短网址生成的混合后缀
    '# oUrl.by = "php" '指定算法采用php版算法
    '# urls = oUrl.shorturl("http://furzoom.com")
    '# 'urls = oUrl.shorturl_php("http://furzoom.com")
    '# Response.Write "
" & urls(0) '得到值 cvch1h
    '# Response.Write "
" & urls(1) '得到值 ssjfdx
    '# Response.Write "
" & urls(2) '得到值 zzpkdh
    '# Response.Write "
" & urls(3) '得到值 mbstyx
    '-------------------------------------------------------------------

    Public Function ShortUrl(Byval url)
        Dim Result
        s_by = LCase(Trim(Me.By))
        If s_by="" Or s_by="0" Or s_by="java" Or s_by="c#" Or s_by="csharp" Or s_by="c" Then
            Result = ShortUrl_Java(url)
        ElseIf s_by = "1" Or s_by = "php" Then
            Result = ShortUrl_PHP(url)
        Else
            Result = ShortUrl_Java(url)
        End If
        ShortUrl = Result
    End Function

    Public Function ShortUrl_Java(Byval url) 'java或c#版ShortUrl算法
        Dim chars, Hex, subHex, Result
        chars = Array("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z","0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z")
        Hex = LCase(Md5(s_prefix & url & s_suffix)) '32位Md5
        Result = Array()
        Dim hexint, index, out, i, j
        For i = 0 To 3
            subHex = Mid(Hex, (i * 8) + 1, 8)
            Dim temp : temp = Eval("&H" & subHex)
            hexint = &H3FFFFFFF And (1 * temp)
            out = ""
            For j = 0 To 5
                index = Cint(&H0000003D And hexint)
                out = out & chars(index)
                'hexint = hexint \ 2^5 '按位右移5位
                hexint = RShift(hexint,5) '按位右移5位
            Next
            Result = Push(Result, out)
        Next
        ShortUrl_Java = Result
    End Function

    Public Function ShortUrl_PHP(Byval url) 'php版ShortUrl算法
        Dim base32, Hex, hexLen, subHexLen, subHex, Result
        base32 = Array("a", "b", "c", "d", "e", "f", "g", "h","i", "j", "k", "l", "m", "n", "o", "p","q", "r", "s", "t", "u", "v", "w", "x","y", "z", "0", "1", "2", "3", "4", "5")
        Hex = LCase(Md5(s_prefix & url & s_suffix)) '32位Md5
        hexLen = Len(Hex)
        subHexLen = hexLen / 8
        Result = Array()
        Dim hexint, index, out, i, j
        For i = 0 To subHexLen-1
            subHex = Mid(Hex, (i * 8) + 1, 8)
            Dim temp : temp = Eval("&H" & subHex)
            hexint = &H3FFFFFFF And (1 * temp)
            out = ""
            For j = 0 To 5
                index = &H0000001F And hexint
                ''Response.Write(index & "
")
                out = out & base32(index)
                'hexint = hexint \ 2^5 '按位右移5位
                hexint = RShift(hexint,5) '按位右移5位
            Next
            Result = Push(Result, out)
        Next
        ShortUrl_PHP = Result
    End Function

    Private Function Push(ByVal arr, ByVal s) '向数组中从后压入元素
        Dim i, a : a = Clone(arr)
        If arrLen(arr)<=0 Then : Redim Preserve a(0): a(0) = s: Push = a: Exit Function: End If
        Redim Preserve a(UBound(arr)+1)
        a(UBound(arr)+1) = s
        Push = a
    End Function

    Private Function Clone(ByVal arr) '数组克隆(拷贝)
        Dim i, a()
        If arrLen(arr)<=0 Then : Clone = arr: Exit Function: End If
        For i = LBound(arr) To UBound(arr)
            Redim Preserve a(i)
            a(i) = arr(i)
        Next
        Clone = a
    End Function

    Private Function arrLen(Byval arr) '检测(一维)数组长度(元素个数)
        On Error Resume Next
        If Not IsArray(arr) Then:arrLen=-1:End If
        Dim temp:temp=Ubound(arr)
        If Err Or temp        Dim i,iCount:iCount=0
        For i=Lbound(arr) To Ubound(arr)
            iCount = iCount + 1
        Next
        arrLen = iCount
        On Error GoTo 0
    End Function

    Private Function LShift(ByVal lThis, ByVal lBits) '向左移位(移位运算)
        On Error Resume Next
        Init()
        If (lBits <= 0) Then             LShift = lThis         ElseIf (lBits > 63) Then
            ' .. error ...
        ElseIf (lBits > 31) Then
            LShift = 0
        Else
            If (lThis And m_lPower2(31 - lBits)) = m_lPower2(31 - lBits) Then
                LShift = (lThis And (m_lPower2(31 - lBits) - 1)) * m_lPower2(lBits) Or m_lPower2(31)
            Else
                LShift = (lThis And (m_lPower2(31 - lBits) - 1)) * m_lPower2(lBits)
            End If
        End If
        On Error Goto 0
    End Function

    Private Function RShift(ByVal lThis, ByVal lBits) '向右移位(移位运算)
        On Error Resume Next
        Init()
        If (lBits <= 0) Then             RShift = lThis         ElseIf (lBits > 63) Then
            ' ... error ...
        ElseIf (lBits > 31) Then
            RShift = 0
        Else
            If (lThis And m_lPower2(31)) = m_lPower2(31) Then
                RShift = (lThis And &H7FFFFFFF) \ m_lPower2(lBits) Or m_lPower2(31 - lBits)
            Else
                RShift = lThis \ m_lPower2(lBits)
            End If
        End If
        On Error Goto 0
    End Function

    Private Sub Init()
        On Error Resume Next
        m_lPower2(0) = &H1&
        m_lPower2(1) = &H2&
        m_lPower2(2) = &H4&
        m_lPower2(3) = &H8&
        m_lPower2(4) = &H10&
        m_lPower2(5) = &H20&
        m_lPower2(6) = &H40&
        m_lPower2(7) = &H80&
        m_lPower2(8) = &H100&
        m_lPower2(9) = &H200&
        m_lPower2(10) = &H400&
        m_lPower2(11) = &H800&
        m_lPower2(12) = &H1000&
        m_lPower2(13) = &H2000&
        m_lPower2(14) = &H4000&
        m_lPower2(15) = &H8000&
        m_lPower2(16) = &H10000
        m_lPower2(17) = &H20000
        m_lPower2(18) = &H40000
        m_lPower2(19) = &H80000
        m_lPower2(20) = &H100000
        m_lPower2(21) = &H200000
        m_lPower2(22) = &H400000
        m_lPower2(23) = &H800000
        m_lPower2(24) = &H1000000
        m_lPower2(25) = &H2000000
        m_lPower2(26) = &H4000000
        m_lPower2(27) = &H8000000
        m_lPower2(28) = &H10000000
        m_lPower2(29) = &H20000000
        m_lPower2(30) = &H40000000
        m_lPower2(31) = &H80000000
        On Error Goto 0
    End Sub

End Class
%>

如无特别说明,本站文章皆为原创,若要转载,务必请注明以下原文信息:
日志标题:《微博短网址(ShortUrl)算法详解》
日志链接:http://furzoom.com/short-url/
博客名称:枫竹梦

发表评论

插入图片

NOTICE1:请申请gravatar头像,没有头像的评论可能不会被回复!

回到顶部