Deambulando » ASP

En horario de oficina, función ASP

deambulando — Fri, 08 Aug 2008 10:01:39 +0000

Función de asp que nos devuelve verdadero o falso, en el caso que estes en horario o no, útil para mostrar un contenido en algunas horas o no, por ejemplo un chat de empresa que sólo estará disponible en horario laboral ;)

function enHorarioOficina()‘devuelve si estamos en el horario de oficina o no
dim inicioMan,finMan,inicioTarde,finTarde,diaInicio,diaFin,hora,dia
dia=weekday(date())
hora=hour(time)’parametros para configurar según tu empresa
inicioMan=10′inicio en la mañana
finMan=14′fin de la mañana
inicioTarde=15′inicio trabajo tarde
finTarde=19′fin del trabajo
diaInicio=2′lunes inicio de la semana
diaFin=6′viernes fin de la semana laboral
enHorarioOficina=false’suponemos que no esta en horario

if (dia>=diaInicio and dia<=diaFin) and ((hora>=inicioMan and hora=inicioTarde and hora enHorarioOficina=true’esta en horario
end if

end function

Función reemplazar para ASP

deambulando — Mon, 28 Jul 2008 20:46:55 +0000

Pues para hoy otra función ASP, para esta antes necesitaremos la función que nos dice si algo esta vacío.

Pero para que es útil esta función si ya existe el replace?

Simple, trata hacer un replace sobre algo que es nulo o vacío, y ya vereís por que es util esta función ;)

Al grano!

function reemplaza(byref origen,byref cad,byref cadReemp)‘replace mejorado, comprueba si las variables estan vacias
‘1r param= cadena en la que se hace el reemplazo,
‘2º param, cadena a buscar
‘3º cadena por la que reemplazar
if not esVacio(origen) and not esVacio(cad) and not esVacio(cadReemp) then’si no estan vacias!!!
reemplaza=replace(origen,cad,cadReemp)’reemplazamos
end if
end function

Otra función de asp útil para coleccionar ;)

Función ASP para saber si una variable esta vacía

deambulando — Tue, 22 Jul 2008 20:16:27 +0000

Es una de estas funciones ASP que tengo que son chorras, pero a su vez muy útil

Con esta función nos ahorraremos hacer tres a la vez, comprobaremos que tenga un valor inicial (isEmpty), que no sea null (isNull), o que simplemente este vacía (=”") aquí va:

function esVacio(byref var)’chequea que una variable tenga algun valor
esVacio=true’por defecto pensamos que esta vacia

if not isEmpty(var) and not isnull(var) and var<>”" then ’si esta declarada, no es null, y tiene valor
esVacio=false ‘no esta vacia!!
end if

end function

Uso:

dim casa:casa=”micasa”

if not esVacio(casa) then

response.write “no esta vacia ” & casa

end if

Y ya esta…por que esto? próximo día tengo otra bonita función :P

Object Moved – Asp

deambulando — Tue, 08 Apr 2008 16:40:13 +0000

Otro problema con asp con solución encontrada aquí

SafeRedir "http://www.motobit.com"

Sub SafeRedir(ByVal URL)
  Response.Buffer = True
  Response.Status = "302 Object moved"
  Response.AddHeader "Location", URL
  Response.Write ""
  Response.Write ""0;URL=" & URL & """>"
  Response.Write ""
  Response.Write ""
'  Response.Write " This page was moved "" & URL & """>here"
  Response.Write ""
End Sub

De número a Letras, Number to words, ASP

deambulando — Fri, 21 Mar 2008 09:22:23 +0000

Basado en http://www.forosdelweb.com/f15/funcion-para-convertir-numeros-letras-387197/

Modifico la función para que muestre también con palabras los decimales ;), y alguna optimización.

<%
response.Write number2word(1000.101)

output: mil con diez

function number2word(byval numero)’convierte un número a palabras
Dim decimales

number2word=oneNumberToWord(Cdbl(Int(numero)))’lo pasamos a palabras

decimales = (numero – Cdbl(Int(numero))) * 100′obtenemos si tenia decimales
If decimales <> 0 Then number2word = number2word & ” con ” & CStr(oneNumberToWord(Round(decimales))) ’si tiene decimales convertimos los decimales a palabras

end function

Function oneNumberToWord(pnumero)’un número simple sin decimales a palabras

Dim xcen(9) ‘centenas
Dim xdec(9) ‘decenas
Dim xuni(9) ‘unidades
Dim xexc(6) ‘except
Dim ceros(9)

Dim letras,i,c,j,xnumero, xnum,num,digito,numero_ent,entero,temp

xcen(2) = “dosc”
xcen(3) = “tresc”
xcen(4) = “cuatrosc”
xcen(5) = “quin”
xcen(6) = “seisc”
xcen(7) = “setec”
xcen(8) = “ochoc”
xcen(9) = “novec”
xdec(2) = “veinti”
xdec(3) = “trei”
xdec(4) = “cuare”
xdec(5) = “cincue”
xdec(6) = “sese”
xdec(7) = “sete”
xdec(8) = “oche”
xdec(9) = “nove”
xuni(1) = “uno”
xuni(2) = “dos”
xuni(3) = “tres”
xuni(4) = “cuatro”
xuni(5) = “cinco”
xuni(6) = “seis”
xuni(7) = “siete”
xuni(8) = “ocho”
xuni(9) = “nueve”
xexc(1) = “diez”
xexc(2) = “once”
xexc(3) = “doce”
xexc(4) = “trece”
xexc(5) = “catorce”
xexc(6) = “quince”
ceros(1) = “0″
ceros(2) = “00″
ceros(3) = “000″
ceros(4) = “0000″
ceros(5) = “00000″
ceros(6) = “000000″
ceros(7) = “0000000″
ceros(8) = “00000000″

c = 1
i = 1
j = 0

xnumero = cStr(pnumero)
If Cdbl(LTrim(RTrim(pnumero))) < 999999999.99 Then
numero_ent = Cdbl(Int(pnumero))
If Len(numero_ent) < 9 Then
numero_ent = ceros(9 – Len(numero_ent)) & numero_ent
End If
entero = Cdbl(Int(numero_ent))

Do While i < 8
temp = 0
num = Cdbl(Mid(numero_ent, i, 3))
xnum = Mid(numero_ent, i, 3)
digito = Cdbl(Mid(xnum, 1, 1))

‘/* analizo el numero entero de a 3 */
If xnum = “000″ Then
j = 0
Else
j = 1
If digito > 1 Then
letras = letras & xcen(digito) & “ientos ”
End If
If Mid(xnum, 1, 1) = “1″ And Mid(xnum, 2, 2) <> “00″ Then
letras = letras & “ciento ”
ElseIf Mid(xnum, 1, 1) = “1″ Then
letras = letras & “cien ”
End If

‘/* analisis de las decenas */
digito = Cdbl(Mid(xnum, 2, 1))
If digito > 2 And Mid(xnum, 3, 1) = “0″ Then
letras = letras & xdec(digito) & “nta ”
temp = 1
End If

If digito > 2 And Mid(xnum, 3, 1) <> “0″ Then
letras = letras & xdec(digito) & “nta y ”

End If

If digito = 2 And Mid(xnum, 3, 1) = “0″ Then
letras = letras & “veinte ”
temp = 1
ElseIf digito = 2 And Mid(xnum, 3, 1) <> “0″ Then
letras = letras & “veinti”

End If

If digito = 1 And Mid(xnum, 3, 1) >= “6″ Then
letras = letras & “dieci”
ElseIf digito = 1 And Mid(xnum, 3, 1) < “6″ Then
letras = letras & xexc(Cdbl(Mid(xnum, 3, 1) + 1))
temp = 1
End If
End If

if temp = 0 then
‘/* analisis del ultimo digito */
digito = Cdbl(Mid(xnum, 3, 1))
If ((c = 1) Or (c = 2)) And xnum = “001″ Then
‘letras = letras & “un”
Else
If ((c = 1) Or (c = 2)) And xnum >= “020″ And Mid(xnum, 3, 1) = “1″ Then
letras = letras & “un”
Else
If digito <> 0 Then
letras = letras & xuni(digito)
End If
End If
End If
end if

If j = 1 And i = 1 And xnum = “001″ And c = 1 Then
letras = letras & ” millon ”
ElseIf j = 1 And i = 1 And xnum <> “001″ And c = 1 Then
letras = letras & ” millones ”
ElseIf j = 1 And i = 4 And c = 2 Then
letras = letras & ” mil ”
End If
i = i + 3
c = c + 1
Loop
If letras = “” Then
letras = “cero ”
End If

End If

oneNumberToWord = letras
End Function

Obtener último día del mes – ASP

deambulando — Wed, 23 Jan 2008 21:01:05 +0000

Pues eso!! le pasas una fecha y te devuelve el último día del mes que puede tener esa fecha ;)
Function lastMonthDay(byval sDate)'obtiene el ultimo dia del mes dim nextMonth sDate = DateSerial(Year(sDate), Month(sDate), "01") nextMonth = DateAdd("m", 1, SDate) lastMonthDay = Day(DateAdd("d", -1, nextMonth)) End Function

Evita el SQL injection en ASP

deambulando — Wed, 16 Jan 2008 20:58:48 +0000

Esta función ya os la presenté anteriormente pero ayer me decidí a mejorarla basándome en este pdf
function limpia(text,encode) dim banned,i limpia=text banned = array("""","'","&","--","select","insert","update","delete","drop") for i = 0 to uBound(banned) limpia = replace(limpia, banned(i),"") next if encode=true then limpia=server.htmlencode(limpia) end if end function

Funciones para recoger datos ASP

deambulando — Tue, 15 Jan 2008 17:25:33 +0000

Bueno otro golpe de genialidad como el response.write, pero ahora con el request.querystring y el request.form, harto estaba de escribir esto!! así que monto estas dos chorras/funciones, que ademas me limpian lo que me hayan pasado ;)

function rf(s)'hace el request form
rf=limpia(request.form(s),false)
end function

function rq(s)'hace el request query
rq=limpia(request.QueryString(s),false)
end function

Meta keywords ASP

deambulando — Mon, 07 Jan 2008 21:57:35 +0000

El otro día expliqué como hacer el meta description de html con ASP (por cierto mejorado), el de keywords no lo he puesto aún por que lo estaba mejorando ;)

Lo ideal es pasar le un texto no demasiado largo, yo le paso el description, ya que el meta keyword, cuanto mas parezca al contenido de la web, mucho mejor ;)
function getKeywords(texto)'convierte un texto a keywords dim i,banned getKeywords=lcase(texto)'todo a minusuclas getKeywords=quitarHtml(getKeywords)'quitamos el html banned = array(";",":","."," from "," ante " , " bajo "," cabe "," contra "," desde "," entre "," hacia "," hasta "," para "," según "," sobre "," tras ",",,"," ")'palabras de mas de 3 caracteres que no queremos y los espacios los substituimos por comas for i = 0 to uBound(banned) getKeywords = replace(getKeywords, banned(i),",")'reemplazamos next getKeywords=delMenoresDe(3,getKeywords,",")'quitamos palabras menores de 3, esto es configurable getKeywords=delDuplicados(getKeywords,",")'eliminamos las palabras duplicadas end function

También necesitareis estas tres funciones, la primera elimina todas las palabras menores de X, la segunda las palabras duplicadas, y la tercera te dice si un elemento esta en un array
1.function delMenoresDe(num,str,car)'elimina las palabras menores de num de una cadena STR, las diferencia usando la variable CAR dim i,arr arr=split(str,car)'split de str, por el car for i = 0 to uBound(arr) if len(arr(i))>num then delMenoresDe = delMenoresDe & arr(i) & car'concatenamos con CAR end if next if len(delMenoresDe)>len(car) then delMenoresDe=left(delMenoresDe,len(delMenoresDe)-len(car))'quitamos la ultima posicion y se devuelve end function
2.
function delDuplicados(str,car)'elimina palabras duplicadas de una cadena STR, las diferencia usando la variable CAR dim i,arr arr=split(str,car)'split de str, por el car for i = 0 to uBound(arr) if not enArray(arr(i),split(delDuplicados,car)) then 'si no esta en el delDuplicados, lo concatenamos con el CAR delDuplicados = delDuplicados & arr(i) & car'concatenamos con CAR end if next if len(delDuplicados)>len(car) then delDuplicados=left(delDuplicados,len(delDuplicados)-len(car))'quitamos la ultima posicion y se devuelve end function

3.function enArray(str,arr)'dice si un str, esta en un array dim i:i=0 enarray=false while enarray=false and i<=ubound(arr) if lcase(arr(i))=lcase(str) then 'si se encuentra en el array enarray=true end if i=i+1 wend end function

Meta description ASP

deambulando — Thu, 27 Dec 2007 19:19:28 +0000

El otro día ya os presente el limpiador de html…pues mas que nada era para hacer el meta description como dios manda ;)
function getDescriptionMeta(desc)'le pasas un texto y te lo formatea para la descripcion del meta dim i,banned getDescriptionMeta = left(desc,200) getDescriptionMeta = limpia(getDescriptionMeta,false) getDescriptionMeta = quitarHtml(getDescriptionMeta) end function

Quitar etiquetas Html de un texto ASP

deambulando — Thu, 20 Dec 2007 22:01:22 +0000

Muy útil!

Imaginad tenéis un texto con multitud de etiquetas html…pero claro…no siempre deben de ser buenas para insertar y mantener una estructura de una web.

Pues con esto lo arreglamos :D

function quitarHtml(str)'con regex nos cargamos todos los tags html quitarHtml=replaceExpresion(str,"","<[^>]*?>") end function
function replaceExpresion(str,reem,pat)'hace un regExp dim oER:set oER = New RegExp oER.Pattern = pat oER.IgnoreCase = True oER.Global = True replaceExpresion = oER.replace(str, reem) set oER = nothing end function

La paradoja Python – ASP

deambulando — Sun, 04 Nov 2007 20:01:56 +0000

Primero mi experiencia: Mas vale malo conocido que malo por conocer….

Y no me refiero a que ASP sea malo, pero en mi caso, es el que mejor conozco y mas rendimiento le saco, de que me serviría programar en otro lenguaje si resulta que no podré sacar el mismo rendimiento, con la perdida de tiempo que conlleva?

Y esto la paradoja:

A falta de un nombre mejor lo llamaré la paradoja Python: si una compañía decide escribir su software en un lenguaje poco utilizado comparativamente, serán capaces de contratar a mejores programadores, porque atraerán sólo a aquellos que se molestaron en aprenderlo…
Hasta ahora sólo unas pocas compañías han sido suficientemente inteligentes para darse cuenta de esto. Pero hay una especie de selección natural trabajando: son exactamente las mismas compañías en las que a los programadores les gustaría trabajar. Google, por ejemplo. Cuando ofertan puestos para programar en Java, también piden experiencia con Python.
– Paul Graham

vía mundogeek

Averiguar fechas de Semana Santa – ASP

deambulando — Mon, 08 Oct 2007 20:17:43 +0000

Bueno una función de estas útiles , extraído de la wikipedia y reprogramado por mí xD

se usa isSemanaSanta(“23/04/2008″)

function isSemanaSanta(Fecha)‘le pasas una fecha y te dice si cae en semana santa
dim FechaDomingoSanto,FechaInicio,FechaFin

Fecha=cdate(Fecha)
FechaDomingoSanto=cdate(obtenerDomingoSanto(year(fecha)))
‘para barcelona
FechaInicio=dateadd(“d”,-2,FechaDomingoSanto)’acaba en el lunes de pascua
FechaFin=dateadd(“d”,1,FechaDomingoSanto)’comienza en viernes santo
‘resto españa
‘FechaInicio=dateadd(“d”,-3,FechaDomingoSanto)’comienza en jueves santo
‘FechaFin=FechaDomingoSanto’acaba el mismo domingo
‘rw FechaInicio & FechaFin
if Fecha>=FechaInicio and Fecha<=FechaFin then
isSemanaSanta=true’es semana santa
else
isSemanaSanta=false’sino esta en rango no es semana santa
end if

end function
function obtenerDomingoSanto(anno)‘rw obtenerDomingoSanto(1928)
‘formula obtenida de http://es.wikipedia.org/wiki/C%C3%A1lculo_de_la_fecha_de_Pascua
dim M,N,a,b,c,d,e,mes,dia
‘Constantes mágicas según artículo
anno=cint(anno)
if anno>=1583 and anno<=1699 then
M=22
N=2
elseif anno>=1700 and anno<=1799 then
M=23
N=3
elseif anno>=1800 and anno<=1899 then
M=23
N=4
elseif anno>=1900 and anno<=2099 then
M=24
N=5
elseif anno>=2100 and anno<=2199 then
M=24
N=6
elseif anno>=2200 and anno<=2299 then
M=25
N=0
end if

‘Cálculo de residuos
a = anno mod 19
b = anno mod 4
c = anno mod 7
d = (19*a + M) mod 30
e = (2*b+4*c+6*d + N) mod 7

‘Decidir entre los 2 casos:
if d+e < 10 then
dia = d+e+22
mes = 03
else
dia = d+e-9
mes = 04
end if

‘Excepciones especiales (según artículo)
if dia = 26 and mes = 04 then dia = 19
if dia = 25 and mes = 04 and d=28 and e = 6 and a >10 then dia = 18

obtenerDomingoSanto=dateserial(anno,mes,dia)

end function

Ordenar Matriz

deambulando — Tue, 31 Jul 2007 19:34:00 +0000

Una función que he desarrollado, supongo que muy útil, se le pasa una matriz, el campo por el que lo queremos ordenar, y el orden, et tachán!!!

uso: matriz=orderMatrixBy(matriz,1,”asc”)

function orderMatrixBy(matriz,campo,orden)’se pasa una matriz, el campoa ordenar, y el tipo de orden, y nos devuelve el array ordenado!!

if isarray(matriz)=true and isnumeric(campo)=true then
dim i,j,aux,total,totalCampos
total=ubound(matriz,2)-1′total registros a recorrer, el -1 es por que se evita a llegar hasta el ultimo
totalCampos=Ubound(matriz, 1)’total de campos
redim aux(totalCampos)’el vector auxiliar para guardar la posicion de la matriz
dim desordenado:desordenado=true

if cint(campo)<=totalCampos then’si el campo que se le pasa es menor que o igual al total de campos

while desordenado’mientras este desordenado….
desordenado=false’le decimos que se ha ordenado

for i= 0 to total’recorremos todo el array
if (orden=”asc” and matriz(campo,i)>matriz(campo,i+1)) or (orden=”desc” and matriz(campo,i) for J = 0 to totalCampos’movemos toda la posicion de la matriz a un vector auxilias
aux(j)=matriz(j,i)
next

for J = 0 to totalCampos’la posicion + 1 a la anterior
matriz(j,i)=matriz(j,i+1)
next

for J = 0 to totalCampos’la posicion anterior guardada en aux en la posicion mas 1
matriz(j,i+1)=aux(j)
next
desordenado=true’sigue desordenado
end if
next
wend

end if

redim aux(0)’no lo usaremos mas

end if

orderMatrixBy=matriz’devolvemos la matriz

end function

PrinttableXML ASP

deambulando — Thu, 26 Jul 2007 20:03:17 +0000

Lo prometido es deuda, una función que pasandole el sql te devuelve el xml, así de fácil, ademas optimizado mega rápido!!! fium fium

function printtableXml(sql)’se le pasa un string sql, e devuelve en
Response.ContentType = “text/xml”

dim rs,i,j,tabla,campos
set rs = openRS (“”, sql)

response.write “”
if not rs.eof then
redim campos(rs.fields.Count – 1)
for i = 0 to rs.fields.Count – 1
campos(i)=rs.fields(i).name
next
tabla=rs.getrows

i=0:j=0
for I = 0 to UBound(Tabla,2)
response.write ”
for J = 0 to Ubound(Tabla, 1)’Imprimo una celda para
cada campo
Response.Write campos(j) & “=”"” & Tabla(J, I) & “”" ”
next
response.write “/>”
next

end if
response.write “”

closeRS(rs)
end function