<% Dim code, origcode, height, width, mode, caching, FontKey, FontCN10, FontCN12 caching = True ' turn this on To cache barcodes in '10101010' format. Might speed things up on busy servers, although this script doesn't take many resources to begin with. An EAN-13 or UPC barcode will take less than 100 bytes of memory space. Other types will take more or less depending on the length of the barcode created. ' DO NOT EDIT BELOW THIS LINE! code = request.querystring("code") height = request.querystring("height") width = request.querystring("width") mode = request.querystring("mode") origcode = code if Not IsNumeric(height) or height = "" Then height = 1 Else height = numeric(height) if Not IsNumeric(width) or width = "" Then width = 1 Else width = numeric(width) if caching AND application("cache" & origcode & mode & height & width) <> "" Then code = application("cache" & origcode & mode & height & width) else Select Case lcase(mode) Case "raw" ' Do nothing. non-0 chars are automatically 1s Case "code39": code = code39(code) Case "code128b": code = code128b(code) Case "upc-a": code = codeean13("0" & code, "AAAAAA") Case "ean-13": code = codeean13(code, eanflag(left(code, 1))) End Select if caching Then Application.Lock Application("cache" & origcode & mode & height & width) = code Application.UnLock End if End if function stb(String) Dim I, B For I=1 To len(String) B = B & ChrB(Asc(Mid(String,I,1))) Next stb = B End function function tstr(data, width) Dim tchar, total, tpos, i, j, x tchar = 0 total = "" tpos = 8 For i = 1 To len(data) For j = 1 To width tpos = tpos - 1 if mid(data, i, 1) <> "0" Then tchar = tchar + 2^tpos if tpos = 0 Then total = total & chr(tchar) tpos = 8 tchar = 0 End if Next Next if tpos <> 8 Then total = total & chr(tchar) End if x = len(total) mod 4 if x = 0 Then x = 4 For i = x To 3 total = total & chr(0) Next tstr = total End function function numeric(num) Dim numb, valid, i numb = "" valid = "0123456789" For i = 1 To len(num) if InStr(valid, mid(num, i, 1)) > 0 Then numb = numb & mid(num, i, 1) Next num = left(num, 30) numeric = cint(num) End function function size(lngth) lngth = cdbl(lngth) if lngth > 255 Then if lngth > 65535 Then lngth = 65535 size = chr(lngth mod 256) & chr(int(lngth/256)) Else size = chr(lngth) & chr(0) End if End function function code39(code) Dim output, i, clet output = "" code = "*" & strreplace(code, "*", "") & "*" For i = 1 To len(code) clet = "" Select Case ucase(mid(code, i, 1)) Case "1": clet = "111010001010111" Case "2": clet = "101110001010111" Case "3": clet = "111011100010101" Case "4": clet = "101000111010111" Case "5": clet = "111010001110101" Case "6": clet = "101110001110101" Case "7": clet = "101000101110111" Case "8": clet = "111010001011101" Case "9": clet = "101110001011101" Case "0": clet = "101000111011101" Case "A": clet = "111010100010111" Case "B": clet = "101110100010111" Case "C": clet = "111011101000101" Case "D": clet = "101011100010111" Case "E": clet = "111010111000101" Case "F": clet = "101110111000101" Case "G": clet = "101010001110111" Case "H": clet = "111010100011101" Case "I": clet = "101110100011101" Case "J": clet = "101011100011101" Case "K": clet = "111010101000111" Case "L": clet = "101110101000111" Case "M": clet = "111011101010001" Case "N": clet = "101011101000111" Case "O": clet = "111010111010001" Case "P": clet = "101110111010001" Case "Q": clet = "101010111000111" Case "R": clet = "111010101110001" Case "S": clet = "101110101110001" Case "T": clet = "101011101110001" Case "U": clet = "111000101010111" Case "V": clet = "100011101010111" Case "W": clet = "111000111010101" Case "X": clet = "100010111010111" Case "Y": clet = "111000101110101" Case "Z": clet = "100011101110101" Case "-": clet = "100010101110111" Case ".": clet = "111000101011101" Case " ": clet = "100011101011101" Case "*": clet = "100010111011101" Case "$": clet = "100010001000101" Case "/": clet = "100010001010001" Case "+": clet = "100010100010001" Case "%": clet = "101000100010001" End Select output = output & clet & "0" Next code39 = left(output, len(output)-1) End function function code128b(ByVal InputString) Const MinValidAscii = 32 Const MaxValidAscii = 126 Dim CharValue(255) Dim i For i = 0 To 94 CharValue(i+32) = i Next For i = 95 To 106 CharValue(i+100) = i Next ' Encode the input String InputString = Trim(InputString) Dim CheckDigitValue, CharPos, CharAscii, InvalidCharsFound InvalidCharsFound = False CheckDigitValue = CharValue(204) For CharPos = 1 To Len(InputString) CharAscii = Asc(Mid(InputString, CharPos, 1)) if (CharAscii < MinValidAscii) OR (CharAscii > MaxValidAscii) Then CharAscii = Asc("?") InvalidCharsFound = True End if CheckDigitValue = CheckDigitValue + (CharValue(CharAscii) * CharPos) Next CheckDigitValue = (CheckDigitValue Mod 103) Dim CheckDigitAscii if CheckDigitValue < 95 Then CheckDigitAscii = CheckDigitValue + 32 Else CheckDigitAscii = CheckDigitValue + 100 End if Dim OutputString OutputString = Chr(204) & InputString & Chr(CheckDigitAscii) & Chr(206) Dim BarcodePattern(255) BarcodePattern(32) = "212222" ' BarcodePattern(33) = "222122" ' ! BarcodePattern(34) = "222221" ' " BarcodePattern(35) = "121223" ' # BarcodePattern(36) = "121322" ' $ BarcodePattern(37) = "131222" ' % BarcodePattern(38) = "122213" ' & BarcodePattern(39) = "122312" ' ' BarcodePattern(40) = "132212" ' ( BarcodePattern(41) = "221213" ' ) BarcodePattern(42) = "221312" ' * BarcodePattern(43) = "231212" ' + BarcodePattern(44) = "112232" ' , BarcodePattern(45) = "122132" ' - BarcodePattern(46) = "122231" ' . BarcodePattern(47) = "113222" ' / BarcodePattern(48) = "123122" ' 0 BarcodePattern(49) = "123221" ' 1 BarcodePattern(50) = "223211" ' 2 BarcodePattern(51) = "221132" ' 3 BarcodePattern(52) = "221231" ' 4 BarcodePattern(53) = "213212" ' 5 BarcodePattern(54) = "223112" ' 6 BarcodePattern(55) = "312131" ' 7 BarcodePattern(56) = "311222" ' 8 BarcodePattern(57) = "321122" ' 9 BarcodePattern(58) = "321221" ' : BarcodePattern(59) = "312212" ' ; BarcodePattern(60) = "322112" ' < BarcodePattern(61) = "322211" ' = BarcodePattern(62) = "212123" ' > BarcodePattern(63) = "212321" ' ? BarcodePattern(64) = "232121" ' @ BarcodePattern(65) = "111323" ' A BarcodePattern(66) = "131123" ' B BarcodePattern(67) = "131321" ' C BarcodePattern(68) = "112313" ' D BarcodePattern(69) = "132113" ' E BarcodePattern(70) = "132311" ' F BarcodePattern(71) = "211313" ' G BarcodePattern(72) = "231113" ' H BarcodePattern(73) = "231311" ' I BarcodePattern(74) = "112133" ' J BarcodePattern(75) = "112331" ' K BarcodePattern(76) = "132131" ' L BarcodePattern(77) = "113123" ' M BarcodePattern(78) = "113321" ' N BarcodePattern(79) = "133121" ' O BarcodePattern(80) = "313121" ' P BarcodePattern(81) = "211331" ' Q BarcodePattern(82) = "231131" ' R BarcodePattern(83) = "213113" ' S BarcodePattern(84) = "213311" ' T BarcodePattern(85) = "213131" ' U BarcodePattern(86) = "311123" ' V BarcodePattern(87) = "311321" ' W BarcodePattern(88) = "331121" ' X BarcodePattern(89) = "312113" ' Y BarcodePattern(90) = "312311" ' Z BarcodePattern(91) = "332111" ' [ BarcodePattern(92) = "314111" ' / BarcodePattern(93) = "221411" ' ] BarcodePattern(94) = "431111" ' ^ BarcodePattern(95) = "111224" ' _ BarcodePattern(96) = "111422" ' ` BarcodePattern(97) = "121124" ' a BarcodePattern(98) = "121421" ' b BarcodePattern(99) = "141122" ' c BarcodePattern(100) = "141221" ' d BarcodePattern(101) = "112214" ' e BarcodePattern(102) = "112412" ' f BarcodePattern(103) = "122114" ' g BarcodePattern(104) = "122411" ' h BarcodePattern(105) = "142112" ' i BarcodePattern(106) = "142211" ' j BarcodePattern(107) = "241211" ' k BarcodePattern(108) = "221114" ' l BarcodePattern(109) = "413111" ' m BarcodePattern(110) = "241112" ' n BarcodePattern(111) = "134111" ' o BarcodePattern(112) = "111242" ' p BarcodePattern(113) = "121142" ' q BarcodePattern(114) = "121241" ' r BarcodePattern(115) = "114212" ' s BarcodePattern(116) = "124112" ' t BarcodePattern(117) = "124211" ' u BarcodePattern(118) = "411212" ' v BarcodePattern(119) = "421112" ' w BarcodePattern(120) = "421211" ' x BarcodePattern(121) = "212141" ' y BarcodePattern(122) = "214121" ' z BarcodePattern(123) = "412121" ' { BarcodePattern(124) = "111143" ' | BarcodePattern(125) = "111341" ' } BarcodePattern(126) = "131141" ' ~ BarcodePattern(195) = "114113" BarcodePattern(196) = "114311" BarcodePattern(197) = "411113" BarcodePattern(198) = "411311" BarcodePattern(199) = "113141" BarcodePattern(200) = "114131" BarcodePattern(201) = "311141" BarcodePattern(202) = "411131" BarcodePattern(203) = "211412" BarcodePattern(204) = "211214" BarcodePattern(205) = "211232" BarcodePattern(206) = "2331112" Dim OutputPattern, ThisPattern, thischar OutputPattern = "" For CharPos = 1 To Len(OutputString) ThisPattern = BarcodePattern(Asc(Mid(OutputString, CharPos, 1))) For i = 1 To len(ThisPattern) if i mod 2 = 1 Then thischar = "1" Else thischar = "0" OutputPattern = OutputPattern & strreplace(space(int(mid(ThisPattern, i, 1))), " ", thischar) Next Next code128b = OutputPattern End function function CodeEAN13(code, encoding) Dim leftA, leftB, rght, OutputPattern, i if len(code) = 13 Then LeftA = Array("0001101", "0011001", "0010011", "0111101", "0100011", "0110001", "0101111", "0111011", "0110111", "0001011") LeftB = Array("0100111", "0110011", "0011011", "0100001", "0011101", "0111001", "0000101", "0010001", "0001001", "0010111") Rght = Array("1110010", "1100110", "1101100", "1000010", "1011100", "1001110", "1010000", "1000100", "1001000", "1110100") OutputPattern = "101" For i = 1 To 6 if mid(ucase(encoding), i, 1) = "A" Then OutputPattern = OutputPattern & LeftA(cint(mid(code, i+1, 1))) Else OutputPattern = OutputPattern & LeftB(cint(mid(code, i+1, 1))) End if Next OutputPattern = OutputPattern & "01010" For i = 1 To 6 OutputPattern = OutputPattern & Rght(cint(mid(code, i+7, 1))) Next OutputPattern = OutputPattern & "101" CodeEAN13 = OutputPattern End if End function function eanflag(num) Select Case num Case 0: eanflag = "AAAAAA" Case 1: eanflag = "AABABB" Case 2: eanflag = "AABBAB" Case 3: eanflag = "AABBBA" Case 4: eanflag = "ABAABB" Case 5: eanflag = "ABBAAB" Case 6: eanflag = "ABBBAA" Case 7: eanflag = "ABABAB" Case 8: eanflag = "ABABBA" Case 9: eanflag = "ABBABA" End Select End function Dim dataout, i if code <> "" Then dataout = tstr(code, width) response.binarywrite stb(chr(66) & chr(77) & size(62+(len(dataout)*height)) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(62) & chr(0) & chr(0) & chr(0) & chr(40) & chr(0) & chr(0) & chr(0) & size(len(code)*width) & chr(0) & chr(0) & size(height) & chr(0) & chr(0) & chr(1) & chr(0) & chr(1) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(37) & chr(14) & chr(0) & chr(0) & chr(37) & chr(14) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(255) & chr(255) & chr(255) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0)) For i = 1 To height response.binarywrite stb(dataout) Next End if %>