Login
Important alert: (current site time 7/15/2013 11:43:30 PM EDT)
 

VB icon

Pure ASP Barcode Generator

 Email
Submitted on: 5/29/2003 11:21:34 PM
By: Mark Kahn  
Level: Advanced
User Rating: By 17 Users
Compatibility: ASP (Active Server Pages)
Views: 48546
(About the author)
 
     This script generates a .bmp barcode from scratch with no COM+ object required. Supports only a few types, but the common ones (UPC-A, code128b, code39, EAN-13).
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
 
Terms of Agreement:   
By using this code, you agree to the following terms...   
  1. You may use this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
  2. You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
  3. You may link to this code from another website, but ONLY if it is not wrapped in a frame. 
  4. You will abide by any additional copyright restrictions which the author may have placed in the code or code's description. 
				
'**************************************
' Name: Pure ASP Barcode Generator
' Description:This script generates a .bmp barcode from scratch with no COM+ object required. Supports only a few types, but the common ones (UPC-A, code128b, code39, EAN-13).
' By: Mark Kahn
'
' Inputs:<img src="http://www.yoursite.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 if any.
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=8383&lngWId=4'for details.'**************************************

<%
OPTION EXPLICIT
response.contenttype	=	"image/bmp"
'img src="http://www.yoursite.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)
' 
' NOTE: If you prefer, you can also set the mode to 'raw' and create the barcode yourself by setting the code to 1s and 0s representing the barcode, ie: 11001100001010... In this case, 1s are black, 0s are white.
'
' NOTE: Maximum width & height values are 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 instance, an ean-13 barcode at a height of 50 pixels is a mere 662 bytes (less than 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 final set of 1s and 0s that represent the bars.
'
' If anyone adds additional codes, please 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
%>


Other 19 submission(s) by this author

 
Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:
Your Vote

What do you think of this code (in the Advanced category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 
Other User Comments

5/30/2003 5:55:08 AM: 

Excellent, just plain excellent
(If this comment was disrespectful, please report it.)
 
5/30/2003 7:03:24 AM: 

Very nice. Excellent from me.
(If this comment was disrespectful, please report it.)
 
5/30/2003 9:38:03 AM: VbNick

Very Very useful...and excellent coding...congrats.....5 globs..!!
(If this comment was disrespectful, please report it.)
 
6/8/2003 4:46:21 AM: Chris Read

Excellent code. 5 gizmos
(If this comment was disrespectful, please report it.)
 
6/10/2003 6:18:10 AM: Sener Yetgin

Thanks for the useful code...

(If this comment was disrespectful, please report it.)
 
6/16/2003 1:03:03 AM: 

an other country used this code
must add this line
<%@ LANGUAGE=VBScript CODEPAGE="1252"%>
ANSI code page 1252 is used for American English
(If this comment was disrespectful, please report it.)
 
6/28/2003 11:59:46 PM: 

Awesome dude!! its impressive!
(If this comment was disrespectful, please report it.)
 
7/18/2003 5:54:33 AM: 

Lovely, gorgeous, genius :)
(If this comment was disrespectful, please report it.)
 
10/9/2003 11:24:53 PM: 

I think this is a awesome idea, but i cannot get it to work. Can I get some more instructions on how to set it up?
(If this comment was disrespectful, please report it.)
 
10/12/2003 9:46:13 PM: 

I get this error when attempting to run this script. How do I correct this? It is referring to this line of code:

response.binarywrite stb(datawrite)



Response object error 'ASP 0106 : 80020005'

Type Mismatch

/Test3.asp, line 405

An unhandled data type was encountered




(If this comment was disrespectful, please report it.)
 
12/15/2003 8:51:44 PM: 

Not sure what I am doing wrong, I am just getting an image box with a red X as if the image does not exist. Note IIS 6.0 Win 2003, other ASP scripts are running and I have verified I am pointing the script to the correct path.
Any ideas? Thanks.
Chris
(If this comment was disrespectful, please report it.)
 
2/6/2004 6:11:00 PM: 

Works great but I cannot make smaller width than 1 to make realy small barcode. Any idea how to make it?
(If this comment was disrespectful, please report it.)
 
8/23/2004 7:54:54 PM: 

I have similar problem with what Chris had. When I call the barcode asp application in the same way with calling an img link, it returns me a red X at the location where the barcode image should be displayed. If anyone knows how to fix it, please do let me know. (sli036@ec.auckland.ac.nz) I am really looking forward to your reply!
Cheers :-)
(If this comment was disrespectful, please report it.)
 
12/13/2004 10:46:21 PM: 

When ever I call the page all I am getting is a red X wherer the barcode should be. Can anyone tell me how to fix this as if I can get it going it will be ideal.

Cheers
(If this comment was disrespectful, please report it.)
 
2/16/2005 6:11:17 PM: Mark Kahn

The barcode width can't be less than 1 since it would lose data.

If you're getting a red X, open the image source in your browser and post any error here.
(If this comment was disrespectful, please report it.)
 
2/21/2005 11:11:12 PM: 

I got same error with Chris, the submitting img statement is :
{img src="http://aspnt1/justin/govtlab/barcode.asp?code=43&height=20&width=1&mode=code39"}

** {} = <>
(If this comment was disrespectful, please report it.)
 
7/26/2005 10:23:59 AM: José Ignacio Fernández

Excelent. If you were a woman i will kiss you.

Thanks for give us your knowledge.
(If this comment was disrespectful, please report it.)
 
1/21/2006 2:50:37 AM: Stephen

I can get code39 to work but not EAN-13 which is what I need. I get the red x image not found error. Any ideas guys?
(If this comment was disrespectful, please report it.)
 
6/2/2006 5:18:26 AM: Chaiyarit

It's a excellent code but if anyone can tell me how to keep dataout in the image file format(bmp).It's very greatfull.
(If this comment was disrespectful, please report it.)
 
11/2/2007 6:01:29 AM: GrinchWolf

Great work !!!
But... how can create a PDF report with this Barcode ? I'm Using COLDFUSION mx 7
THANKS.
(If this comment was disrespectful, please report it.)
 
Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.

Search:

Newest postings for ASP/ VbScript.

Add this ticker to my site

Daily code email

Click here to join the 'Code of the Day' mailing list!

This site on CD

Over 7,000 submissions on a super fast CD!

Code/Articles

Top Code

Community

Jobs

Other

Goto…

Copyright© 1997-2013 by Exhedra Solutions, Inc. All Rights Reserved.
By using this site you agree to its Terms and Conditions. Planet Source Code™ and the phrase "Dream It. Code It"™ are trademarks of Exhedra Solutions, Inc.