Código Galeria ASP

[Agrey]

Hola a todos, necesito el código de una galería de fotos echa en asp con access.

Gracias por ayudar a este desesperado

[Agrey]

Bueno, al final me he puesto en ello, y me estan surgiendo alguasn dudas que espero k me ayudeis.

Priemro kiero mostrar un la fotos en un tamaño más pequeño, pero komo puedo ahcer eso.
Tengo que poner a todas las fotos el mismo tamaño "height=100 width=70" o puedo hacer que dependiendo del tamaño de la foto original esta cambie en al vista en miniatura.?¿como hago eso?

A mi se me ha ocurrido que en un campo de la base de datos ponga el tamaño que quiero en miniatura, y así al hacer la select y mostrar las imagenes, coja el ancho y alto que yo he pensado para cada foto individual y así queden mejor proporcionadas en miniatura.

Espero vuestras opiniones.

[fernandowind]

me encanto las respuestas que te dieron !!! yo tampoco te las voy a dar

[fernandowind]

jejeje no mentira, para hacer el paginado mira el foro que hay unas cuantas forma para hacerlo y para lo de la imagen en miniatura lo mejor es el componente AspJpeg anda muy bien y lo tienen instalado casi todos los servidores ya que asp no trae nada para manejar imagenes cosa que php si lo trae, el unico problema es que es pago pero hay una versión de prueba de 30 dias

[dobled]

busca aqui
o aca

Suerte

[locko]

mira en mi page. byenbici.tk . tengo dos tipos de galerias haber si te sirve alguno y te paso las direcciones de donde las sake, aunke alguna creo ke andara por aki.

[8461277]

Locko esta muy bueno tu pagina y a mi me interesa esa galeria que esta de machete, por favor donde puedo conseguirlo????

[locko]

si te refieres a la ke esta "integrada" en la page el codigo son los 4 post ke sigen a este
Si es la otra la ke sale en una nueva ventana podeis vajarla de aki es un aplicacion genial, pero rekiere mas movidas de comfiguraciones y asi.


espero ke os sirvan

[locko]

<%
'################################################# ##################
'# Image Gallery v1.0
'#
'# This script will automatically create links for thumbs
'# and links to the full image. You just need to upload the
'# Full Image and the Thumbnail in the right directories.
'# All underscores ('_') in directories & FileNames will be
'# replaced by Spaces. The FileName will apear on top of the
'# page when you view the full Image.
'#
'# It will create a Previous & Next link to limit the amount
'# of thumbs showed on a page and also when you view a Full
'# Image. This way you don't need to return to the thumbs.
'#
'# Created by Sebastien Morel
'# Contact me on '[email protected]' for bugs or comments
'################################################# ##################
%>

<!--#INCLUDE FILE="includes/inc_Common.asp" -->
<%
On Error Resume Next

StartPosition = Request("imgCount")
Folder = Request("Folder")
ImageFilePath = myFolder + "/" + Request("Folder")
indPicturesFolderSpaces = Replace(Folder,"_"," ")
counter = 0
lImgCounter = 0
%>

<table width="100%" cellpadding="0" cellspacing="0" border="0" align="center" bgcolor="#DEBD94">
<tr>
<td>
<table border="0" cellpadding="0" cellspacing="0" width="100%" align="center">
<tr>
<td align="left" width="20"><img src="images/td_top_left.gif" width="20" height="20" border="0"></td>
<td class="Header" align="center" width="*" background="images/td_top.gif">Galeria <%=folder%></td>
<td class="Header" align="center" width="*" background="images/td_top.gif"><A href="galeria-fotos.asp"><img src="images/nav-up.gif" width="16" height="16" border="0" alt="Mas Galerias"></a></td>
<td align="right" width="20"><img src="images/td_top_right.gif" width="20" height="20" border="0"></td>
</tr>
</table>
<table cellpadding="0" cellspacing="20" border="0" width="100%" background="images/td_centro.gif">
<tr>
<%
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(Server.MapPath(ImageFilePath))

For Each objFile In objFolder.Files
strFileExtension = LCase(Mid(objFile.Name, InStrRev(objFile.Name, ".", -1, 1) + 1))

If strFileExtension = "gif" Or strFileExtension = "jpg" Then
If (CLng(counter) >= CLng(StartPosition)) and (Clng(counter) < (CLng(StartPosition) + Clng(ImageLimit))) then

lImgCounter = lImgCounter + 1

%>
<td align="center" bgcolor="#FFFFFF">
<a href="javascript:abrir_img('popupfoto.asp?cod=<%= ImageFilePath & "/" & objFile.Name %>')">
<img src=<%= ImageFilePath & "/" & objFile.Name %> vspace="5" hspace="5" width="120" border="0" alt="<%= objFile.Name %>"></a>
</td>
<%
If (lImgCounter Mod Imagerow) = 0 Then Response.Write "<TR>"
end if
counter = counter + 1
End If
Next

ThumbNextLink = CLng(StartPosition) + Clng(lImgCounter)
ThumbPreviousLink = CLng(StartPosition) - Clng(ImageLimit)
%>
</tr>
</table>
<table border="0" cellpadding="0" cellspacing="0" width="100%" align="center">
<tr>
<td class="middle" align="left" width="20"><img src="images/td_bot_left.gif" width="20" height="20" border="0"></td>
<% If (CLng(StartPosition) >= CLng(ImageLimit)) Then %>
<td class="middle" align="left" width="100" background="images/td_bot.gif">
<A href="foto.asp?Folder=<%= Folder %>&imgCount=<%= ThumbPreviousLink %>" class="links">Anterior</A>
</td>
<% End If %>
<td class="middle" align="center" width="*" background="images/td_bot.gif">&nbsp;</td>
<% If (CLng(StartPosition)) < (CLng(counter) - (CLng(ImageLimit))) Then %>
<td class="middle" align="right" width="100" background="images/td_bot.gif">
<A href="foto.asp?Folder=<%= Folder %>&imgCount=<%= ThumbNextLink %>" class="links">Siguiente</A>
</td>
<% End If %>
<td class="middle" align="right" width="20"><img src="images/td_bot_right.gif" width="20" height="20" border="0"></td>
</tr>
</table>
</td>
</tr>
</table>


<!--#INCLUDE FILE="includes/inc_footer.asp" -->
<%
Set objFSO = Nothing
Set objFolder = Nothing
%>

[locko]

<%
'################################################# ##################
'# Image Gallery v1.0
'#
'# This script will automatically create links for thumbs
'# and links to the full image. You just need to upload the
'# Full Image and the Thumbnail in the right directories.
'# All underscores ('_') in directories & FileNames will be
'# replaced by Spaces. The FileName will apear on top of the
'# page when you view the full Image.
'#
'# It will create a Previous & Next link to limit the amount
'# of thumbs showed on a page and also when you view a Full
'# Image. This way you don't need to return to the thumbs.
'#
'# Created by Sebastien Morel
'# Contact me on '[email protected]' for bugs or comments
'################################################# ##################
%>
<!--#INCLUDE FILE="includes/inc_Common.asp" -->
<%
On Error Resume Next

myFolderPath = Server.MapPath(myFolder)
%>
<table border="0" cellpadding="0" cellspacing="0" width="100%" align="center">
<tr>
<td class="header" align="left" width="20"><img src="images/td_top_left.gif" width="20" height="20" border="0"></td>
<td class="header" align="center" width="*" background="images/td_top.gif"><font class="PopTitle">Galerias</font></td>
<td class="header" align="right" width="20"><img src="images/td_top_right.gif" width="20" height="20" border="0"></td>
</tr>
</table>
<table cellpadding="3" cellspacing="0" border="0" width="100%" background="images/td_centro.gif">
<tr>
<td width="120">&nbsp;</td>
<td width="300"><br>
<%
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(myFolderPath) Then
'The main picture folder exists
Set objPicturesFolder = objFSO.GetFolder(myFolderPath)
Set collPicturesFolders = objPicturesFolder.SubFolders
For Each indPicturesFolder in collPicturesFolders
indPicturesFolderSpaces = Replace(indPicturesFolder.Name,"_"," ")
%>
<img src="images/orangeball.gif" align="top">&nbsp;
<a href="foto.asp?Folder=<%= indPicturesFolder.Name %>" class="links">
<%= indPicturesFolderSpaces %></A><br><br>
<%
Next
%>
<%

Set collPicturesFolders = Nothing

Else
'The main picture folder does not exists
%>
<font class="error">No Pictures could be found.</font>
<%
End If
%>
</td>
</tr>
</table>
<table border="0" cellpadding="0" cellspacing="0" width="100%" align="center">
<tr>
<td class="middle" align="left" width="20"><img src="images/td_bot_left.gif" width="20" height="20" border="0"></td>
<td class="middle" align="center" width="*" background="images/td_bot.gif">&nbsp;</td>
<td class="middle" align="right" width="20"><img src="images/td_bot_right.gif" width="20" height="20" border="0"></td>
</tr>
</table>
<!--#INCLUDE FILE="includes/inc_footer.asp" -->
<%
Set objFSO = Nothing
Response.Flush
%>

[locko]

<%
'################################################# ##################
'# Image Gallery v1.0
'#
'# This script will automatically create links for thumbs
'# and links to the full image. You just need to upload the
'# Full Image and the Thumbnail in the right directories.
'# All underscores ('_') in directories & FileNames will be
'# replaced by Spaces. The FileName will apear on top of the
'# page when you view the full Image.
'#
'# It will create a Previous & Next link to limit the amount
'# of thumbs showed on a page and also when you view a Full
'# Image. This way you don't need to return to the thumbs.
'#
'# Created by Sebastien Morel
'# Contact me on '[email protected]' for bugs or comments
'################################################# ##################
%>
<BR>
<div align="center">
<font class="footer">Image Gallery created by <A class="smalllinkgrey" href="mailto:[email protected]?Subject=Ima ge Gallery">Sebastien Morel</A><BR>Copyright © 2002 - 2003</font>
</div>
<BR>

[locko]

<%
'################################################# ##################
'# Image Gallery v1.0
'#
'# This script will automatically create links for thumbs
'# and links to the full image. You just need to upload the
'# Full Image and the Thumbnail in the right directories.
'# All underscores ('_') in directories & FileNames will be
'# replaced by Spaces. The FileName will apear on top of the
'# page when you view the full Image.
'#
'# It will create a Previous & Next link to limit the amount
'# of thumbs showed on a page and also when you view a Full
'# Image. This way you don't need to return to the thumbs.
'#
'# Created by Sebastien Morel
'# Contact me on '[email protected]' for bugs or comments
'################################################# ##################

Dim myFolder 'name of main folder where pictures are in
Dim ImageRow 'Set how many images are displayed/row
Dim ImageLimit 'Set how many thumbs are displayed/page
Dim FullImageDir 'set the folder where the full images are stored

'******** change this *********
myFolder = "galerias"
ImageRow = 3
ImageLimit = 12
FullImageDir = "fotos"
'******************************

Dim objFSO 'instance of FileSystemObject component
Dim objFile 'a file under the individual pictures folder
Dim objFolder 'access the current folder
Dim objPicturesFolder 'to access the main picture folder
Dim collPicturesFolders 'collection of folders under pictures folder
Dim indPicturesFolder 'a folder in the folders collection
Dim myFolderPath 'full path of pictures folder
Dim ImageFilePath 'specific folder to show from request
Dim indPicturesFolderSpaces 'Displays the folder name with spaces
Dim strFileExtension 'Get the extension of the files in the directory
Dim Counter 'Counts how many images were displayed
Dim Folder 'Request the folder from previous page
Dim FileNbr 'The filenameNumber of the image to be shown
Dim FileNameSpaces 'The description of the image to be shown with spaces
Dim imgCurrentBaseName 'Current basefilename in the loop
Dim StartPosition 'The # of the image where to start display
Dim lImgCounter 'The current image count/page
Dim ThumbPreviousLink 'Builds up the Previous Page Link
Dim ThumbNextLink 'Builds up the Next Page Link
Dim ShowImageLink 'This will show the requested full image
Dim CurrentFileName 'Request the current FileName in the loop
Dim Author
%>

[8461277]

Gracias amigo tengo los dos, lo revisare a ver cual es el que me sirve, epero contar contigo por algunas dudas que salga??? gracias

[locko]

por aki andare. ke pa eso stamos

[8461277]

Ok por casualidad tu tiene una aplicacion que genere codigo de barra en asp, yo encontre este que segun lo hace pero no lo entiendo bien o es que ando tapao aqui te lo dejo a ver si te interesa o me ayude a desifra como trabaja:

[8461277]

'**************************************
' 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

[8461277]

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

[8461277]

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
%>

[locko]

ahora ando algo liado, pero esta noche haber si libro un rato y lo miro por si veo algo.