条形码：EAN13

<%
Dim arrMobile(1)
 
arrMobile(1) = "613926666677"
 

Call ean13(FomratEanCode(arrMobile(1)),2,100)
 
'生成条码
Function EAN13(code,w,h)
        Dim Guide,Dict,Lencode,Rencode,cStart,cMid,cEnd,Barcode,Lmethod
        Dim i
        Guide = array("AAAAAA","AABABB","AABBAB","ABAABB","ABBAAB","ABBBAA","ABABAB","ABABBA","ABBABA")
 
        Set Dict = CreateObject("Scripting.Dictionary")
        Dict.Add "A", "0001101001100100100110111101010001101100010101111011101101101110001011"
        Dict.Add "B", "0100111011001100110110100001001110101110010000101001000100010010010111"
 
        Rencode = array("1110010","1100110","1101100","1000010","1011100","1001110","1010000","1000100","1001000","1110100")
 
        cStart="101"
        cMid="01010"
        cEnd="101"
 
        if w<2 then w=2
        if h<20 then h=20
        cWidth=w        '条码单元宽度
        cHeight=h        '条码高度
 
        '转换条码
        Barcode=cStart
        Lmethod=left(code,1)
        'if Lmethod=0 then Lmethod=1
        for i=2 to 7
                barcode = barcode & mid(Dict(Mid(Guide(Lmethod-1),i-1,1)),(7*mid(code,i,1)+1),7)
        next
        barcode=barcode & cMid
        for i=8 to 13
                barcode = barcode & Rencode(mid(code,i,1))
        next
        barcode=barcode & cEnd
 

        fg="#000000"        '条码前景色
        bg="#ffffff"        '条码背景色
        response.write "<div style='position:absolute;width:"&cWidth*95+60&"px; height:"&cHeight+30&"px; background:"&bg&";'>"
        '绘制条码
        for x=1 to len(barcode)
                if x<5 or x>92 or (x>46 and x<51)then
                        sh=10
                else
                        sh=0
                end if
 
                if mid(barcode,x,1)="1" then
                        bColor=fg
                else
                        bColor=bg
                end if
 
                response.write "<div style='position:absolute;left:"&(x-1)*cWidth+30&"px;top:5px;width:"&cWidth&"px;height:"&cHeight+5+sh&"px;background:"&bColor&";'></div>"
        next
        '加入可读数字标签
        response.write "<div style='position:absolute;left:16px;top:"&cHeight+10&"px;background:"&bg&";color:"&fg&";font:12px Verdana;'>"&left(code,1)&"</div>"
        for x=1 to 6
                response.write "<div style='position:absolute;left:"&(x*7+2)*cWidth+22&"px;top:"&cHeight+10&"px;background:"&bg&";color:"&fg&";font:12px Verdana;'>"&mid(code,x+1,1)&"</div>"
                response.write "<div style='position:absolute;left:"&(x*7+47)*cWidth+24&"px;top:"&cHeight+10&"px;background:"&bg&";color:"&fg&";font:12px Verdana;'>"&mid(code,x+7,1)&"</div>"
        next
        response.write "</div>"
End Function
'格式化条形码，为12位
Function FomratEanCode(str)
        Dim strZero:strZero = "0000000000000000000"
        Dim i,k,int1,int2,iX,strTemp,iT
        str = str & strZero
        str = Left(str,12)
        '计算奇偶
        k = 1
        int1 = 0
        int2 = 0
        For i = Len(str) To 1 Step -1
                iT = CInt(Mid(str,i,1))
                if k Mod 2 = 1 Then
                        int1 = int1 + iT
                Else
                        int2 = int2 + iT
                End if
                k = k + 1
        Next
        iX = int1 * 3 + int2
 
        '求模的补
        iX = 10 - (iX Mod 10)
        strTemp = str & iX
        FomratEanCode = strTemp
End Function
%>