'**************************************
' 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.yoursit
' e.com/barcode.asp?code=YourBarCode012345
' &height;=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 :-)
'
' Side Effects:none...please notify me i
' f any.
'
'This code is copyrighted and has ' limited warranties.Please see http://w
' ww.Planet-Source-Code.com/vb/scripts/Sho
' wCode.asp?txtCodeId=8383&lngWId;=4 '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
%> |
