Biblioteca de Clases,Funciones y Sub-rutinas.

Saruman · #31 (**permalink**) 08/11/2004, 10:11

Una función para saber el tamaño de un archivo (bytes, KB, MB).

la funcion es esta:

Código:

<%
	Function FileSize(Path, FileName, Tipo)
		set FSO = Server.CreateObject("Scripting.FileSystemObject")
		set oFile = FSO.GetFile(Server.MapPath(Path & FileName))
	
		FileSize = oFile.Size
		
		select case Tipo
			case 2:
				FileSize = Round(FileSize / 1024, 2)
			case 3:
				FileSize = Round(FileSize / 1048576, 2)
			case 4:
				FileSize = FileSize & " Bytes"
			case 5:
				FileSize = Round(FileSize / 1024, 2) & " KB"
			case 6:
				FileSize = Round(FileSize / 1048576, 2) & " MB"
			case 7:
				if FileSize > 0 and FileSize < 1024 then
					FileSize = FileSize & " Bytes"
				elseif FileSize >= 1024 and FileSize < 1048576 then
					FileSize = Round(FileSize / 1024, 2) & " KB"
				elseif FileSize >= 1048576 then
					FileSize = Round(FileSize / 1048576, 2) & " MB"
				end if
			case else
				FileSize = FileSize
		end select
		
		set oFile = nothing
		set FSO = nothing
	End Function
%>

Y se llama asi:

Código:

tamano_archivo = FileSize("ruta_del_archivo", "nombre_del_archivo", 1)

Tipos:

tamano_del_archivo_ejemplo = 500000

1 = tamano en bytes (500000)
2 = tamano en Kilo bytes (KB) (488.28)
3 = tamano en Mega bytes (MB) (0.48)
4 = tamano en bytes pero con la palabra bytes (500000 bytes)
5 = tamano en Kilo bytes pero con la palabra KB (488.28 KB)
6 = tamano en Mega bytes pero con la palabra MB (0.48 MB)
6 = tamano automático del peso (bytes, KB o MB).

Saruman · #32 (**permalink**) 08/11/2004, 10:18

Aqui hay dos funciones para enviar e-mails utilizando dos de los métodos más famosos....

Enjoy

Código:

<%
sub SendEmail(de, nick, para, asunto, mensaje)
		Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
		
		with Mailer
			.FromName = FromName
			.FromAddress = de
			.RemoteHost = RemoteHost
			.AddRecipient nick, para
			.Subject = asunto
			.ContentType = "text/html"
			.BodyText = mensaje
			if .SendMail = false then
				response.write("Error al enviar el E-Mail:<br>")
				response.write("<strong>Mensaje: </strong>" & .Response & "<br>")
			end if
		end with
		
		set Mailer = nothing
	end sub
	
	sub SendJMailEmail(de, nick, para, asunto, mensaje)
		Set objJMail = Server.CreateObject("JMail.SMTPMail")
		if isnumeric(body_tipo) = false then body_tipo = 0
		
		with objJMail
			.ServerAddress = RemoteHost
			.Sender = de
			.SenderName = nick
			.AddRecipient para
			.Subject = asunto
			if body_tipo = 1 then
				.Body = mensaje
			else
				.HTMLBody = mensaje
			end if
			.Silent = True
			.Priority = 3
			bSuccess = .Execute()
			if bSuccess = false then
				response.write("Error al enviar el E-Mail:<br>")
				response.write("<strong>Código: </strong>" & .ErrorCode & "<br>")
				response.write("<strong>Mensaje: </strong>" & .ErrorMessage & "<br>")
			end if
		end with
		
		Set objJMail = Nothing
	end sub
%>

se utiliza asi:

ASP Mail

Código:

call SendEmail(de, nick, para, asunto, mensaje)

J Mail

Código:

call SendJMailEmail(de, nick, para, asunto, mensaje)

Saruman · #33 (**permalink**) 08/11/2004, 10:22

Función para insertar un Flash en nuestras páginas ASP.

Código:

function InsertFlash(Path, FileName, Width, Height)
		with response
			.write("<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" " _
			& " codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""" & Width & """ " _
			& "height=""" & Height & """>")
			.write("<param name=""movie"" value=""" & Path & FileName & """>") & vbcrlf
			.write("<param name=menu value=false>") & vbcrlf
			.write("<param name=""quality"" value=""high"">") & vbcrlf
			.write("<embed src=""" & Path & FileName & """ quality=""high"" menu=""false"" pluginspage=""http://www.macromedia.com/go/getflashplayer""  " _
			& "type=""application/x-shockwave-flash"" width=""" & Width & """ height=""" & Height & """></embed>") & vbcrlf
			.write("</object>") & vbcrlf
		end with
	end function

Se utiliza asi:

Código:

call InsertFlash("ruta_del_swf", "archivo.swf", "Ancho_del_archivo", "alto_del_archivo")

Ancho_del_archivo y alto_del_archivo son valores enteros

OXIGENO · #34 (**permalink**) 18/11/2004, 05:43

algo util para todos... formatear tipos de Fecha... espero que sea de utilidad... salu2 a to2!

Código:

Function FormatFecha(TIPO,FEC)
	dim myFEC
	SELECT CASE TIPO
		CASE "DMA"
			myFEC = (day(FEC)&"/"&month(FEC)&"/"&year(FEC))
		CASE "MDA"
			myFEC = (month(FEC)&"/"&day(FEC)&"/"&year(FEC))		
		CASE "ADM"				
			myFEC = (year(FEC)&"/"&day(FEC)&"/"&month(FEC))		
		CASE "AMD"				
			myFEC = (year(FEC)&"/"&month(FEC)&"/"&day(FEC))			
	END SELECT
	FormatFecha = myFEC
End Function

lexus · #35 (**permalink**) 02/12/2004, 16:52

esta subrutina sirve para darle un manejo ordenado a nuestros errores, recomendado para usar en intranets.

no coloqué el desarrolo de la pagina de envio de datos pero es hecha usando Cdonts y solo falta agregarle los parametros a enviar.asp?errornum=.....asi

Código:

 
 
<%
Dim mensaje_error,hay_error
mensaje_error = ""
hay_error = false
 
sub manejoerror(error)
hayerror = true
mensaje_error = mensaje_error & error & ", "
response.write(vbCrLf & "<fieldset><legend><strong>ADVERTENCIA: Se ha producido un error</strong></legend>")
response.write(vbCrLf & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Error #:</b> " & err.number & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Fuente del Error:</b> " & err.source & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Descripci&oacute;n del Error:</b> " & err.description & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Fecha y Hora:</b> " & now() & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Pagina:</b> " & request.servervariables("SCRIPT_NAME") & "<br>")
		if request.cookies("login") = "" then
response.write(vbCrLf & "	 <b>&nbsp;Usuario:</b> An&oacute;nimo <br>")
else 
response.write(vbCrLf & "	 <b>&nbsp;Usuario:</b> " & request.cookies("login") & "<br>")
end if
response.write(vbCrLf & "<br>")
		response.write(vbCrLf & "<input type=""submit"" name=""Submit"" value=""Enviar a Soporte"" onClick=""javascript:window.location.href='enviar.asp';""> ")
		response.write(vbCrLf & "<input type=""submit"" name=""Submit"" value=""Imprimir Reporte"" onClick=""javascript:print();"">")
response.write(vbCrLf & "</fieldset>")
end sub
on error resume next
%>
<html><head></head><body></body></html>
<%
If err.number <> 0 Then
	manejoerror err.description
End If
%>

para probarlo creen un error a proposito por ejemplo coloquen dentro de las etiquetas body algo asi: <%asd%>

pempas · #36 (**permalink**) 09/12/2004, 19:58

Aquí pongo mi pequeña aportación:

Genera un código aleatorio de 40 caracteres, números y letras.

***********************************************
Function Codigo_Aleatorio
Dim confirmado, valor
randomize

For I = 1 to 40
confirmado = Int((90 - 48 + 1) * Rnd + 48)
valor = valor & chr(confirmado)
next

Codigo_Aleatorio = valor
End Function
***********************************************

Para que genere más solo teneis que incrementar el valor del for por el número que quieras.

Saludos a tod@s

mamon · #37 (**permalink**) 15/12/2004, 01:12

Cómo hago para saber el factorial de un numero?

function fact(xnumero)
fact = 1
for i = 1 to xnumero
fact = fact*i
next
end function

cómo lo recupero?
<%="El factorial de 10 es: " & fact(10)%>

para que sirve saber el factorial de un numero? pucha la vdd es que no sé.. pero se me acaba de ocurrir esta funcion.. jejejeje

Bravenap · #38 (**permalink**) 15/12/2004, 03:25

Cita:

para que sirve saber el factorial de un numero? pucha la vdd es que no sé.. pero se me acaba de ocurrir esta funcion.. jejejeje

Pues sirve, por ejemplo, para hallar números combinatorios. No obstante una aclaración: habría que comprobar previamente si el número que se le pasa a la función es un número entero. Los factoriales son sólo de números enteros, por lo que de no ser así, es muy probable que devuelva un error.

Un saludo.

lexus · #39 (**permalink**) 19/12/2004, 00:58

esta funcion sirve para colocar ceros a la izquierda de un numero, funcion ideal para sistemas de facturacion por ejemplo nos deja un numero por ejemplo 14 a 00014

Código:

function FormatoNum(num,digitos)
largo = Len(Cstr(num))
dif = digitos - largo
if dif < 0 then exit function
if largo < digitos Then
x = String(dif,"0") & Cstr(num)
else
x = Cstr(num)
end if
FormatoNum = x
End Function

Le pasas como primer parámetro el numero y luego la cantidad de digitos
EJ:
response.write FormatoNum(14,4)' devolvera 0014

lexus · #40 (**permalink**) 19/12/2004, 01:03

Funcion para sacar el ultimo dia del mes

Código:

Function ultimodiadelmes(mes, ano)
DIm messig
messig = DateAdd("m", 1, DateSerial(ano, mes, "01"))
ultimodiadelmes = Day(DateAdd("d", -1, messig))
End Function

le pasamos como parametro el mes y el año asi nos retornara el ultimo dia de ese mes.

llamado asi:

Código:

Response.Write "Ultimo día del mes Enero de 2005:" & ultimodiadelmes(1,2005)

lexus · #41 (**permalink**) 19/12/2004, 01:08

estas funciones las vi no recuerdo donde pero me han servido muchisisisimo.

usan filesystemobject para borrar archivos o carpetas

Código:

 Borrar archivo 
 
Function BorrarArchivo(archivo)
	dim fs
	Set fs = Server.CreateObject("Scripting.FileSystemObject") 
	if fs.FileExists(archivo) then fs.DeleteFile(archivo)
	Set fs = Nothing
End function
 
arch = "c:\proyecto1\a.txt"
BorrarArchivo(arch)

Código:

Borrar Carpeta
 
Function BorrarCarpeta(carpeta)
	Dim fs
	Set fs = Server.CreateObject("Scripting.FileSystemObject")
	if fs.FolderExists(carpeta) then fs.DeleteFolder(carpeta)
	Set fs = Nothing
End Function
 
carp = "c:\proyecto1"
BorrarCarpeta(carp)

Muzztein · #42 (**permalink**) 04/01/2005, 08:18

bueno.
aburrido de tener que lidear con las configuraciones de las fechas y tener que sincronizarlas entre el servidor web y el servdior de base de datos.
se me ocurrio manejar mi propio estandar de fechas que lo he estado aplicando desde hace tiempo en todas mis creaciones y a funcionado de maravilla.

para empezar, nunca mas utilice un tipo de dato DATE.

para mi eso ya esta obsoleto.

por el contrario me he creado un DOMINIO del tipo de dato char14 que va desde el

19000101000000 hasta el 99991231235959

ahora bien.
como podran darse cuenta el formato utilizado es yyyymmddhhmmss

de tal manera que si lo ordeno de mayor a menor quedara ordena segun la hora de manera natural.(tal como el tiempo pasa)

Teniendo eso como base del estandard utilizo estas dos simples funciones que me permite convertir de ida y de vuelta la fecha como desee yo ocuparla

(la llamo inc_fechas.asp y la invoco en todas mis paginitas)

Código:

'session.lcid=1033 'setea la fecha en mmddyy
session.lcid=1034 'setea la fecha en ddmmyy

function dateToIwsDate(str)
	if isdate(str) = true then
		ano = year(str)
		mes = month(str)
		dia = day(str)
		hora= hour(str)
		minuto = minute(str)
		segundo = second(str)
		if len(ano) < 4 then ano = "20" & ano
		if len(mes) < 2 then mes = "0" & mes
		if len(dia) < 2 then dia = "0" & dia
		if len(hora) < 2 then hora = "0" & hora
		if len(minuto) < 2 then minuto = "0" & minuto
		if len(segundo) < 2 then segundo = "0" & segundo
		dateToIwsDate = ano&mes&dia&hora&minuto&segundo
	else
		dateToIwsDate= "19000101000000"
	end if
end function


function iwsDateToDate(str)
	if len(str) = 14 then
		ano = left(str,4)
		mes = mid(str,5,2)
		dia = mid(str,7,2)
		hora = mid(str,9,2)
		minuto = mid(str,11,2)
		segundo = right(str,2)
		x_fecha = ano & "/" & mes & "/" & dia & " " & hora & ":" & minuto & ":" & segundo
		if isdate(x_fecha) = true then
			iwsDateToDate = cdate(x_fecha)
		else
			iwsDateToDate = cdate(iwsDateToDate("19000101000000"))
		end if
	else
		iwsDateToDate = cdate(iwsDateToDate("19000101000000"))
	end if
end function

y tadá

adios complicaciones con las fechas para siempre.

(he hecho algunas modificaciones,pero la idea sigue siendo la misma)

saludos

#43 (**permalink**) 10/01/2005, 04:39

Aki os pongo mi pequeña aportación, aunque tienes muchísimos usos que pueden ser más o menos legales, vosotros mismos.

El código lo que hace es acceder al código fuente html de la página y mostrarla, por lo que se puede aprovechar para muchas cositas

Código:

<% 
if request("url") <>"" then
set http_obj = createObject("Microsoft.XMLHTTP")
ulr=request("url")
http_obj.Open "GET",url,false
http_obj.Send()
codigo = Server.HTMLEncode(http_obj.responseText)
%>
<%=codigo%>
<%end if%>

Guardais la página como codigo.asp, por ejemplo, y si poneis codigo.asp?url=http://www.instruccionesymanuales.com vereis el código html de esta página (que es la mía dicho de paso)

Espero que os sirva

Nota: Editado por Al Zuwaga para colocar el código entre etiquetas CODE en vez de QUOTE debido a que desforma las tablas

#44 (**permalink**) 10/01/2005, 04:51

Pues muy fácil, esto es un caso práctico de cómo podemos aprovechar el xmlhttp.

Código:

<% 
if request("traducir") = "yes" then
set http_obj = createObject("Microsoft.XMLHTTP")
cadena2 = "http://babelfish.altavista.com/babelfish/tr?doit=done&intl=1&tt=urltext&urltext="&request("palabra")&"&lp=es_en" 
http_obj.Open "GET",cadena2,false
http_obj.Send()
codigo = Server.HTMLEncode(http_obj.responseText)
pos = instr(codigo, "10px;&gt;")
codigo = mid(codigo,pos+9,len(codigo))
pos2 = instr(codigo ,"&")
codigo = mid(codigo,1,pos2-1)
end if
%>
<form action="babel.asp" method="get">
<textarea name="palabra" cols="40" rows="10"><%=request("palabra")%></textarea><br>
<input type="hidden" name="traducir" value="yes">
<input type="submit"><br>
</form>
<%=codigo%>

Copiamos el código en un página asp que se llame babel.asp.

¿Cómo funciona?
Pues muy fácil, enviamos la palabra que queremos traducir a nuestra própia página, ésta lo que hace es ver el código fuente de la página de babelfish con nuestra frase ya traducida, busca dónde se encuentra la traducción y listo, la metemos en la variable "codigo" y la mostramos.

Es una pequeña demostración del poder que tiene el objeto Microsoft.XMLHTTP

Nota: Editado por Al Zuwaga para colocar el código entre etiquetas CODE en vez de QUOTE debido a que desforma las tablas

Muzztein · #45 (**permalink**) 10/01/2005, 04:59

extraordinario !!!

#46 (**permalink**) 10/01/2005, 05:24

Pues igual de fácil que el anterior:

Código:

<%
if request("traducir") = "yes" then
set http_obj = createObject("Microsoft.XMLHTTP")
cadena2 = "http://www.google.es/search?num=100&hl=es&q="&request("palabra")
http_obj.Open "GET",cadena2,false
http_obj.Send()
codigo = Server.HTMLEncode(http_obj.responseText)
codigo = replace(codigo,"&lt;","<")
codigo = replace(codigo,"&gt;",">")
codigo = replace(codigo,"<a","<a target=""new""")
pos = instr(codigo,"class=g")
codigo = mid(codigo,pos-3,len(codigo))
pos = instr(codigo,"clear=all")
codigo = mid(codigo,1,pos)
codigo = replace(codigo,"/search?","google.asp?")
codigo = "<table><tr><td>" & codigo
end if
%>
<html>
	<head>
		<style>
		<!--
body,td,div,.p,a{font-family:verdana }
div,td{color:#000}
.f,.fl:link{color:#6f6f6f}
a:link,.w,a.w:link,.w a:link{color:#800000;text-decoration:none;}
a:visited,.fl:visited{color:#551a8b}
a:active,.fl:active{color:#f00}
.t a:link,.t a:active,.t a:visited,.t{color:#000}
.t{background-color:#e5ecf9}
.k{background-color:#36c}
.j{width:34em}
.h{color:#36c}
.i,.i:link{color:#a90a08}
.a,.a:link{color:#008000}
.z{display:none}
div.n {margin-top: 1ex}
.n a{font-size:10pt; color:#000}
.n .i{font-size:10pt; font-weight:bold}
.q a:visited,.q a:link,.q a:active,.q {color: #00c; }
.b{font-size: 12pt; color:#00c; font-weight:bold}
.ch{cursor:pointer;cursor:hand}
.e{margin-top: .75em; margin-bottom: .75em}
.g{margin-top: 1em; margin-bottom: 1em}
//-->
</style>
	</head>
<body>
<form action="google.asp" method="get">
<input type="text" name="palabra" size="50"value="<%=request("palabra")%>"><br>
<input type="hidden" name="traducir" value="yes">
<input type="submit"><br>
</form>
<%=codigo%>

</body>
</html>

Guardamos el código como google.asp luego si queremos cambiar un poco el estilo de la web para que no se parezca en nada al google lo hacemos editando el <style>.

La única dificultad que se me plantea es la paginación que hace google, pero eso ya os lo dejo a vosotros, aunque si tengo un hueco luego lo posteo.

chao

Nota: Editado por Al Zuwaga para colocar el código entre etiquetas CODE en vez de QUOTE debido a que desforma las tablas

lexus · #47 (**permalink**) 10/01/2005, 17:58

Esta subrutina nos sirve para calcular un tiempo transcurrido desde la fecha dada hasta la actual, por ejemplo si queremos calcular la edad de una persona con solo introducir su fecha de nacimiento..
esta subrutina recibe 4 parametros.
dia, mes, ano, y f
f es el formato de salida qeu queremos ver en pantalla 1 si es en dias, 2 si es en meses y 3 si es en años

un ejemplo de llamado seria asi
calculartiempo 05, 11, 1980, 3

el resultado de esta ejecucion seria 24 años.

Código:

 
Sub calculartiempo(dia, mes, ano, f)
Dim fecha, formatosalida,t
fecha= dia & "/" & mes& "/" & ano
if f = 1 then
formatosalida = "d"
end if
if f =2 then 
formatosalida = "m"
end if
if f = 3 then
formatosalida = "yyyy"
end if
t = DateDiff(formatosalida,fecha,Date())
response.write t
End Sub

si alguien quiere hacerle algunas mejoras seria bueno.. por ahora no se me ocurre que mas hacerle. creo qeu tambien se puede hacer en horas, minutos, segundos, etc.. o la verdad n estoy muy seguro, si es asi, porfavor escriban la modificacion.

Muzztein · #48 (**permalink**) 12/01/2005, 07:00

una facilita

Código:

sub redirecionar(url)
	escribe "<script>"
	escribe "window.location ="""& url &""";"
	escribe "</script>"
end sub

y se podria usar asi

Código:

parametro = request("parametro")
if len(parametro) = 0 then
            mensaje "Se esperaba parametro"
            redireccionar "default.asp"
            termina
end if

como para controlar la entrada de un parametro a mi aplicacion.

lexus · #49 (**permalink**) 12/01/2005, 07:37

hola yo tengo la misma que vos ,pero asi

Código:

sub redirecionar(url)
   response.redirect url
end sub

y la llamo asi:

Código:

redireccionar "mipagina.asp"

alguien preguntara cual es la diferencia, pues la verdad es mucha... para algunos casos es mejor la de mutzein ya qeu por ser en javascript permite cambiar lo de window.location por el nombre de un marco(frame) incluso en iframes, la idea es que sirve redireccionar paginas sencillas o con frames, la que yo pongo solo sirve para mandar a paginas comun y corrientes.
suerte.

-------------------------------- ----------------------------------

bueno cuando cerre este mensaje se me ocurrio otra cosa y edite este post, seria modificar un poco la funcion de mutzein si me lo permite y agregarle un nuevo parametro "target", lo hice porque muchas veces la gente pregunta si es posible que el redirect tenga target cosa qeu nose porque no lo permite el asp. entonces con esta funcion queda solucionado ese problemita.

qeudaria asi.
esta rutina hace uso de la funcion escribe

Código:

 
sub redirecionar(url,target) 
   if target = 1 then
	  target = "window"
   end if
   if target = 2 then
	  target = "self"
   end if
   if target = 3 then
	  target = "top"
   end if
   if target = 4 then
	  target = "parent"
   end if
   if target = 5 then
	  target = "blank"
   end if
 
escribe "<script>"
escribe target &".location ="""& url &""";"
escribe "</script>"
end sub

se podria hacer el llamado asi:

Código:

 
' esto nos ubica la pagina default.asp en la ventana principal
redireccionar "default.asp", 1

Código:

 
' esta nos ubica la pagina en un marco especificado
' donde dice mimarco se debe colocar el nombre de
' tu frame donde deseas qeu aparezca la pagina.
redireccionar "default.asp", "mimarco"

espero sea de utilidad.

sqa212 · #50 (**permalink**) 17/01/2005, 09:25

<%
Function Diasenelmes(Mes, anio)
Dim Valor
Valor = DateAdd("d", -1, DateSerial(anio, Mes + 1, 1))
Diasenelmes = Day(Valor)
End Function
%>
<%=Diasenelmes(1, 2005)%> 
<%=Diasenelmes(2, 2005)%> 
<%=Diasenelmes(3, 2005)%> 
<%=Diasenelmes(4, 2005)%> 
<%=Diasenelmes(5, 2005)%> 
<%=Diasenelmes(6, 2005)%> 
<%=Diasenelmes(7, 2005)%> 
<%=Diasenelmes(8, 2005)%> 
<%=Diasenelmes(9, 2005)%> 
<%=Diasenelmes(10, 2005)%> 
<%=Diasenelmes(11, 2005)%> 
<%=Diasenelmes(12, 2005)%>

Ramonkill · #51 (**permalink**) 24/01/2005, 16:40

Hola.
Os dejo una funcion que sirve para ver si una cadena cumple un patron de una expresion regular. Con esta funcion podemos saber si la cadena es valida o no dependiendo del patron. Sirve para validar direcciones de mail, validar nombres, contraseñas, etc... Dependiendo del patron.

Código:

<%Function ExprRegulares(patron,cadena)

	Dim ExprReg
	set ExprReg = New RegExp
	ExprReg.Pattern = patron
	ExprReg.IgnoreCase = True
	
	ExprRegulares=ExprReg.Test(cadena) 
	
	set ExprReg = nothing

End function%>

Con IgnoreCase es que ignora entre mayusculas y minusculas. Con el metodo ExprReg.Replace(cadena,"Texto de sustitucion") podemos sustituir lo que encontremos segun el patron.
Os dejo un ejemplo para que veais como saber si una cadena es demasiado larga como para deformar una tabla de un foro por ejemplo. Asi podriamos devolver un error.

Código:

<% Dim comprobar

comprobar=ExprRegulares("\S{90,}",texto)

if comprobar=true then
response.write("Cadena demasiado larga.")
end if%>

En este caso mira si la cadena no contiene espacios en 90 caracteres seguidos. Es muy poco codigo y muy simple. Esto con bucles tardaria el doble y seria mas larga y complicada la función.
Saludos.

Muzztein · #52 (**permalink**) 02/02/2005, 08:33

esta subrutina es para gente extremadamente floja.

y basicamente lo que hace es imprimir todas las variables que vengan de un formulario enviado.

es simple y sirve para debuguear de manera rapida

Código:

sub imprime_variables_del_form()
	for each x in Request.Form 
		imprime "<strong>" & x & "</strong> = " & Request.Form(x) 
	Next
end sub

akela · #53 (**permalink**) 02/02/2005, 18:30

Con esta puedes calcular claves aleatorias

Código:

 
Dim Codigo
Randomize 
    For i=1 to 6
        codigo = codigo & Cstr(Intr((9-1+1) * Rnd + 1))
    Next i
Response.write codigo

El ciclo está puesto hasta el 6 e indica la longitud de la clave, para hacer claves mas largas o cortas debes cambiar este número.

Hay que hacer notar que la clave se compone de numero aletorios entre el 1 y el 9 haciendo uso de la función RND.

esta funciòn se puede mejorar para que te de cualquier caracter utilizando la función CHR

Espero les sirva.

Muzztein · #54 (**permalink**) 04/02/2005, 07:29

Esta sirve para alertar de errores
No sirve de mucho, por que no es la mamera correcta de manejar errores, pero sirve para empezar

Código:

on error resume next
'ejecucion de algun sql contra alguna base de datos
call checa_error()

donde

Código:

sub checa_error()
	if err.number <> 0 then 
	mensaje ("Error en tiempo de ejecucion")
	imprime "<strong>NUMERO ERROR:</strong>" & err.number 
	imprime "<strong>DESCRIPCION ERROR:</strong>" & err.Description 
	imprime err.HelpContext 
	termina
	end if
end sub

mamon · #55 (**permalink**) 09/02/2005, 01:23

Hola, hoy leí un post donde preguntaban cómo hacer si tengo una cadena y no quiero que se repitan números, letras o lo que sea... bueno, aquí les mando una función:

Código:

 
<%
function no_repetir(cadena,separacion)
V = Split(cadena,separacion)
cant = Ubound(V)
num = -1
do
num = num + 1
for i = num+1 to Cint(cant)
if Cstr(V(num)) = V(i) then
V(i) = ""
end if
next
loop until num = cant-1
for a = 0 to CInt(cant)
if Cstr(V(a)) <> "" then xcadena = xcadena & separacion & V(a)
next
no_repetir = right(xcadena,len(xcadena)-1)
end function
%>

ahora la página q llamará a la función
<%
cadena = "01,02,01,50,500,500"
response.Write(no_repetir(cadena,","))
%>
como ven digo q se imprima lo que devuelve la función, le envio la cadena con los datos y el otro parámetro dice de qué forma están separados los números, han podido ser palabras, letras y la separación x ejemplo un espacio.. bueno espero les sirva

3pies · #56 (**permalink**) 24/02/2005, 03:49

¿Tienes un campo en la DB con "pepito pérez", otro con "PEPITO PÉREZ", otro con "pePiTO PÉreZ", y quieres que al recuperar los datos, te salgan todos homogéneos en pantalla, como "Pepito Pérez"?. Aquí os dejo una función (que a la vez elimina los espacios > 1 (si es que entre "pepito" y "pérez" hubiese más de 1 espacio):

Código:

<%
Function InicialesEnMayusculas(cadena)
'Función para poner las iniciales de un campo en mayúsculas,
'con independencia del nº de palabras que conformen la cadena.
'Miramos si existen más de un espacio vacío,
'y lo reemplazamos por un único espacio vacío
Do While InStr(cadena, "  ")
    cadena = Replace(cadena, "  ", " ")
Loop
'Descomponemos la cadena, en subcadenas,
'para lo cual incidamos el delimitador " ", aunque
'por defecto, podríamos haberlo omitido, pues es ese mismo
cadena = Split(trim(cadena), " ",-1,1)
'miramos las palabras que componen la cadena,
'para lo cual le decimos que recorra desde el primer
'valor de la matriz (empieza en cero), hasta el máximo
'valor (nº de la última palabra) que lo obtenemos con el UBound
For i = 0 To UBound(cadena)
    'ponemos la inicial en mayúsculas, y el resto en minúsculas
    cadena(i) = UCase(Left(cadena(i), 1)) & LCase(Right(cadena(i), Len(cadena(i)) - 1))
Next
'Unimos las cadenas, con la función Join
cadena = Join(cadena)
InicialesEnMayusculas=cadena
End function
%>

AlZuwaga · #57 (**permalink**) 15/03/2005, 14:01

Barra de navegación para resultados paginados (similar a la que usa éste foro)
Créditos del update: 3pies

Función para crear una barra de navegación por resultados paginados.
El aspecto es 'customizable' (tal vez no del todo por el momento) y sólo necesita que se le pase como argumentos la cantidad total de páginas y el número de la página actual

Código:

<%
Function BarraDeNavegacion(PaginasTotales, PaginaActual)
	'Modificar el contenido de las constantes para cambiar el aspecto de la barra de navegación
	const EstiloDeLaTabla = "border: 1px solid #D6AD6B; font-family: Arial, Helvetica, sans-serif; font-size: 10px;"
	const EstiloCeldaPaginaXdeY = "color: #846B42; background-color: #D6AD6B;"
	const LinkDelEnlace = "link1"
	const EstiloDeLaCeldaPaginaActual = "background-color:#EFD6AD; font-weight:bold;"
	const EstiloDeLaCeldaPaginaConLink = "background-color:#F7E7C6"

	if PaginasTotales > 1 then
		if PaginasTotales > 5 then MostrarUltima = true	
		TablaConBarraDeNavegacion = "<table border=""0"" cellpadding=""2"" cellspacing=""1"" style=""" & EstiloDeLaTabla & """><tr><td style=""" & EstiloCeldaPaginaXdeY & """>&nbsp; P&aacute;gina " & PaginaActual & " de " & PaginasTotales & "&nbsp;&nbsp;</td>"
		if PaginaActual >= 4 then
			TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "<td style="""& EstiloDeLaCeldaPaginaConLink &"""><a href="""& PaginaActualBarraDeNavegacion & "?pagina=1"" class=""" & LinkDelEnlace & """><strong>«</strong> Primera</a></td>"
			CantidadAMostrarDeAnterioresYPosteriores = 2
			'Indicamos la celda central como activa, y sin link
			'(la 3ª, de las 5 mostradas), y el resto con link
			for i = 1 to 5
				'No mostramos link si estamos en la 3ª celda de las 5 mostradas
				if i = 3 then
					TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "<td width=""15"" align=""center"" style=""" & EstiloDeLaCeldaPaginaActual & """>" & PaginaActual & "</td>"
				else
				'Mostramos el link si estamos en las celdas distintas de la 3ª (la central)
					TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "<td width=""15"" align=""center"" style=""" & EstiloDeLaCeldaPaginaConLink & """><a href="""& PaginaActualBarraDeNavegacion & "?pagina=" & PaginaActual - CantidadAMostrarDeAnterioresYPosteriores & """ class=""" & LinkDelEnlace & """>" & PaginaActual - CantidadAMostrarDeAnterioresYPosteriores & "</a></td>"
				end if

				if PaginaActual - CantidadAMostrarDeAnterioresYPosteriores = PaginasTotales then
					MostrarUltima = False
					Exit For
				end if

				CantidadAMostrarDeAnterioresYPosteriores = CantidadAMostrarDeAnterioresYPosteriores - 1
			next
		else
			if PaginasTotales < 5 then
				for i = 1 to PaginasTotales
					if i <> PaginaActual then
						TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "<td width=""15"" align=""center"" style="""& EstiloDeLaCeldaPaginaConLink &"""><a href="""& PaginaActualBarraDeNavegacion & "?pagina=" & i & """ class=""" & LinkDelEnlace & """>" & i & "</a></td>"
					else
						TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "<td width=""15"" align=""center"" style="""& EstiloDeLaCeldaPaginaActual &""">" & i & "</td>"
					end if
				next
			else
				For i = 1 to 5
					if i <> PaginaActual then
						TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "<td width=""15"" align=""center"" style="""& EstiloDeLaCeldaPaginaConLink &"""><a href="""& PaginaActualBarraDeNavegacion & "?pagina=" & i & """ class=""" & LinkDelEnlace & """>" & i & "</a></td>"
					else
						TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "<td width=""15"" align=""center"" style="""& EstiloDeLaCeldaPaginaActual &""">" & i & "</td>"
					end if
				next
			end if
		end if

		if MostrarUltima = true then TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "<td style="""& EstiloDeLaCeldaPaginaConLink &"""><a href="""& PaginaActualBarraDeNavegacion & "?pagina=" & PaginasTotales & """ class=""" & LinkDelEnlace & """>&Uacute;ltima <strong>»</strong></a></td>"
		TablaConBarraDeNavegacion = TablaConBarraDeNavegacion & "</tr></table>"
		BarraDeNavegacion = TablaConBarraDeNavegacion
	end if
end Function
%>

Se la llama así en el lugar donde se desea que la barra aparezca:

Código:

<%=BarraDeNavegacion(PaginasTotales, PaginaActual)%>

Update 31/10/2005:
La función fue modificada según el genial aporte de 3pies de éste mensaje

trasgukabi · #58 (**permalink**) 18/03/2005, 06:24

Función para esconder el path real de nuestras imágenes.

Código:

<%
function enseñame_la _imagen_mentirosa(a)
	Set fso = CreateObject("Scripting.FileSystemObject")
	'path de la imagen
	caminito="/imagenes/"&a
	'se comprueba que la imagen existe
	If fso.FileExists(server.mappath(caminito)) Then
		Set dibujito = fso.GetFile( server.MapPath(caminito))
		'SE COPIA LA IMAGEN A UN DIRECTORIO TEMPORAL
		dibujito.Copy (request.ServerVariables("APPL_PHYSICAL_PATH")&"/temp/"&a
		'sale la imagen copiada
		response.write "<img src='/temp/"&a&"'>"
	else 'si no existe la imagen original, saca una genérica
		response.write"<img src='/imagenes/no_imagen.gif'>"
	end if
	set fso=nothing
end function%>

Y se le llama así

Código:

<%call enseñame_la _imagen_mentirosa("imagen_a_copiar.jpg")%>

para borrar las imágenes del directorio temporal, basta poner en la página índice,
o mejor si hay una intro en flash o algo así ésto para que lo haga en segundo plano

Código:

<%
Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder(server.MapPath("/temp/"))
   Set fc = f.Files
   For Each f1 in fc
          'borra las imágenes con más de 1 minuto de vida
	  if (minute(now()-f1.DateLastAccessed)>=1) then
	  	f1.delete
	end if
   Next
%>

sé que es algo más pesado que enseñar al imagen a secas, pero quien algo quiere,
algo le cuesta.
SALUDOS,

verinchi · #59 (**permalink**) 29/03/2005, 14:33

Código que sirve para generar desde una cadena de cualquier extensión, cadenas imprimibles del tamaño que se quiera.

Código:

 
<%
Sub Ren(vec,renglon)
'Funcion renglonado
'Definición de variables
Dim tempo, ctotal, i
tempo=""    'Variable que contendrá el renglón imprimible en cada ocasión
i=0	 'Indice para recorrer la extensión del vector generado por split
ctotal="Cadena de texto que vamos a renglonar"
vec=Split(ctotal, " ")	 'Desmiembra la cadena original en un vector de extensión "cantidad de palabras de la cadena"
while i<=ubound(vec)		 'Recorre todos los elementos del vector generado por el split.
if (len(tempo)+len(vec(i))<=renglon) Then		 'Calcula que el tamaño del renglón imprimible no exceda la cantidad deseada
if len(tempo)=0 then			 'Si es la primera palabra que carga en el renglón, no le concatena espacio en el inicio
tempo=tempo&vec(i)
else
tempo=tempo&" "&vec(i)			 'Si no es la primera, antes de colocar el contenido del elemento del vector concatena un espacio
End If
else 'Cuando el renglón imprimible obtiene su tamaño máximo
Response.Write(tempo)			 'Imprime el renglón
Response.Write("<br>")			'Imprime un salto de línea
tempo=""							 'Vacía el vector. Lo reinicia.
i=i-1							 'Retrocede una posición para no omitir la última palabra leída, que generara el exceso de renglón y la impresión.
end if
i=i+1					'Incremento de elemento en el vector.
Wend
'Al salir del bucle general, controla que tempo imprima la última línea, que muy probablemente no haya llegado a cien como para imprimirse
 
if(len(tempo)<>0) Then 
Response.Write(tempo)
Response.Write("<br>")
End if
End Sub
%>

Esto lo llamamos

Código:

<%Ren cadena,tamañorenglon 'Tamaño renglón puede ser un número una variable con valor numérico %>

Ya ves Al zu que al fín me pongo a estandarizar un poco mi código!!! y ya era hora jajaja!!!

ESPERO QUE LES SEA DE UTILIDAD!!!

TurKa · #60 (**permalink**) 30/03/2005, 12:41

Convertir mayúsculas y minúsculas "Tipo frase."
- Son dos funciones que pueden utilizarse en forma independiente o conjunta.
- Lo que hace, es imitar el efecto de "Convertir mayúsculas y minúsculas «Tipo oración.»" del MS Word.
- Es ideal para convertir los textos traídos de un formulario.

Código:

Function TipoFrase(cadenaAconvertir)
	contenido = ""
	palabra = Split(cadenaAconvertir," ")
		For I = 0 To UBound(palabra)
			contenido = contenido & LCase(palabra(I)) & " "
		Next
	PrimeraLetra = UCase(Left(contenido,1))
	frase = PrimeraLetra&Right(contenido,Len(contenido)-1)
	TipoFrase = frase
End Function

Function TipoParrafo(parrafoAconvertir)
	contenido = ""
	frase = Split(parrafoAconvertir,". ")
		For I = 0 To UBound(frase)
			contenido = contenido & UCase(Left(frase(I),1))&LCase(Right(frase(I),Len(frase(I))-1))&". "
		Next
	parrafo = Left(contenido,Len(contenido)-2)
	frase = Split(parrafo,chr(10))
		For I = 0 To UBound(frase)
			contenido2 = contenido2 & UCase(Left(frase(I),1))&Right(frase(I),Len(frase(I))-1)&chr(10)
		Next
	TipoParrafo = contenido2
End Function