UNKNOWN '************************************** ' Name: Pure ASP Barcode Generator ' Description:This script generates a .b ' mp barcode from scratch with no COM+ obj ' ect required. Supports only a few types, ' but the common ones (UPC-A, code128b, co ' de39, EAN-13). ' By: Mark Kahn ' ' ' Inputs:<img src="http://www.yoursite.c ' om/barcode.asp?code=YourBarCode012345&he ' ight=20&width=1&mode=code39"> code = bar code value height = height of barcode in pixels. width = width MULTIPLIER in pixels. mode = type of barcode (Currently supported barcode types: code39, code128b, UPC-A, EAN-13) ' ' Returns:a barcode :-) ' 'Assumes:None ' 'Side Effects:none...please notify me if ' any. 'This code is copyrighted and has limite ' d warranties. 'Please see http://www.Planet-Source-Cod ' e.com/xq/ASP/txtCodeId.8383/lngWId.4/qx/ ' vb/scripts/ShowCode.htm 'for details. '************************************** <% OPTION EXPLICIT response.contenttype = "image/bmp" 'img src="http://www.yoursite.com/barcod ' e.asp?code=YourBarCode012345&height;=20&w; ' idth=1&mode;=code39" ' ' code = bar code value ' height = height of barcode in pixels. ' width = width MULTIPLIER in pixels. ' mode = type of barcode (Currently supp ' orted barcode types: code39, code128b, U ' PC-A, EAN-13) ' ' NOTE: If you prefer, you can also set ' the mode to 'raw' and create the barcode ' yourself by setting the code to 1s and 0 ' s representing the barcode, ie: 11001100 ' 001010... In this case, 1s are black, 0s ' are white. ' ' NOTE: Maximum width & height values ar ' e 65536 pixels. Values larger than this ' will cause errors in the bmp file. This ' is a limitation of the bmp file format ( ' why would you WANT an barcode this large ' anyway?) ' ' Additional code types are very easy to ' implement. ' ' Images generated are very small. For i ' nstance, an ean-13 barcode at a height o ' f 50 pixels is a mere 662 bytes (less th ' an 1kb). The largest realistic barcodes ' I've generated were less than 2kb. ' ' I added support for code caching. Note ' that the image is NOT cached, only the f ' inal set of 1s and 0s that represent the ' bars. ' ' If anyone adds additional codes, pleas ' e send me the source, thanks :-) ' cwolves@cwolves.com 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 = "*" & replace(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" ' <space> 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 & replace(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 %>