Biblioteca de Clases,Funciones y Sub-rutinas.

[Muzztein]

Como ya lo propusieron por ahi, la idea es publicar clases, funciones y subrutinas de uso cotidiano que automaticen tediosas lineas de codigo que repetimos una y otra vez.

¿El fin ultimo ?

1) Lograr hacer un seudo lenguaje propio de nosotros que separe correctamente el "Que hacer" del "Como hacerlo".

2) Hacer un codigo mas facil de leer para facilitar la mantencion de nuestros sistemas.

3) Ahorrar tiempo de mantencion y elaboracion

4) Ayudarnos mutuamente

Como hacerlo: Pegar el codigo y comentar para que sirve y en que circunstancias sirve.

Reglas :
1) Los codigos pueden ser modificados y son de uso público.
2) Las clases, funciones o sub rutinas , deben tener nombres en español y explicitar claramente para que sirven.

Empecemos.

[Muzztein]

Nivel: Facilitas

Sub Rutina hecha para ahorrarse el escribir de mas.
Escribe en pantalla el string deseado seguido de un salto de carro, ideal para armar xml y escribir java scripts dinamicamente o cosas por el estilo.

Código:

sub escribe(str)
response.write str & chr(10)
end sub

Sub rutina familiar a la anterior, la diferencia que en vez de salto de carro imprime un br de HTML lo que permite imprimir en pantalla mas ordenadamente algun dato X.

Código:

sub imprime(str)
response.write str & "<br>"
end sub

Sub rutina que termina la ejecucion, Hecha con el finde de escribir poco.

Código:

sub termina()
response.end
end sub

Sub rutina que imprime un mensaje de alerta de Java Script, Depende de la funcion "escribe".

Código:

sub mensaje(txt)
escribe "<script>"
escribe "alert(""" & txt & """)"
escribe "</script>" 
end sub

Sub rutina que dado un pop up, lo cierra y recarga el marco que abrio dicho pop up. Especial para mantenedores que actualizan datos en otras pantallas.

Código:

sub cierra_y_recarga
escribe "<script>" 
escribe "window.opener.location.reload();"
escribe "window.close();"
escribe "</script>" 
end sub

[u_goldman]

Útil para ver los elementos que llegan de un querystring o de un form

Código:

Sub Depura(accion)
 If accion = "qs" Then
   For each elemento in request.querystring
      Response.Write elemento & " = " & request.querystring(elemento) & "<br>"
   Next
 ElseIf accion = "frm" Then
   For each elemento in request.form
      Response.Write elemento & " = " & request.form(elemento) & "<br>"   
   Next
 End If
 Response.End
End Sub

Depura "frm"

Salu2,

[AlZuwaga]

Una recién salida del horno
Sirve para generar un <select> con opciones obtenidas de una base de datos.
Hay que aclarar que la conexión a la BD y el recordset ya deben estar presentes en el script:

Código:

Function genera_select(txtNombre_ID, numLineas, Multi, txtClass, txt1erOpcion, objRecordset, campoValue, campoDesc)
	If Multi = "Multiple No" Then Multi = "" Else Multi = "Multiple"
	Response.Write "<select name=""" & txtNombre_ID & """ id=""" & txtNombre_ID & """ size=""" & numLineas & """ class=""" & txtClass & """" & Multi & ">" & VBCrLf
	If txt1erOpcion <> "" Then Response.Write "<option value="""">" & txt1erOpcion & "</option>" & VBCrLf
	Do While Not objRecordset.EOF
		Response.Write "<option value=""" & objRecordset(campoValue) & """>" & objRecordset(campoDesc) & "</option>" & VBCrLf
	objRecordset.MoveNext
	Loop
	Response.Write "</select>" & VBCrLf
End Function

Se la llama así:

Código:

genera_select "nombre_del_select", "cantidad_de_lineas", "es_multiple", "nombre_de_clase", "primero_a_mostrar", nombre_del_recordset, "campo_en_value", "campo_a_mostrar"

En donde:

nombre_del_select es el nombre que se le dará al select (alfanumerico)
cantidad_de_lineas es la cantidad de líneas que mostrará (numérico)
es_multiple indica si permitirá selecciones múltiples (alfanumerico. "Multiple No" para NO y vacío o cualquier otra cosa para SI)
nombre_de_clase le asigna un estilo al <select> (alfanumerico)
primero_a_mostrar el primer elemento del <select> (alfanumerico. Dejar vacío para ignorarlo)
nombre_del_recordset es el nombre del objeto recordset del que tomaran los datos (objeto. no va entre comillas)
campo_en_value es el nombre del campo de la BD que se le asignará al value del <select> (alfanumerico)
campo_a_mostrar es el nombre del campo de la BD que se le asignará a lo que muestre el <select> (alfanumerico)

Ejemplo de uso:

Código:

<form...>
<% genera_select "MiSelect", "1", "Multiple No", "estilo10", "Seleccione una opción", Rs, "ID", "Descripcion"  %>
</form>

[lexus]

se usa en el caso en qeu tengamos muchas bases de datos en un mismo sitio,

Código:

 
function conx_bd(nombre_bd)
'#####################################
  'CONEXION A BASE DE DATOS 
  'EL PARAMETRO nombre_bd CORRESPONDE AL NOMBRE DE LA
' BASE DE DATOS QUE SE DESEE ABRIR
'#####################################
con = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
"Data Source="& Server.MapPath("carpeta/"&nombre_bd&".mdb")&";"  & _
"Jet OLEDB:Database Password=tuclaveaqui;"
set conx = Server.Createobject("adodb.connection")
conx.open con
conx_bd = conx
end function

el llamado lo hacemos asi.

Código:

 
sql= "SELECT * FROM tutabla"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open sql, conx_bd("tubasededatossinextencion"),  3, 3

a simple vista no parece util, pero cuanto tienes muchas bases de datos veras qeu te facilita mucho las cosas.

por cierto muy buena idea la de crear este post, se que nos sera muy util a todos.. espero qeu todos aportemos para hacer crecer esta biblioteca de funciones y subrutinas

[u_goldman]

Obtiene el máximo valor de un campo campo en "x" tabla, se necesita una conexión activa (en negritas), si es fin de archivo (EOF), regresa un 0

Código:

<%
Function GetMyMaxId(table, field)
	Set rsGetMyMaxId = Server.CreateObject("ADODB.Recordset")
	strSQLGetMyMaxId = "SELECT MAX(" & field & ") AS myMax FROM " & table
	rsGetMyMaxId.Open strSQLGetMyMaxId, ObjConn, 3, 3
	fnctMyMaxId = rsGetMyMaxId("myMax")
	If IsNull(fnctMyMaxId) Then
		fnctMyMaxId = 0
	End If
	rsGetMyMaxId.Close
	Set rsGetMyMaxId = Nothing
	GetMyMaxId = fnctMyMaxId
End Function
%>

Llamada a la función

MaxID = GetMyMaxId("tabla", "campo")

Salu2,

[Myakire]

Sirve para ver las tablas que existen en la BD's.

Código:

<!-- #INCLUDE File="adovbs.inc" -->
<script runat=server LANGUAGE="VBSCRIPT">
  Dim oConn,rstSchema
  Set oConn = Server.CreateObject("ADODB.Connection")
  Set rstSchema = Server.createobject("ADODB.Recordset")
  oConn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("rebe_pad.mdb"))
  Set rstSchema = oConn.OpenSchema(adSchemaTables)
	response.write "<table>"
  Do Until rstSchema.EOF
     Response.Write "<tr><td>Tabla: " & rstSchema("TABLE_NAME")
     Response.Write "<td>Tipo: " & rstSchema("TABLE_TYPE")
     rstSchema.MoveNext
  Loop
  rstSchema.Close 
  oConn.Close
</script>

[Myakire]

Obtiene el total de registros de una BD's (a mi me los han preguntado, ¿qué se le va a hacer?, tal vez a otro también se los pregunten, ), solo falta agregar la conexión.

Código:

set adoRs = Server.CreateObject("adodb.recordset")
Query = "SELECT name FROM  sysobjects WHERE (xtype = 'U') AND (status > 0)"
adoRs.Open Query,cnn
suma = 0
%>
<table><tr><td>Nombre de la tabla<td>registros<%
while Not adoRs.EOF
     set adoRs2 = Server.CreateObject("adodb.recordset")
     adoRs2.CursorLocation = adUseClient
     sql = "Select count(*) as reg from "&adoRs("name")	 
    adoRs2.Open sql,cnn
%><tr><td><%=adoRs("name")%><td><%=adoRs2("reg")%></tr><%
    suma = suma + adoRs2("reg")
    adors2.Close
    adors2 = null		
    adoRs.moveNext
wend
%></Table><%
response.write "<hr><br>Registros Totales: " & Suma
%>

[sqa212]

Iniciado por Myakire

Sirve para ver las tablas que existen en la BD's.

Código:

<!-- #INCLUDE File="adovbs.inc" -->
<script runat=server LANGUAGE="VBSCRIPT">
  Dim oConn,rstSchema
  Set oConn = Server.CreateObject("ADODB.Connection")
  Set rstSchema = Server.createobject("ADODB.Recordset")
  oConn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("rebe_pad.mdb"))
  Set rstSchema = oConn.OpenSchema(adSchemaTables)
	response.write "<table>"
  Do Until rstSchema.EOF
     Response.Write "<tr><td>Tabla: " & rstSchema("TABLE_NAME")
     Response.Write "<td>Tipo: " & rstSchema("TABLE_TYPE")
     rstSchema.MoveNext
  Loop
  rstSchema.Close 
  oConn.Close
</script>

Se puede poner tambien esto:
Response.Write "<td>Ubicacion: " & rstSchema("TABLE_CATALOG")
Saludos

[AlZuwaga]

Reemplaza los retornos de carro por un salto de línea HTML e interpreta TAB's en el texto.

ATENCIÓN: Eliminar de &-#09; el guión rojo (ocurre que el foro interpreta el TAB en vez de muestrar su código)

Código:

<%
Function txt2htm(txt)
	txt2htm = txt
	txt2htm = Replace(txt2htm, VBCrLf, "<br>" & VBCrLf)
	txt2htm = Replace(txt2htm, CHR(9), "<pre style='display:inline'>&-#09;</pre>")
End Function
%>

Se la llama así:

Código:

<% Response.Write txt2htm(Fuente_de_datos) %>

En donde Fuente_de_datos puede ser el campo de una BD, el contenido de un archivo de texto, el de un campo de formulario, etc.


Editado el 18/10/2004 porque me tengo que quitar la maldita costumbre de meter "responseS.writeS" dentro de la funciones

[Bravenap]

Presentar un texto tabulado en una tabla

A veces, se tienen ciertos archivos de texto que funcionan como una base de datos: cada línea es un registro y los campos están separados por un tabulador.

Esta es una subrutina para poder presentar en una tabla esos datos y que sea más fácil su lectura. La acabo de hacer y funciona, aunque claro está, es muy depurable y adaptable.

La subrutina es la siguiente:

Código:

Sub tabularTexto(archivo)

Dim objFSO
Dim objTextStream
Dim registro()
Dim numCampos,numRegistros
Dim campo
Dim i,n

Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(archivo) Then
	Set objTextStream = objFSO.OpenTextFile(archivo, 1) 'Método 1: "sólo lectura"
	i=0
	Do while not objTextStream.AtEndOfStream
      		Redim Preserve registro(i)
		registro(i) = objTextStream.ReadLine
		i = i + 1
	Loop


	numCampos = Ubound(Split(registro(0),Chr(9)))+1
	numRegistros = i

	Response.Write("<table border=1>")
	Response.Write("<tr>")
	For n=0 to numCampos-1
		Response.Write("<th>Campo " & n & "</th>")
	Next
	Response.Write("</tr>")
	For i=0 to Ubound(registro)
		Response.Write("<tr>")
		campo = Split(registro(i),Chr(9))
		For n=0 to numCampos-1
			Response.Write("<td>")
			Response.Write(campo(n))
			Response.Write("</td>")
		Next
		Response.Write("</tr>")
	Next
	Response.Write("</table>")
	Response.Write("Campos: " & numCampos & "<br>Registros: " & i)

Else
	Response.Write("No existe el archivo " & archivo)
End If

End Sub

Se le pasa la ruta completa del archivo a leer, por ejemplo:

tabularTexto(Server.MapPath("ejemplo.txt"))

y el contenido de ejemplo.txt es algo así:

Código:

campoA1	campoA2
campoB1	campoB2

Si en lugar de tabuladores tenemos, por ejemplo, puntos y comas (;) no hay más que cambiar esta línea:

Código:

campo = Split(registro(i),";")

Un saludo.

[Muzztein]

a todos !

Aqui ahora les coloco una conjunto de rutinas y funciones que permiten conectarse a cualquier base de datos transaccional sin DSN (probado en sql server y oracle)

En un include colocar

Código:

	dim dbcSuperConexion
	db_provider = "sqloledb" 'tipo de conexion
	db_userid = "test" ' usuario a usar 
	db_password = "test" ' password del usuario a usar
	db_database = "test" ' nombre de la base de datos
	db_datasource = "10.10.10.10" ' Numero IP o Nombre del servidor que contiene la base de datos



sub abre_conexion

Set dbcSuperConexion = Server.CreateObject("ADODB.Connection")
  On Error Resume Next
            dbcSuperConexion.Open "Provider=" & db_Provider & ";" _
                    & "Data Source=" & db_DataSource & ";" _
                    & "User Id=" & db_UserID & ";" _
                    & "Password=" & db_Password & ";" _
                    & "Database=" & db_Database & ";"
                    
   If Err.Number <> 0 Then
	 escribe "Error en la Conexion a la Base de Datos"
   end if
end sub


sub cierra_conexion
dbcSuperConexion.Close
Set dbcSuperConexion = Nothing
end sub


function ejecuta(strsql)
	on error resume next
	Set dbcRec = Server.CreateObject("ADODB.RecordSet")
        Set dbcRec = dbcSuperConexion.Execute(strSQL)
        If Err.Number <> 0 Then
        	ejecuta = False
        else
        	ejecuta = True
        end if
        dbcRec.Close
	Set dbcRec = Nothing
end function

y el codigo quedaria asi de simplecito y facil de leer

Código:

abre_conexion
strsql = "poner aqui string sql a ejecutar"
ejecuta(strsql)
cierra_conexion

TA DA !!!!!!!!

[AlZuwaga]

Reemplaza la comilla simple, que jode a las sentencias SQL, por dos de ellas seguidas. Además, evita el "SQL injection"

Código:

<%
Function RyL(elemento)
	'RyL significa Recibe y Limpia
	If Request.QueryString(elemento).Count > 0 Then RyL = Request.QueryString(elemento)
	If Request.Form(elemento).Count > 0 Then RyL = Request.Form(elemento)
	RyL = Replace(RyL, "'", "''")
	' Agregar aquí todos los Replace() que crean necesarios
End Function
%>

Ejemplo de uso:

Código:

SQL = "INSERT INTO tabla (Campo1, Campo2) VALUES ('"& RyL("Elemento1") &"', '"& RyL("Elemento2") &"')"

[AlZuwaga]

Función para hacer insert's "simples" a una tabla (está en desarrollo)
Si se trata de un insert algo más complejo con "parseo" de cadenas, validaciones server-side, etc, mejor dejar esto de lado y construir la sentencia SQL normalmente

Todos los campos del formulario deberán llamarse como los campos de la tabla donde se insertarán y tendrán como prefijo uno de los siguientes (para todos los casos, sin las comillas):
- "str" para datos que se inserten en campos text *
- "num" para datos que se inserten en campos numéricos
- "s_n" para datos que se inserten en campos si/no
- "ni_" para todo campo del formulario que no se desee insertar en la BD (ej: el botón submit )

Los campos tipo 'si/no' deberán tener valor predeterminado = No en la tabla.
El motivo de esto es que si el checkbox no ha sido 'checkeado', no aparece en la colección FORM. Y si no aparece, no se puede establecer el valor como FALSE... quedando su valor como el valor predeterminado del campo en la tabla (o ninguno)

Código:

<%
Function Insertar(Tabla)
	' Empiezo a construir la sentencia SQL
	SQL = "INSERT INTO " & Tabla & " ("
	' Reviso la colección FORM para colocar el nombre de los campos en la sentencia SQL
	For i = 1 to Request.Form.Count()
		Campo = Request.Form.key(i)
		' Verifico que el campo sea "insertable"
		If Left(Campo, 3) <> "ni_" Then
			'El campo es "insertable"
			Campo = Replace(Campo, "str", "")
			Campo = Replace(Campo, "num", "")
			Campo = Replace(Campo, "s_n", "")
			SQL = SQL & Campo & ", "
		End if
	next 
	'Quito la última comilla, el espacio final y concateno
	SQL = Mid(SQL, 1, Len(SQL) - 2)
	SQL = SQL & ") VALUES ("
	'Recorro nuevamente la colección FORM para seguir generando la sentencia SQL
	For i = 1 to Request.Form.count()
		' Obtengo el tipo de dato, el nombre de campo y el valor del mismo
		Tipo = Left(Request.Form.key(i), 3)
		Campo = Mid(Request.Form.key(i),4 , Len(Request.Form.key(i)))
		Valor = Request.Form.item(i)
		
		' Si se trata de una campo text lo coloco entre apóstrofes
		If Tipo = "str" Then SQL = SQL & "'" & Replace(Valor, "'", "''") & "', "
		' Si se trata de un campo numérico va sin los apóstrofes
		If Tipo = "num" Then
			SQL = SQL & Valor & ", "
			' Si el valor ingresado no es un número, arroja un mensaje de error y detiene el proceso
			If NOT IsNumeric(Valor) Then
				Response.Write "<STRONG>Error:</STRONG> " _
					& "El campo '" & campo & "' recibe valores incorrectos" _
					& " (<span style='color:#FF0000'>" & Valor & "</span>). Debería ser un número válido.<br>" _
					& "La operación no se ha efectuado."
				Response.End
			End if
		End if
		' Si es un campo si/no convierto a True (-1) si es que ha sido 'checkeado'.
		' Si no ha sido 'checkeado' no lo puedo identificar, así que el campo en la tabla deberá...
		'... tener como valor predeterminado False (0, No o lo que corresponda)
		If Tipo = "s_n" Then
			If Valor <> "" Then Valor = -1 Else Valor = 0
			SQL = SQL & Valor & ", "
		End if
		
	next 
	' Nuevamente elimino la última comilla y el espacio
	SQL = Mid(SQL, 1, Len(SQL) - 2)
	' Finalmente, cierro la sentencia SQL
	SQL = SQL & ")"
	
	' Le doy a la función el valor de la sentencia SQL
	Insertar = SQL
End Function
%>

Formulario de ejemplo:

Código:

<form ...>
Nombre: <input name="strNombre" type="text">
Apellido: <input name="strApellido" type="text">
Edad: <input name="numEdad" type="text">
Este no se guarda: <input name="ni_Control" type="text">
Activo? <input name="s_nActivado" type="checkbox" value="checkbox">
<input name="ni_Submit" type="submit" value="Enviar">
</form>

Se la llama así:

Código:

<%
'Reemplazar Response.Write por objetoConexion.Execute
Response.Write(Insertar("MiTabla"))
%>

Todavía no la usé ni sé si vale la pena usarla, pero se me ocurrió hacerla


Correcciones:
- 21/10/2004 La línea marcada con * decía "txt", como prefijo, cuando debía decir "str". Fue modificado en el texto original.

[AlZuwaga]

Sirve para cortar cadenas de caracteres muy largas (que no contengan espacios) y así evitar que desformen nuestras tablas al, por ejemplo, dejar un mensaje en un foro.
Importante: Hace uso de la función txt2htm(txt) así que ésta también debe estar presente al momento de usarla.

Código:

<%
Function CortarLargos(a_cortar, Largo, Separador)

arrCadena = Split(a_cortar, " ")

For i = 0 to UBound(arrCadena)
If Len(arrCadena(i)) > Largo Then

Veces = (Len(arrCadena(i)) \ Largo) + 1

For j = 1 To Veces
Tmp = Mid(arrCadena(i),(j*Largo) - (Largo - 1), Largo)
Tmp2 = Tmp2 & Tmp & Separador
Next

Tmp2 = Left(Tmp2, Len(Tmp2) - Len(Separador))
arrCadena(i) = Tmp2
End if

Next

CortarLargos = Join(arrCadena)
CortarLargos = txt2htm(CortarLargos)

End Function
%>

Se la llama así

Código:

<% Response.Write CortarLargos(Fuente_de_datos, "Cantidad_de_caracteres", "separador_usado") %>

En donde:

-Fuente_de_datos puede ser el campo de una BD, etc.. (variable)
-Cantidad_de_caracteres es la cantidad máxima de caracteres permitidos para una palabra laaaaargaaaa (numerico)
-separador_usado será lo que divida la palabra larga que se exceda de Cantidad_de_caracteres (string)

[AlZuwaga]

Muestra el criterio buscado en el contexto del texto donde se encuentre.
Cuando buscamos una palabra en, por ejemplo, una base de datos de noticias, lo que solemos hacer es mostrar los, supongamos, 250 primeros caracteres de un campo. Qué pasa si la palabra buscada no aparece dentro de esos 250 caracteres? Pues, obvio: que no se muestra en ese pequeño extracto. Para solventar ese inconveniente, se me ocurrió hacer esto:

Código:

Function MostrarResult(numLongitud, strTxt, strCriterio)

	varAparicion1 = InStr(LCase(strTxt), LCase(strCriterio))
	
	If varAparicion1 > numLongitud Then
		Mitad = (numLongitud - Len(strCriterio)) \ 2
		PrimerMitad = Mid(strTxt, varAparicion1 - Mitad, Mitad)
		SegundaMitad = Mid(strTxt, varAparicion1 + Len(strCriterio), Mitad)
		Recorte = "...<EM>" & PrimerMitad & "<STRONG>" & strCriterio & "</STRONG>" & SegundaMitad & "</EM>..."
	Else
		Recorte = Left(strTxt, numLongitud + Len(strCriterio))
		Recorte = "<EM>" & Replace(Recorte, strCriterio, "<STRONG>" & strCriterio & "</STRONG>",1,1000,1) & "</EM>..."
	End if
	MostrarResult = Recorte
End Function

Se la llama así:

Código:

Response.Write MostrarResult(cantidad_caracteres, Fuente_de_datos, el_criterio)

En donde:
-cantidad_caracteres es la cantidad de caracteres que se mostrará a manera de extracto
-Fuente_de_datos puede ser el campo de una BD, etc..
-el_criterio es justamente lo que se está buscando dentro de Fuente_de_datos

Estaría bueno modificarla para que, además de hacerlo para la primer coincidencia, haga lo mismo para las coincidencias restantes dentro del texto.. pero eso para otra oportunidad

[Muzztein]

Funcion que toma un texto y lo guarda en un archivo en el disco duro..


Obviamente se necesita tener poder de escritura sobre la carpeta donde se esta guardando el archivo.
Si es que se ejecuta multiples veces, la funcion abrirá el documento y le anexara la nueva entrada de texto.

Es especial para hacer tus propios LOGS y sistemas de control por el estilo.

Código:

Function EscribeEnDisco(texto,archivo)
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
   Dim fso, f, ts
   Set fso = CreateObject("Scripting.FileSystemObject")
   
   On Error Resume next
   Set f = fso.GetFile(archivo) 

  
   if Err.number <> 0 then
	 fso.CreateTextFile archivo  
	 Set f = fso.GetFile(archivo)
   End if
   
   Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)
   ts.Write texto & Vbcrlf
   ts.Close
   Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
   EscribeEnDisco = ts.ReadLine
   ts.Close
End Function

Para llamarla se hace asi.

Código:

EscribeEnDisco now , "c:\testing_datos.txt"

este ejemplo escribira la fecha actual en un documento y lo guardara en el archivo que se especifica.

[Muzztein]

Esta funcioncita lo que hace es preparar un string para hacer un login y evitar posibles jaqueos como el de insertar trozos de SQL para engañar la validacion del usuario, entre otras cosas.

Código:

function prepara_str_para_login(str)
str = trim(str)
str = lcase(str)
str = replace(str,"=","")
str = replace(str,"'","")
str = replace(str,"""""","")
str = replace(str," or ","")
str = replace(str," and ","")
str = replace(str,"(","")
str = replace(str,")","")
str = replace(str,"<","[")
str = replace(str,">","]")
prepara_str_para_login = str
end function

y esta otra funcioncita prepara un string para una insercion evitando las comillas y que te coloquen html, es la misma idea que el anterior , pero mas ajustada al asunto de los inserts

Código:

function prepara_str_para_insert(str)
str = trim(str)
str = replace(str,"'","''")
str = replace(str,"<","[")
str = replace(str,">","]")
prepara_str_para_insert = str
end function

[trasgukabi]

Se pueden añadir estas líneas a la función de Muzztein:

Código:

 
  str=replace(str,"--","")
  str=replace(str,"select","")
  str=replace(str,"insert","")
  str=replace(str,"update","")
  str=replace(str,"delete","")
  str=replace(str,"drop","")
  str=replace(str,"-shutdown","")
  str=replace(str,"--","")

[Muzztein]

topisimo, eso si. una consulta. Por que hay que tener cuidado con el "--"



aqui va otra funcioncita muy util

Sirve para chequear si es que un valor en una variable es numerico o no, en el caso de que no sea numerico o venga vacio o sea nulo, le asigna un valor por defecto.

Especial para chequear la entrada de algun ID

Código:

function checa_numerico_con_defecto(id,defecto)
	if id = "" or isnumeric(id) = false or isnull(id) = true then 
	checa_numerico_con_defecto = defecto
	else
	checa_numerico_con_defecto = id
	end if
end function

ejemplo:

id_class = checa_numerico_con_defecto(request("id_class"),2)

[trasgukabi]

Muzztein: Vete a http://clusty.com y escribe en la caja de texto
sql "--" , por ejemplo. ya verás que risas, ya.

"--" se usa para comentarios SQL en algunas bases de datos, pero en las que no, puede causar lo que ves ahí.

Un saludo.




Un buen artículo sobre SQL Injection en dos partes en el cual viene explicado el mal uso de -- (AY, PILLÍN, PILLÍN!!!! :-p ) en esta técnica:

**Los artículos son de Kriptopolis

1ª Parte

2ª Parte

[Muzztein]

Funcion util para evitar que un usuario ejecute una accion repetidas veces, como; inserciones,actualizaciones o busquedas que apañen el desempeño del sistema.

ejemplo de uso

Ejemplo que obliga esperar 30 segundos entre ejecucion de busquedas.

Código:

ultima_busqueda = session("ultima_busqueda")
hora_actual = now

if permite_accion(ultima_busqueda,hora_actual,"s",30) = true then
	session("ultima_busqueda") = now
	response.write  "puede ejecutar la busqueda"
else
	response.write  "NO puede ejecutar la busqueda"
end if

Codigo

Código:

function permite_accion(fecha_ultima_accion,fecha_intento_accion,Hora_Minuto_o_Segundo,cantidad_de_espera)

	if isdate(fecha_ultima_accion) = false or isdate(fecha_intento_accion)= false then
		permite_accion = true
	end if

   Select Case lcase(Hora_Minuto_o_Segundo)
      Case "hora"	     Hora_Minuto_o_Segundo = "h"
      Case "minuto"		 Hora_Minuto_o_Segundo = "n"
      Case "segundo"     Hora_Minuto_o_Segundo = "s"
      Case "h"			 Hora_Minuto_o_Segundo = "h"
      Case "m"			 Hora_Minuto_o_Segundo = "n"
      Case "s"			 Hora_Minuto_o_Segundo = "s"
      Case Else			 Hora_Minuto_o_Segundo = "n"
   End Select

   if isnumeric(cantidad_de_espera) = false or isnull(cantidad_de_espera) = true or cantidad_de_espera="" then
		permite_accion = true
   end if

	intervalo = datediff(hora_minuto_o_segundo,fecha_ultima_accion,fecha_intento_accion)
	
	if intervalo < cantidad_de_espera then
		permite_accion = false
	else
		permite_accion = true
	end if
end function

[edu007ar]

Esta función sirve para generar claves aleatorias especificando el listado de caracteres que puede incluir dicha clave.

-----------------------------------------------
Function generadordeclaves(longituddeclave)
char_array = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c")
Randomize()
Do While Len(salida) < longituddeclave
salida = salida & char_array(Int(8 * Rnd()))
Loop
generadordeclaves = salida
End Function
-----------------------------------------------

y se la llama de la siguiente manera

response.write generadordeclaves(9)

[edu007ar]

Esta otra función sirve para elegir un número aleatorio especificando un mínimo y un máximo:

---------------------------------------------
Function RandomNumber(inicio, fin)
Randomize()
RandomNumber = Int((fin - inicio + 1) * Rnd + inicio)
End Function
---------------------------------------------

y se la llama de la siguiente manera:

response.write RandomNumber(8, 55)

Esto va a devolver un número aleatorio entre 8 y 55

[edu007ar]

Y esta otra sirve para saber si un número es par o impar:

----------------------------------------------------
function paroimpar(num)
select Case abs(num) mod 2
case 0: paroimpar = "par"
case 1: paroimpar = "impar"
end select
end function
---------------------------------------------------

y se la llama de la siguiente manera:

response.write paroimpar(6324)

[Muzztein]

que buenas funciones.


aqui les dejo una SUB rutina muy util que Educa y entretiene

Lo que hace es una tablita conlos valores que existen en una sesion.

Ideal para saber como captar:

1) El ip del usuario que me visita
2) De donde me visita
3) Que sistema operativo tiene

entre otras cosas muy utiles.

Código:

Sub Imprime_Variables_servidor

	escribe "<TABLE border=""1""><TR><TD><B>Nombre Varaible de servidor</B></TD><TD><B>Valor</B></TD></TR>"
	For Each name In Request.ServerVariables 
		escribe "<TR><TD>" & name & "</TD><TD>" & Request.ServerVariables(name) & "</TD></TR>"
	Next
	escribe "</TABLE>"

end sub

Pruebenla, y recuerden que esta usando la sub rutina "escribe"

[AlZuwaga]

Crea enlaces en textos.
Acepta targets y estilos personalizados.
Los enlaces deben comenzar por http, es decir que no acepta direcciones del tipo www.loquesea.com ni ventas.loquesea.com

Código:

<%
Function CrearEnlaces(varTexto, strTarget, strClass)
	arrTexto = Split(varTexto, " ")
	
	For i = 0 To UBound(arrTexto)
		UltimoCaracter = Right(arrTexto(i), 1)
			If UltimoCaracter = "." Then arrTexto(i) = Left(arrTexto(i), Len(arrTexto(i)) - 1) & " " & UltimoCaracter
			If UltimoCaracter = "," Then arrTexto(i) = Left(arrTexto(i), Len(arrTexto(i)) - 1) & " " & UltimoCaracter
			If UltimoCaracter = ";" Then arrTexto(i) = Left(arrTexto(i), Len(arrTexto(i)) - 1) & " " & UltimoCaracter
		varTextoArreglado = Join(arrTexto)
	Next
	
	arrTexto2 = Split(varTextoArreglado, " ")
	
	For i = 0 To UBound(arrTexto2)
		HTTP = Left(LCase(arrTexto2(i)), 4)
			If HTTP = "http" Then
				URL = "<a href=""" & arrTexto2(i) & """ target=""" & strTarget & """ class=""" & strClass & """>" & arrTexto2(i) & "</a>"
				arrTexto2(i) = URL
			End if
		varTextoArreglado2 = Join(arrTexto2)
	Next
	varTextoArreglado2 = Replace(varTextoArreglado2, " . ", ". ")
	varTextoArreglado2 = Replace(varTextoArreglado2, " , ", ", ")
	varTextoArreglado2 = Replace(varTextoArreglado2, " ; ", "; ")
	CrearEnlaces = varTextoArreglado2
End Function
%>

Demo:

Código:

<%
Texto = "La siguiente es una dirección que tiene un punto al final (aunque podría haber tenido una coma u otro sígno de puntuación): http://www.forosdelweb.com/. Esta otra no http://www.google.com pero tiene un espacio y no tiene barra. Esta última no tiene nada al final, porque está al final del string y además tiene parámetros: http://www.google.com/search?hl=en&q=%22Club+Atl%C3%A9tico+Boca+Juniors%22"
Response.Write Texto
Response.Write "<br>"
Response.Write "<br>"
Response.Write CrearEnlaces(Texto, "_blank", "enlaces")
%>

Salud
PD: 100% mejorable

[trasgukabi]

Lo acabo de poner para responder a un post, pero mejor estará aquí:

DE TEXTO A BINARIO:

Código:

<%
Dim C
Dim DD
Dim EE
Dim BinArray(7)
Dim temporal
Dim nuevacadena
cadena="Hola"
For C = 1 To Len(cadena)
			DD = Asc(Mid(cadena, C, 1))
			
			BinArray(7) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(6) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(5) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(4) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(3) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(2) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(1) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(0) = CStr(DD Mod 2)
			
			For EE = 0 To UBound(BinArray)
				temporal = temporal & BinArray(EE)
			Next
			
			nuevacadena = nuevacadena & temporal
			
			temporal = ""
			
		Next
		response.Write(nuevacadena)
	%>

DE BINARIO A TEXTO:

Código:

<%
Bintext="01001000011011110110110001100001"
Dim BinChar
		Dim CharX
		Dim convertido
		Dim Z
		Dim NewChar
		Dim Bx
		Dim BBx
		
		For Bx = 1 To Len(BinText)
			BinChar = Mid(BinText, Bx, 8)
			Z = 128
			NewChar = 0
			
			For BBx = 1 To 8
				CharX = Mid(BinChar, BBx, 1)
				If CharX = "1" Then
					NewChar = NewChar + Z
					Z = Z / 2
				Else
					Z = Z / 2
				End If
			Next
			
			convertido = convertido & Chr(NewChar)
			Bx = Bx + 7
			
		Next
		
		BinText = convertido
		response.Write(bintext)
	%>

Saludos, monstruos.

[Carlos_Campos]

Funcion para quitar acentos

Código:

Function SinAcentos(str) 
  	Dim intI, strCar, Dev
    	Dev = ""
    	For intI = 1 To Len(str)
      		strCar = Mid(str, intI, 1)
      		Select Case strCar
			Case "à": Dev = Dev & "a"
			Case "á": Dev = Dev & "a"
			Case "è": Dev = Dev & "e"
			Case "é": Dev = Dev & "e"
			Case "í": Dev = Dev & "i"
			Case "ò": Dev = Dev & "o"
			Case "ó": Dev = Dev & "o"
			Case "ú": Dev = Dev & "a"
			Case Else: Dev = Dev & strCar
      		End Select
    	Next
    	SinAcentos = Dev
End Function

[Carlos_Campos]

Y aqui paso algunas funciones de WMI (Windows Management Instrumentation). Tienes que tener unas variables globales, llamadas WMIUSER, WMISERVER y WMIPASSWD (El usuario y password deben de tener permisos en las maquinas destino.)

Devuelve el nombre de la maquina si introduces una IP en WMIServer

Código:

Function Nombre()
	Dim objLocator, objService, objInstance, item
	Nombre = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select caption from win32_computersystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		Nombre = Nombre & item.caption & "|"
	Next
	Nombre = Left(Nombre,Len(Nombre)-1)
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing	
End Function

Devuelve la Marca de la maquina

Código:

Function Marca()
	Dim objLocator, objService, objInstance, item
	Marca = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select manufacturer from win32_computersystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		Marca = Marca & item.manufacturer & "|"
	Next
	Marca = Left(Marca,Len(Marca)-1)
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function

Devuelve el modelo de la maquina

Código:

Function Modelo()
	Dim objLocator, objService, objInstance, item
	Modelo = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select model from win32_computersystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		Modelo = Modelo & item.model & "|"
	Next
	Modelo = Left(Modelo,Len(Modelo)-1)
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function

Devuelve el numero de CPUS

Código:

Function NumCPUS()	
	Dim objLocator, objService, objInstance, item
	NumCPUS = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select numberofprocessors from win32_computersystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		NumCPUS = NumCPUS & item.numberofprocessors & "|"
	Next
	NumCPUS = Left(NumCPUS,Len(NumCPUS)-1)
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function

Devolver el Sistema Operativo

Código:

Function SistemaOperativo()
	Dim objLocator, objService, objInstance, item
	SistemaOperativo = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select Caption from win32_operatingsystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		SistemaOperativo = SistemaOperativo & item.Caption & "|"
	Next
	SistemaOperativo = Left(SistemaOperativo, Len(SistemaOperativo)-1) 
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function

Devolver el Service Pack del Sistema Operativo

Código:

Function ServicePack()
	Dim objLocator, objService, objInstance, item
	ServicePack = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select ServicePackMajorVersion, ServicePackMinorVersion from win32_operatingsystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		ServicePack = ServicePack & item.ServicePackMajorVersion & "." & item.ServicePackMinorVersion & "|"
	Next
	ServicePack = Left(ServicePack, Len(ServicePack)-1) 
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function

Idioma del Sistema Operativo

Código:

Function Idioma()
	Dim objLocator, objService, objInstance, item
	Idioma = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select oslanguage from win32_operatingsystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		Idioma = Idioma & NombreIdioma(Hex(item.oslanguage)) & "|"
	Next
	Idioma = Left(Idioma, Len(Idioma)-1) 
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function

Private Function NombreIdioma(value)
	Dim dictLang
        Set dictLang = Server.CreateObject("Scripting.Dictionary")
        dictLang.Add "409","Ingles (US)"
        dictLang.add "809","Ingles (Britanico)"
        dictLang.Add "1009","Ingles (Canada)I"
        dictLang.Add "1409","Ingles (Nueva Zelanda)"
        dictLang.Add "0c09","Ingles (Australia)"
        dictLang.Add "1809","Ingles (Irlanda)"
        dictLang.Add "1c09","Ingles (America del Sur)"
        dictLang.Add "2009","Ingles (Jamaica)"
        dictLang.Add "2409","Ingles (Caribe)"
        dictLang.Add "40c","Frances (Estandard)"
        dictLang.Add "80c","Frances (Belgica)"
        dictLang.Add "100c","Frances (Suiza)"
        dictLang.Add "c0c","Frances (Canada)"
        dictLang.Add "140c","Frances (Luxemburgo)"
        dictLang.Add "407","Aleman (Estandard)"
        dictLang.Add "807","Aleman (Suiza)"
        dictLang.Add "c07","Aleman (Austria)"
        dictLang.Add "1007","Aleman (Luxemburgo)"
        dictLang.Add "1407","Aleman (Liechtenstein)"
        dictLang.Add "411","Japones"
        dictLang.Add "80a","Español (Mejico)"
        dictLang.Add "40a","Español (Tradicional)"
        dictLang.Add "c0a","Español (Moderno)"

        NombreIdioma = dictLang.Item(lcase(cstr(value)))
        Set dictLang = Nothing
End Function

Espero que sean de utilidad