Foros del Web » Programando para Internet » ASP Clásico »

Biblioteca de Clases,Funciones y Sub-rutinas.

 Estas en el tema de Biblioteca de Clases,Funciones y Sub-rutinas. en el foro de ASP Clásico en Foros del Web. acortar texto en ocasiones no queremos acortar el texto por cantidad de caracteres usando las funciones Left o Right, sino por cantidad de frases (divididas ...
Página 5 de 5 1234 5

  #121 (permalink)  
Antiguo 10/07/2010, 06:21
Avatar de IsaBelM
Colaborador
  
Fecha de Ingreso: junio-2008
Mensajes: 5.032
Antigüedad: 16 años, 8 meses
Puntos: 1012
Respuesta: Biblioteca de Clases,Funciones y Sub-rutinas.
acortar texto
en ocasiones no queremos acortar el texto por cantidad de caracteres usando las funciones Left o Right, sino por cantidad de frases (divididas por puntos) o saltos de líneas, etc

Código ASP: 
Ver original
  1. <%
  2. Function CortarStr(TextoOrg)
  3. i = 0
  4. Set objRE = new RegExp
  5. objRE.Pattern = "((([\wñáéíóú]+)\s)+([\wñáéíóú]+)\.(\s?))"
  6. objRE.IgnoreCase = True
  7. objRE.Global = True
  8. Set objExe = objRE.Execute(TextoOrg)
  9. For Each Coincidencia in objExe
  10. If i <= 1 then
  11. strAcortado  = strAcortado & Coincidencia.Value
  12. i = i +1
  13. Else
  14. Exit For
  15. End If
  16. Next
  17. Set objExe = nothing
  18. Set objRE = nothing
  19. CortarStr = strAcortado 
  20. End Function
  21.  
  22. texto = "Este es un texto que está compuesto por varia frase. Solo nos interesa mostrar por pantalla dos. Aunque el texto continua. No se mostrará."
  23. Response.Write CortarStr(texto)
  24. %>

en este caso se acorta el texto cuando llega a la posición del segundo punto. si se quiere que se acorte en la posición del tercer punto, solo hay modificar el if. si quieres acortar el texto cada salto de línea hay que modificar la expresión regular
__________________
if(ViolenciaDeGénero) {alert('MUJER ASESINADA');}
  #122 (permalink)  
Antiguo 17/09/2011, 05:59
 
Fecha de Ingreso: septiembre-2011
Mensajes: 8
Antigüedad: 13 años, 5 meses
Puntos: 0
Respuesta: Biblioteca de Clases,Funciones y Sub-rutinas.
yo tengo un asp con un monton de funciones para cosas comunes que ASP no tiene... Paso algunas para fechas:

'
'Funciones de Fecha
'
Function FormatFecha(Fecha, Formato)
If IsDate(Fecha) Then
tmpFormatFecha = Formato
tmpFormatFecha = Replace(tmpFormatFecha, "hh", Right("0" & Hour(Fecha), 2))
tmpFormatFecha = Replace(tmpFormatFecha, "nn", Right("0" & Minute(Fecha), 2))
tmpFormatFecha = Replace(tmpFormatFecha, "ss", Right("0" & Second(Fecha), 2))
tmpFormatFecha = Replace(tmpFormatFecha, "yyyy", Year(Fecha))
tmpFormatFecha = Replace(tmpFormatFecha, "yy", Right(Year(Fecha), 2))
tmpFormatFecha = Replace(tmpFormatFecha, "mmmm", MesLLargo(Fecha))
tmpFormatFecha = Replace(tmpFormatFecha, "mmm", MesLCorto(Fecha))
tmpFormatFecha = Replace(tmpFormatFecha, "mm", Right("0" & Month(Fecha), 2))
tmpFormatFecha = Replace(tmpFormatFecha, "ddddd", DiaSLargoMay(Fecha))
tmpFormatFecha = Replace(tmpFormatFecha, "dddd", DiaSLargo(Fecha))
tmpFormatFecha = Replace(tmpFormatFecha, "ddd", DiaSCorto(Fecha))
tmpFormatFecha = Replace(tmpFormatFecha, "dd", Right("0" & Day(Fecha), 2))
FormatFecha = tmpFormatFecha
End IF
End Function

Function MesLLargo(Fecha)
Select Case Month(Fecha)
Case 1: MesLLargo = "Enero"
Case 2: MesLLargo = "Febrero"
Case 3: MesLLargo = "Marzo"
Case 4: MesLLargo = "Abril"
Case 5: MesLLargo = "Mayo"
Case 6: MesLLargo = "Junio"
Case 7: MesLLargo = "Julio"
Case 8: MesLLargo = "Agosto"
Case 9: MesLLargo = "Septiembre"
Case 10: MesLLargo = "Octubre"
Case 11: MesLLargo = "Noviembre"
Case 12: MesLLargo = "Diciembre"
End Select
End Function

Function MesLCorto(Fecha)
Select Case Month(Fecha)
Case 1: MesLCorto = "Ene"
Case 2: MesLCorto = "Feb"
Case 3: MesLCorto = "Mar"
Case 4: MesLCorto = "Abr"
Case 5: MesLCorto = "May"
Case 6: MesLCorto = "Jun"
Case 7: MesLCorto = "Jul"
Case 8: MesLCorto = "Ago"
Case 9: MesLCorto = "Sep"
Case 10: MesLCorto = "Oct"
Case 11: MesLCorto = "Nov"
Case 12: MesLCorto = "Dic"
End Select
End Function

Function DiaSLargo(Fecha)
Select Case WeekDay(Fecha)
Case 1: DiaSLargo = "Domingo"
Case 2: DiaSLargo = "Lunes"
Case 3: DiaSLargo = "Martes"
Case 4: DiaSLargo = "Miercoles"
Case 5: DiaSLargo = "Jueves"
Case 6: DiaSLargo = "Viernes"
Case 7: DiaSLargo = "Sabado"
End Select
End Function

Function DiaSLargoMay(Fecha)
Select Case WeekDay(Fecha)
Case 1: DiaSLargoMay = "<b>DOMINGO</b>"
Case 2: DiaSLargoMay = "<b>LUNES</b>"
Case 3: DiaSLargoMay = "<b>MARTES</b>"
Case 4: DiaSLargoMay = "<b>MIÉRCOLES</b>"
Case 5: DiaSLargoMay = "<b>JUEVES</b>"
Case 6: DiaSLargoMay = "<b>VIERNES</b>"
Case 7: DiaSLargoMay = "<b>SABADO</b>"
End Select
End Function

Function DiaSCorto(Fecha)
Select Case WeekDay(Fecha)
Case 1: DiaSCorto = "Dom"
Case 2: DiaSCorto = "Lun"
Case 3: DiaSCorto = "Mar"
Case 4: DiaSCorto = "Mie"
Case 5: DiaSCorto = "Jue"
Case 6: DiaSCorto = "Vie"
Case 7: DiaSCorto = "Sab"
End Select
End Function

Function ComboAnios(Anio_Inicio, Anio_Fin, Anio_default)
str_ComboAnios = ""
For t_ComboAnios = Anio_Inicio To Anio_Fin
strSelected = ""
If Anio_default = 0 Then
If Year(Now) = t_ComboAnios Then strSelected = "selected"
Else
If Anio_default = t_ComboAnios Then strSelected = "selected"
End IF
str_ComboAnios = str_ComboAnios & "<OPTION " & strSelected & " Value=" & t_ComboAnios & ">" & t_ComboAnios & "</OPTION>"
Next
ComboAnios = str_ComboAnios
End Function

Function ComboMeses(Mes_default)
str_ComboMes = ""
For t_ComboMes = 1 To 12
strSelected = ""
If Mes_default = 0 Then
If Month(Now) = t_ComboMes Then strSelected = "selected"
Else
If Mes_default = t_ComboMes Then strSelected = "selected"
End IF
str_ComboMes = str_ComboMes & "<OPTION " & strSelected & " Value=" & t_ComboMes & ">" & MesLLargo("01/" & t_ComboMes & "/2000") & "</OPTION>"
Next
ComboMeses = str_ComboMes
End Function

Function ComboDias(Dia_default)
str_ComboDia = ""
For t_ComboDia = 1 To 31
strSelected = ""
If Dia_default = 0 Then
If Day(Now) = t_ComboDia Then strSelected = "selected"
Else
If Dia_default = t_ComboDia Then strSelected = "selected"
End IF
str_ComboDia = str_ComboDia & "<OPTION " & strSelected & " Value=" & t_ComboDia & ">" & t_ComboDia & "</OPTION>"
Next
ComboDias = str_ComboDia
End Function
  #123 (permalink)  
Antiguo 17/09/2011, 06:02
 
Fecha de Ingreso: septiembre-2011
Mensajes: 8
Antigüedad: 13 años, 5 meses
Puntos: 0
Respuesta: Biblioteca de Clases,Funciones y Sub-rutinas.
Algunas veces nos vienen querystrings que el usuario puede meter textos para explotar sitios, o una db que en un campo int admite nulos... cosas asi que hacen que las cuentas no cierren. La funcion Numero es mi caballito de batalla..

Esta emprolija el texto para que quede mas bonito.

Function Mayusculas(ByVal Texto)
strLetras = "abcdefghijklmnopqrstuvwxyzñàèìùòáéíóúí"
Texto = Lcase(Texto) & ""
ProximaMayuscula = True

For Mayusculas_t = 1 To Len(Texto)
strLetra = Mid(Texto, Mayusculas_t, 1)
If Instr(strLetras, strLetra) = 0 Then
ProximaMayuscula = True
Mayusculas = Mayusculas & strLetra
Else
If ProximaMayuscula = True Then
Mayusculas = Mayusculas & Ucase(strLetra)
Else
Mayusculas = Mayusculas & strLetra
End IF
ProximaMayuscula = False
End If
Next
End Function

'
'Funciones de Numeros
'
Function EsNumero(tmpNumero)
On Error Resume Next

EsNumero = False
'Saco cualquier espacio a los costados y me aseguro de que no sea Null
tmpNumero = Trim(tmpNumero & "")

'Si no esta vacio
If tmpNumero & "" <> "" Then
'Si no tiene espacios en el medio
If Instr(tmpNumero, " ") = 0 Then
'Ahora si podemos caer en el IsNumeric con seguridad
If IsNumeric(tmpNumero) Then
EsNumero = True
End IF
End IF
End IF
End Function

Function Numero(tmpNumero)
On Error Resume Next
'Igual que el EsNumero, pero devuelve el numero en lugar de True o False
'Si lo que se pasa no es un numero devuelve 0
Numero = 0
'Saco cualquier espacio a los costados y me aseguro de que no sea Null
tmpNumero = Trim(tmpNumero & "")

'Si no esta vacio
If tmpNumero & "" <> "" Then
'Si no tiene espacios en el medio
If Instr(tmpNumero, " ") = 0 Then
'Ahora si podemos caer en el IsNumeric con seguridad
If IsNumeric(tmpNumero) Then
Numero = tmpNumero
End IF
End IF
End IF
End Function
  #124 (permalink)  
Antiguo 17/09/2011, 06:03
 
Fecha de Ingreso: septiembre-2011
Mensajes: 8
Antigüedad: 13 años, 5 meses
Puntos: 0
Respuesta: Biblioteca de Clases,Funciones y Sub-rutinas.
Para crear un pass al azar.

Function GeneraPassword
Randomize Timer
Letras = ""
For t = 65 To 90
Letras = Letras & Chr(t)
Next
For t = 48 To 57
Letras = Letras & Chr(t)
Next

For t = 1 to 8
GeneraPassword = GeneraPassword & Mid(Letras, Int(RND * Len(Letras)) + 1, 1)
Next
End Function
  #125 (permalink)  
Antiguo 17/09/2011, 06:03
 
Fecha de Ingreso: septiembre-2011
Mensajes: 8
Antigüedad: 13 años, 5 meses
Puntos: 0
Respuesta: Biblioteca de Clases,Funciones y Sub-rutinas.
Para manejar archivos:

Function LeerArchivo(Archivo_Nombre)
If ExisteArchivo(Archivo_Nombre) Then
Set fs_LeerArchivo = Server.CreateObject("Scripting.FileSystemObject")
Set Arch = fs_LeerArchivo.OpenTextFile(Server.MapPath(Archivo _Nombre), 1)
LeerArchivo = Arch.ReadAll
Set Arch = Nothing
Set fs_LeerArchivo = Nothing
Else
ErrorLog "LeerArchivo", "No existe el archivo", Archivo_Nombre
End IF
End Function

Sub GuardarArchivo(Archivo_Nombre, strTexto)
On Error Resume Next

Response.Write "<!--1:" & Err.Description & " -->"
Set fs_GuardarArchivo = Server.CreateObject("Scripting.FileSystemObject")
Response.Write "<!--2:" & Err.Description & " -->"
Set Arch = fs_GuardarArchivo.CreateTextFile(Server.MapPath(Ar chivo_Nombre), True)
Response.Write "<!--3:" & Err.Description & " -->"
Arch.WriteLine strTexto
Response.Write "<!--4:" & Err.Description & " -->"
Arch.Close
Response.Write "<!--5:" & Err.Description & " -->"
Set Arch = Nothing
Response.Write "<!--6:" & Err.Description & " -->"
Set fs_GuardarArchivo = Nothing
Response.Write "<!--7:" & Err.Description & " -->"
End sub

Function ExisteArchivo(Archivo_Nombre)
On Error Resume Next
ExisteArchivo = False

If Archivo_Nombre <> "" Then
Set fs_ExisteArchivo = Server.CreateObject("Scripting.FileSystemObject")
ExisteArchivo = fs_ExisteArchivo.FileExists(Server.MapPath(Archivo _Nombre))
Set fs_ExisteArchivo = Nothing
End IF
End Function
  #126 (permalink)  
Antiguo 17/09/2011, 06:04
 
Fecha de Ingreso: septiembre-2011
Mensajes: 8
Antigüedad: 13 años, 5 meses
Puntos: 0
Respuesta: Biblioteca de Clases,Funciones y Sub-rutinas.
Para quitar todo el HTML de un texto:

Function RemoveHTML(strText)
Dim RegEx
Set RegEx = New RegExp
RegEx.Pattern = "<[^>]*>"
RegEx.Global = True
strText = Replace(LCase(strText), "", chr(10))
RemoveHTML = RegEx.Replace(strText, "")
End Function


Para manejo de mails: (Muy util !!)

Function IsEmail(strEmail)
IsEmail = True
strLetrasPermitidas = "abcdefghijklmnopqrstuvwxyz1234567890._-@"
strEmail = Lcase(strEmail)

For t = 1 To Len(strEmail)
strLetra = Mid(strEmail, t, 1)
If Instr(strLetrasPermitidas, strLetra) = 0 Then
IsEmail = False
End IF
Next

If IsEmail AND Len(strEmail) <= 5 Then IsEmail = False
If IsEmail AND Instr(strEmail, "@") = 0 Then IsEmail = False
If IsEmail Then
strNombre = Mid(strEmail, 1, Instr(strEmail, "@") - 1)
strDominio = Mid(strEmail, Instr(strEmail, "@") + 1)
IF Instr(strDominio, ".") > 1 AND Len(strDominio) > 4 Then
If Len(strNombre) <= 1 Then
IsEmail = False
End IF
Else
IsEmail = False
End IF
End IF
End Function

Sub EnviarEmail(MailFromEmail, MailToEmail, MailSubject, MailText)
On Error Resume Next
Response.Write vbCrLf & "<!--Enviado email-->" & vbCrLf
Set Mail = Server.CreateObject("Persits.MailSender")
Mail.Host = strEmail_SMTPServer
Mail.Port = 25
Mail.From = MailFromEmail
Mail.AddAddress MailToEmail, ""
Mail.Subject = MailSubject
Mail.Body = MailText
Mail.IsHTML = False
Mail.Send
If Err.number <> 0 Then
REsponse.Write "<!--No se pudo enviar el email.-->"
REsponse.Write "<!--" & Err.Description & "-->"
End IF
Set Mail = Nothing
End Sub
  #127 (permalink)  
Antiguo 24/10/2011, 09:47
 
Fecha de Ingreso: diciembre-2010
Mensajes: 236
Antigüedad: 14 años, 3 meses
Puntos: 6
Respuesta: Biblioteca de Clases,Funciones y Sub-rutinas.
Crear un RecordSet paginado

Para aligerar código he creado una función que me devuelve un recordset con el puntero posicionado en la página deseada:

Función:

Código ASP: 
Ver original
  1. <%
  2. 'Parámetros:
  3. 'Sentencia: Sentencia SQL con la que generar el Recordset
  4. 'Pagina_Solicitada: Página del recordset solicitada para mostrar
  5. 'Mostrar: número de registros por página
  6. '
  7. 'La función crea el Recordset solicitado y devuelve un array:
  8. ' Posición 0 : Páginas totales resultantes
  9. ' Posición 1 : Página en la que se posiciona, esta puede diferir de la 
  10. '              solicitada, es decir, si se solicita la página 32 del recordset
  11. '              y sólo hay 28 páginas, el valor será 28.
  12. '              
  13. Function CrearRs_paginado (Sentencia, Pagina_Solicitada, Mostrar)
  14.     
  15.     Dim Devuelve(1)
  16.     
  17.     if Pagina_Solicitada = "" then
  18.         Pagina_Solicitada = 1
  19.     Else
  20.         Pagina_Solicitada=cint(Pagina_Solicitada)
  21.     End if
  22.  
  23.     if Mostrar = "" then
  24.         Mostrar = 5
  25.     Else
  26.         Mostrar = Cint(Mostrar)
  27.     End if
  28.     
  29.     Set rs=server.createobject("adodb.recordset")
  30.     Rs.pagesize = Mostrar
  31.     Rs.cachesize = Mostrar
  32.     
  33.     Rs.open Sentencia,conn,3,1
  34.     cant_paginas=rs.pagecount
  35.  
  36.     If Pagina_Solicitada > cant_paginas then
  37.         Pagina_Solicitada = cant_paginas
  38.     end if
  39.                          
  40.     if Pagina_Solicitada <1 then
  41.         Pagina_Solicitada = 1
  42.     end if
  43.            
  44.     If cant_paginas = 0 Then
  45.         
  46.         'Cantidad de páginas
  47.         Devuelve(0) = 0
  48.         
  49.         'Página Solicitada
  50.         Devuelve(1) = 0
  51.         CrearRs_paginado = Devuelve
  52.         
  53.     Else
  54.     
  55.         Rs.absolutepage = Pagina_Solicitada     
  56.         Devuelve(0) = rs.pagecount
  57.         Devuelve(1) = Pagina_Solicitada
  58.         CrearRs_paginado = Devuelve
  59.         
  60.     End If  
  61.  
  62.  
  63. End Function  
  64. %>

Desde el documento actuamos así:
Código HTML: 
Ver original
  1. <body>
  2.  
  3.     <%
  4.  
  5.     Pags_NumPag = CrearRs_Paginado("Select * From Boletines_Subcr", 523, 10)
  6.     
  7.     For I=1 To 10
  8.         If Rs.Eof Then Exit For
  9.  
  10.         %>
  11.         <div><%=Rs("Email")%></div>
  12.         <%
  13.         Rs.MoveNext
  14.  
  15.     Next
  16.     
  17.     Response.Write "Página " & Pags_NumPag(1) & " de " & Pags_NumPag(0)
  18.     CerrarRs
  19.     %>
  20.         <a href="borrar.asp?cod=&page=<%=Pags_NumPag(1)-1%>"> Anterior </a> | <a href="borrar.asp?cod=&page=<%=Pags_NumPag(1)+1%>"> Siguiente </a>
  21.  
  22.     
  23. </body>

He preferido hacerlo así para que el diseño de muestra de el recordset sea propio de cada página.
Última edición por PabloManuel; 24/10/2011 a las 10:09 Razón: Ahora aparecen los botones.
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta

SíEste tema le ha gustado a 18 personas (incluyéndote)


« Tema Anterior | Próximo Tema »


La zona horaria es GMT -6. Ahora son las 08:58.