'**************************************
' 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
'
[email protected]
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