Biblioteca de Clases,Funciones y Sub-rutinas.

[IsaBelM]

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:

<%
Function CortarStr(TextoOrg)
i = 0
Set objRE = new RegExp
objRE.Pattern = "((([\wñáéíóú]+)\s)+([\wñáéíóú]+)\.(\s?))"
objRE.IgnoreCase = True
objRE.Global = True
Set objExe = objRE.Execute(TextoOrg)
For Each Coincidencia in objExe
If i <= 1 then
strAcortado  = strAcortado & Coincidencia.Value
i = i +1
Else
Exit For
End If
Next
Set objExe = nothing
Set objRE = nothing
CortarStr = strAcortado 
End Function
 
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á."
Response.Write CortarStr(texto)
%>
 

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

[DanielImago]

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

[DanielImago]

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

[DanielImago]

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

[DanielImago]

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

[DanielImago]

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

[PabloManuel]

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:

<%
'Parámetros:
'Sentencia: Sentencia SQL con la que generar el Recordset
'Pagina_Solicitada: Página del recordset solicitada para mostrar
'Mostrar: número de registros por página
'
'La función crea el Recordset solicitado y devuelve un array:
' Posición 0 : Páginas totales resultantes
' Posición 1 : Página en la que se posiciona, esta puede diferir de la 
'              solicitada, es decir, si se solicita la página 32 del recordset
'              y sólo hay 28 páginas, el valor será 28.
'              
Function CrearRs_paginado (Sentencia, Pagina_Solicitada, Mostrar)
    
    Dim Devuelve(1)
    
    if Pagina_Solicitada = "" then
        Pagina_Solicitada = 1
    Else
        Pagina_Solicitada=cint(Pagina_Solicitada)
    End if
 
    if Mostrar = "" then
        Mostrar = 5
    Else
        Mostrar = Cint(Mostrar)
    End if
    
    Set rs=server.createobject("adodb.recordset")
    Rs.pagesize = Mostrar
    Rs.cachesize = Mostrar
    
    Rs.open Sentencia,conn,3,1
    cant_paginas=rs.pagecount
 
    If Pagina_Solicitada > cant_paginas then
        Pagina_Solicitada = cant_paginas
    end if
                         
    if Pagina_Solicitada <1 then
        Pagina_Solicitada = 1
    end if
           
    If cant_paginas = 0 Then
        
        'Cantidad de páginas
        Devuelve(0) = 0
        
        'Página Solicitada
        Devuelve(1) = 0
        CrearRs_paginado = Devuelve
        
    Else
    
        Rs.absolutepage = Pagina_Solicitada     
        Devuelve(0) = rs.pagecount
        Devuelve(1) = Pagina_Solicitada
        CrearRs_paginado = Devuelve
        
    End If  
 
 
End Function  
%>
 

Desde el documento actuamos así:

Código HTML:

<body>
 
    <%
 
    Pags_NumPag = CrearRs_Paginado("Select * From Boletines_Subcr", 523, 10)
    
    For I=1 To 10
        If Rs.Eof Then Exit For
 
        %>
        <div><%=Rs("Email")%></div>
        <%
        Rs.MoveNext
 
    Next
    
    Response.Write "Página " & Pags_NumPag(1) & " de " & Pags_NumPag(0)
    CerrarRs
    %>
        <a href="borrar.asp?cod=&page=<%=Pags_NumPag(1)-1%>"> Anterior </a> | <a href="borrar.asp?cod=&page=<%=Pags_NumPag(1)+1%>"> Siguiente </a>
 
    
</body>
 

He preferido hacerlo así para que el diseño de muestra de el recordset sea propio de cada página.