13/10/04, 18:46:30
|
#1 (permalink)
|
Registrado: nov 2002
Ubicación: Hangar 18
Mensajes: 1.189
|
Biblioteca de Clases,Funciones y Sub-rutinas.
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.
Última edición por Muzztein fecha: 13/10/04 a las 18:57:02.
|
|
|
|
13/10/04, 18:55:35
|
#2 (permalink)
|
Registrado: nov 2002
Ubicación: Hangar 18
Mensajes: 1.189
|
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

|
|
|
|
14/10/04, 11:11:35
|
#3 (permalink)
|
|
Moderatroll
Registrado: nov 2002
Mensajes: 6.955
|
Ú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,
__________________
¡datos...datos...DAATOOOSSS!
Última edición por u_goldman fecha: 14/10/04 a las 11:12:54.
|
|
|
|
14/10/04, 15:45:27
|
#4 (permalink)
|
|
Moderador
Registrado: nov 2002
Ubicación: 34.517 S, 58.500 O
Mensajes: 11.966
|
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:
Cita:
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>
__________________
···---···
|
|
|
|
14/10/04, 16:59:04
|
#5 (permalink)
|
Registrado: nov 2002
Ubicación: Cali - Colombia
Mensajes: 1.638
|
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
|
|
|
|
14/10/04, 18:30:55
|
#6 (permalink)
|
|
Moderatroll
Registrado: nov 2002
Mensajes: 6.955
|
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
Cita:
MaxID = GetMyMaxId("tabla", "campo")
Salu2,
__________________
¡datos...datos...DAATOOOSSS!
Última edición por u_goldman fecha: 15/10/04 a las 10:44:23.
|
|
|
|
15/10/04, 08:34:34
|
#7 (permalink)
|
|
Moderador
Registrado: nov 2002
Mensajes: 6.260
|
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>
|
|
|
|
15/10/04, 08:38:55
|
#8 (permalink)
|
|
Moderador
Registrado: nov 2002
Mensajes: 6.260
|
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
%>
|
|
|
|
15/10/04, 10:04:19
|
#9 (permalink)
|
Registrado: may 2003
Mensajes: 829
|
Cita:
Originalmente publicado 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
|
|
|
|
15/10/04, 11:25:26
|
#10 (permalink)
|
|
Moderador
Registrado: nov 2002
Ubicación: 34.517 S, 58.500 O
Mensajes: 11.966
|
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 
__________________
···---···
Última edición por Al Zuwaga fecha: 18/10/04 a las 18:09:23.
|
|
|
|
17/10/04, 16:47:02
|
#11 (permalink)
|
Registrado: nov 2002
Ubicación: Madrid
Mensajes: 1.890
|
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.
__________________
¡¡NO A LA GUERRA!!
Si ponemos a nuestros mensajes títulos adecuados, la gente se animará más a abrirlos y resultarán más útiles en las busquedas. ¡No a los ayuuudaaa, urgenteee y similares!
|
|
|
|
18/10/04, 06:39:44
|
#12 (permalink)
|
Registrado: nov 2002
Ubicación: Hangar 18
Mensajes: 1.189
|
Conexiones a base de datos.
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 !!!!!!!! 
|
|
|
|
18/10/04, 10:36:50
|
#13 (permalink)
|
|
Moderador
Registrado: nov 2002
Ubicación: 34.517 S, 58.500 O
Mensajes: 11.966
|
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") &"')"
__________________
···---···
Última edición por Al Zuwaga fecha: 18/10/04 a las 10:39:53.
|
|
|
|
18/10/04, 16:02:05
|
#14 (permalink)
|
|
Moderador
Registrado: nov 2002
Ubicación: 34.517 S, 58.500 O
Mensajes: 11.966
|
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.
__________________
···---···
Última edición por Al Zuwaga fecha: 21/10/04 a las 12:28:52.
|
|
|
|
18/10/04, 18:20:02
|
#15 (permalink)
|
|
Moderador
Registrado: nov 2002
Ubicación: 34.517 S, 58.500 O
Mensajes: 11.966
|
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)
__________________
···---···
Última edición por Al Zuwaga fecha: 07/07/05 a las 15:27:37.
|
|
|
|
20/10/04, 14:18:58
|
#16 (permalink)
|
|
Moderador
Registrado: nov 2002
Ubicación: 34.517 S, 58.500 O
Mensajes: 11.966
|
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 
__________________
···---···
|
|
|
|
23/10/04, 10:09:10
|
#17 (permalink)
|
Registrado: nov 2002
Ubicación: Hangar 18
Mensajes: 1.189
|
EscribeEnDisco
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.

|
|
|
|
23/10/04, 12:09:12
|
#18 (permalink)
|
Registrado: nov 2002
Ubicación: Hangar 18
Mensajes: 1.189
|
Funciones para hacer lo9gins e inserts mas seguros
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

|
|
|
|
23/10/04, 12:38:51
|
#19 (permalink)
|
Registrado: sep 2004
Mensajes: 2.105
|
más prevención de sql injection
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,"--","")
|
|
|
|
|