Foros del web, para los que viven de bits

<%
Function ImporteEnLetras(pImporte, pSepDecimal, pCharPorLinea, pDesMoneda, pDesCentavos, pDecimalesEnNumeros, pLeyenda)

Dim tmpEntero(9)
Dim tmpDecimal(2)
Dim tmpImporteEnLetras
Dim tmpLetrasFinal
Dim tmpEsDecimal
Dim tmpImporte
Dim tmpEnteros
Dim tmpDecimales
Dim tmpChar
Dim i
Dim tmpLargoImporte
Dim tmpLargoEnteros
Dim tmpPosicion
Dim tmpDigito
Dim tmpCantChar
Dim tmpPalabra

ImporteEnLetras = ""

tmpImporteEnLetras = ""
tmpLetrasFinal = ""
tmpImporte = Trim(pImporte)
tmpEsDecimal = False
tmpEnteros = ""
tmpDecimales = ""

For i = 1 To Len(tmpImporte)
  tmpChar = Mid(tmpImporte, i, 1)
  If tmpChar <> pSepDecimal And (Asc(tmpChar) < 48 Or Asc(tmpChar) > 57) Then
    Exit Function
  End If
Next

For i = 1 To 9
  tmpEntero(i) = "0"
Next

tmpLargoImporte = Len(tmpImporte)

For tmpPosicion = 1 To tmpLargoImporte
  tmpChar = Mid(tmpImporte, tmpPosicion, 1)
  If tmpChar = pSepDecimal Then
    tmpEsDecimal = True
  Else
    If tmpEsDecimal = True Then
      tmpDecimales = tmpDecimales + tmpChar
    Else
      tmpEnteros = tmpEnteros + tmpChar
    End If
  End If
Next

tmpDecimales = Left(tmpDecimales + "00", 2)
tmpLargoEnteros = Len(tmpEnteros)

For tmpDigito = tmpLargoEnteros To 1 Step -1
  tmpEntero(tmpDigito) = Mid(tmpEnteros, (tmpLargoEnteros - tmpDigito + 1), 1)
Next

If (tmpEntero(9) <> "0" Or tmpEntero(8) <> "0" Or tmpEntero(7) <> "0") Then
  tmpImporteEnLetras = tmpImporteEnLetras + ConvierteLetras(tmpEntero(9), tmpEntero(8), tmpEntero(7))
  If (tmpEntero(9) = "0" And tmpEntero(8) = "0" And tmpEntero(7) = "1") Then
    tmpImporteEnLetras = tmpImporteEnLetras + "millon "
  Else
    tmpImporteEnLetras = tmpImporteEnLetras + "millones "
  End If
End If

If (tmpEntero(6) <> "0" Or tmpEntero(5) <> "0" Or tmpEntero(4) <> "0") Then
  If (tmpEntero(6) = "0" And tmpEntero(5) = "0" And tmpEntero(4) = "1") Then
  Else
    tmpImporteEnLetras = tmpImporteEnLetras + ConvierteLetras(tmpEntero(6), tmpEntero(5), tmpEntero(4))
  End If
  tmpImporteEnLetras = tmpImporteEnLetras + "mil "
End If

tmpImporteEnLetras = tmpImporteEnLetras + ConvierteLetras(tmpEntero(3), tmpEntero(2), tmpEntero(1))
If tmpEntero(1) = "1" Then tmpImporteEnLetras = Left(tmpImporteEnLetras, Len(tmpImporteEnLetras) - 1) + "o "

If tmpImporteEnLetras = "" Then tmpImporteEnLetras = "cero "
If pDecimalesEnNumeros = True Then
   tmpImporteEnLetras = tmpImporteEnLetras + pDesMoneda + " con " + tmpDecimales + "/100 " + pDesCentavos
Else
   tmpDecimal(1) = Mid(tmpDecimales, 1, 1)
   tmpDecimal(2) = Mid(tmpDecimales, 2, 1)
   tmpImporteEnLetras = tmpImporteEnLetras + pDesMoneda + " con " + ConvierteLetras("0", tmpDecimal(1), tmpDecimal(2)) + pDesCentavos
End If

tmpImporteEnLetras = RTrim(tmpImporteEnLetras)

If Len(tmpImporteEnLetras) <= pCharPorLinea Then
  tmpLetrasFinal = tmpImporteEnLetras
Else
  tmpCantChar = 0
  tmpPalabra = ""
  For i = 1 To Len(tmpImporteEnLetras)
    tmpCantChar = tmpCantChar + 1
    tmpChar = Mid(tmpImporteEnLetras, i, 1)
    If tmpChar = " " Then
      tmpLetrasFinal = tmpLetrasFinal + tmpPalabra
      tmpPalabra = ""
      If tmpCantChar < pCharPorLinea Then tmpLetrasFinal = tmpLetrasFinal + tmpChar
    Else
      tmpPalabra = tmpPalabra + tmpChar
    End If
    If tmpCantChar > pCharPorLinea Then
      tmpCantChar = Len(tmpPalabra)
      
    If gCHARLINE Then
      tmpLetrasFinal = tmpLetrasFinal & vbCrLf
    Else
      tmpLetrasFinal = tmpLetrasFinal + Chr(10)
    End If

    End If
  Next
  tmpLetrasFinal = tmpLetrasFinal + tmpPalabra
End If

If pLeyenda = "" Then
    ImporteEnLetras = UCase(tmpLetrasFinal)
Else
    ImporteEnLetras = UCase(tmpLetrasFinal & " " & pLeyenda)
End If

End Function
Function ConvierteLetras(pDigito3, pDigito2, pDigito1)

Dim tmpLetras

ConvierteLetras = ""
tmpLetras = ""

Select Case pDigito3
  Case "0"
  Case "1"
    If pDigito2 = "0" And pDigito1 = "0" Then
      tmpLetras = tmpLetras + "cien "
    Else
      tmpLetras = tmpLetras + "ciento "
    End If
  Case "2"
    tmpLetras = tmpLetras + "doscientos "
  Case "3"
    tmpLetras = tmpLetras + "trescientos "
  Case "4"
    tmpLetras = tmpLetras + "cuatrocientos "
  Case "5"
    tmpLetras = tmpLetras + "quinientos "
  Case "6"
    tmpLetras = tmpLetras + "seiscientos "
  Case "7"
    tmpLetras = tmpLetras + "setecientos "
  Case "8"
    tmpLetras = tmpLetras + "ochocientos "
  Case "9"
    tmpLetras = tmpLetras + "novecientos "
  Case Else
    Exit Function
End Select

Select Case pDigito2
  Case "0"
  Case "1"
    Select Case pDigito1
      Case "0"
        tmpLetras = tmpLetras + "diez "
      Case "1"
        tmpLetras = tmpLetras + "once "
      Case "2"
        tmpLetras = tmpLetras + "doce "
      Case "3"
        tmpLetras = tmpLetras + "trece "
      Case "4"
        tmpLetras = tmpLetras + "catorce "
      Case "5"
        tmpLetras = tmpLetras + "quince "
      Case "6"
        tmpLetras = tmpLetras + "dieciseis "
      Case "7"
        tmpLetras = tmpLetras + "diecisiete "
      Case "8"
        tmpLetras = tmpLetras + "dieciocho "
      Case "9"
        tmpLetras = tmpLetras + "diecinueve "
      Case Else
        Exit Function
    End Select
  Case "2"
    If pDigito1 = "0" Then
      tmpLetras = tmpLetras + "veinte "
    Else
      tmpLetras = tmpLetras + "veinti"
    End If
  Case "3"
    tmpLetras = tmpLetras + "treinta "
  Case "4"
    tmpLetras = tmpLetras + "cuarenta "
  Case "5"
    tmpLetras = tmpLetras + "cincuenta "
  Case "6"
    tmpLetras = tmpLetras + "sesenta "
  Case "7"
    tmpLetras = tmpLetras + "setenta "
  Case "8"
    tmpLetras = tmpLetras + "ochenta "
  Case "9"
    tmpLetras = tmpLetras + "noventa "
  Case Else
    Exit Function
End Select
If cdbl(pDigito2) >= 3 And pDigito1 <> "0" Then tmpLetras = tmpLetras + "y "

If pDigito2 <> "1" Then
  Select Case pDigito1
    Case "0"
    Case "1"
      tmpLetras = tmpLetras + "un "
    Case "2"
      tmpLetras = tmpLetras + "dos "
    Case "3"
      tmpLetras = tmpLetras + "tres "
    Case "4"
      tmpLetras = tmpLetras + "cuatro "
    Case "5"
      tmpLetras = tmpLetras + "cinco "
    Case "6"
      tmpLetras = tmpLetras + "seis "
    Case "7"
      tmpLetras = tmpLetras + "siete "
    Case "8"
      tmpLetras = tmpLetras + "ocho "
    Case "9"
      tmpLetras = tmpLetras + "nueve "
    Case Else
      Exit Function
  End Select
End If

ConvierteLetras = tmpLetras

End Function
%>

Function Age(strBirthDate)
	If IsNull(strBirthDate) then Age = 0: Exit Function
	
	varAge = DateDiff("yyyy", strBirthDate, Now)
	If Date < DateSerial(Year(Now), Month(strBirthDate), Day(strBirthDate)) Then
		varAge = varAge - 1
	End If
	Age = CInt(varAge)
End Function

Function PutSignoZodiacal(strFechaNacimiento)
	strDia = day(strFechaNacimiento)
	strMes = month(strFechaNacimiento)
		
	select case strMes
		case 1
			if strDia <= 19 then strSigno = "Capricornio"
			if strDia >= 20 then strSigno = "Acuario"
		case 2
			if strDia <= 18 then strSigno = "Acuario"
			if strDia >= 19 then strSigno = "Piscis"
		case 3
			if strDia <= 20 then strSigno = "Piscis"
			if strDia >= 21 then strSigno = "Aries"
		case 4
			if strDia <= 20 then strSigno = "Aries"
			if strDia >= 21 then strSigno = "Tauro"
		case 5
			if strDia <= 20 then strSigno = "Tauro"
			if strDia >= 21 then strSigno = "Geminis"
		case 6
			if strDia <= 21 then strSigno = "Geminis"
			if strDia >= 22 then strSigno = "C&aacute;ncer"
		case 7
			if strDia <= 22 then strSigno = "C&aacute;ncer"
			if strDia >= 23 then strSigno = "Leo"
		case 8
			if strDia <= 22 then strSigno = "Leo"
			if strDia >= 23 then strSigno = "Virgo"
		case 9
			if strDia <= 22 then strSigno = "Virgo"
			if strDia >= 23 then strSigno = "Libra"
		case 10
			if strDia <= 22 then strSigno = "Libra"
			if strDia >= 23 then strSigno = "Escorpion"
		case 11
			if strDia <= 21 then strSigno = "Escorpion"
			if strDia >= 22 then strSigno = "Sagitario"
		case 12
			if strDia <= 21 then strSigno = "Sagitario"
			if strDia >= 22 then strSigno = "Capricornio"
		case else
			strSigno = ""
	end select
		
	PutSignoZodiacal = strSigno
End Function

Function RateIt(strEstrella1, strEstrella2, strEstrella3, strEstrella4, strEstrella5)
	strFullEstrella = 0
	strTotal_Estrellas = strEstrella1 + strEstrella2 + strEstrella3 + strEstrella4 + strEstrella5
	if strEstrella1 > 0 then strEstrella1 = strEstrella1 * 1
	if strEstrella2 > 0 then strEstrella2 = strEstrella2 * 2
	if strEstrella3 > 0 then strEstrella3 = strEstrella3 * 3
	if strEstrella4 > 0 then strEstrella4 = strEstrella4 * 4
	if strEstrella5 > 0 then strEstrella5 = strEstrella5 * 5
		
	if strTotal_Estrellas > 0 then
		strFullEstrella = (strEstrella1 + strEstrella2 + strEstrella3 + strEstrella4 + strEstrella5) / strTotal_Estrellas
		strFullEstrella = round(strFullEstrella,0)
		if strFullEstrella > 5 then strFullEstrella = 5
	end if
		
	RateIt = strFullEstrella
End Function

function checa_cadena(cadena,tipo_de_dato_a_chequear,valor_por_defecto)

	'tipo_de_dato_a_chequear = 0 cadena deberia ser una cadena de largo no igual a cero
	'tipo_de_dato_a_chequear = 1 cadena deberia ser numerico
	'tipo_de_dato_a_chequear = 2 cadena deberia ser fecha
	
	Select Case tipo_de_dato_a_chequear
    Case 0
		if len(cadena) = 0 then
			salida = valor_por_defecto
		else
			salida = cstr(cadena)
		end if
	Case 1
		if isnumeric(cadena) = false then
			salida = valor_por_defecto
		else
			salida = cadena
		end if
	Case 2
		if isdate(cadena) = false then
			salida = valor_por_defecto
		else
			salida = cadena
		end if
    Case Else 
		salida = cadena 
	End Select

	checa_cadena = salida

end function

function limpia_cadena(str_a_limpiar,modo_de_limpiar)

	'modo_de_limpiar = 0 prepara str_a_limpiar para insert 
	'modo_de_limpiar = 1 Prepara str_a_limpiar para insert evitando, ademas, la entrada de HTML
	'modo_de_limpiar = 2 Prepara str_a_limpiar para un login y evita sql injection
	
	str = trim(str_a_limpiar)
	
	Select Case modo_de_limpiar
    Case 0
		str = replace(str,"'","''")
	Case 1
		str = replace(str,"'","''")
		str = replace(str,"<","&lt;")
		str = replace(str,">","&gt;")
	Case 2
                          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,">","]")
                          str = replace(str,"having ","")
                          str = replace(str,"group by","")
                          str = replace(str,"union select sum","")
                          str = replace(str,"union select min","")
                          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","")
    Case Else 
        str = str_a_limpiar
	End Select

	limpia_cadena = str

end function

	iws_login		= checa_cadena(request.Form("iws_login"),0,false)
	iws_password	= checa_cadena(request.Form("iws_password"),0,false)
	
	if iws_login = false or iws_password = false then termina
	
	iws_login	 = limpia_cadena(iws_login,2)
	iws_password = limpia_cadena(iws_password,2)

function enlace(url)
		set http_obj = createObject("Microsoft.XMLHTTP")
		ulr=request("url")
		http_obj.Open "GET",url,false
		On Error Resume Next
		http_obj.Send()
		if err.number <> 0 then
			enlace=false
		else
			codigo = Server.HTMLEncode(http_obj.responseText)
			if instr(codigo,"&lt;title&gt;No se encuentra la p&amp;aacute;gina&lt;/title&gt;")<>0 then
				enlace=false
			else
				enlace=true
			end if
			
			if instr(codigo,"El sistema no puede hallar el archivo especificado")<>0 then
				enlace=false
			else
				enlace=true
			end if
			
			if instr(codigo,"&lt;title&gt;Error&lt;/title&gt;")<>0 then
				enlace=false
			else
				enlace=true
			end if
		end if
		end function

function aleatorio()
	randomize
	car = Int((90 - 48 + 1) * Rnd + 48)
	aleatorio = car
end function

Dim clave
Dim tamano = 15

do while Len(clave) < tamano
	n = aleatorio()
	if n < 58 or n > 64 then
		clave = clave & chr(n)		
	end if
loop

Response.Write(clave)

function checa_procedencia(procedencia_autorizada,dominio_autorizado)

	aux = Request.ServerVariables("HTTP_REFERER")
	
	if len(aux) = 0 or aux = "" then 
		checa_procedencia = false
		exit function
	end if
	
	arreglo			 = split(aux,"/")
	dominio_real	 = arreglo(2)
	procedencia_real = arreglo(ubound(arreglo))
	
	if lcase(procedencia_real) = lcase(procedencia_autorizada) and lcase(dominio_real) = lcase(dominio_autorizado) then
		checa_procedencia = true
	else
		checa_procedencia = false
	end if
end function

if checa_procedencia("1.asp","localhost") = true then 
	escribe "eres bienvenido" 
else
	escribe "no eres binevenido"
end if

Class StringBuilder
	Private Sub Class_Initialize()
		growthRate = 50
		itemCount = 0
		ReDim arr(growthRate)
	End Sub
	
	Public Sub Append(ByVal strValue)
		If itemCount > UBound(arr) Then
			ReDim Preserve arr(UBound(arr) + growthRate)
		End If
	
		arr(itemCount) = strValue
		itemCount = itemCount + 1
	End Sub
	
	Public Function ToString() 
		ToString = Join(arr, "")
	End Function
End Class

Dim objBuilder, i
Set objBuilder = new StringBuilder

For i = 0 To 5000
variable = "este es el número: " & i & "<br>" & vbcrlf
	objBuilder.Append(variable)
Next

Response.Write objBuilder.ToString()

 
texto = "www.forosdelweb.com"
texto = InsertHyperlinks(texto) 
response.write(texto)

 
'Convierte los E-Mail's y los Links en enlaces
Function InsertHyperlinks(strInText, strEstilo)
Dim objRegExp, strBuf
Dim objMatches, objMatch
Dim Value, ReplaceValue, iStart, iEnd
 
strBuf = ""
iStart = 1
iEnd = 1
 
Set objRegExp = New RegExp
 
objRegExp.Pattern = "\b(www|http|\S+@)\S+\b"
objRegExp.IgnoreCase = True
objRegExp.Global = True
Set objMatches = objRegExp.Execute(strInText)
 
For Each objMatch in objMatches
iEnd = objMatch.FirstIndex
strBuf = strBuf & Mid(strInText, iStart, iEnd-iStart+1)
 
If InStr(1, objMatch.Value, "@") Then
	strBuf = strBuf & GetHref(objMatch.Value, "email", "_blank", strEstilo)
Else
	strBuf = strBuf & GetHref(objMatch.Value, "web", "_blank", strEstilo)
End If
 
iStart = iEnd+objMatch.Length+1
Next
 
strBuf = strBuf & Mid(strInText, iStart)
InsertHyperlinks = strBuf
End Function
 
 
Function GetHref(url, urlType, Target, strEstilo)
Dim strBuf
 
if strEstilo <> "" then strEstilo = "class=""" & strEstilo & """"
 
strBuf = "<a href="""
 
If urlType = "web" Then
If LCase(Left(url, 3)) = "www" Then
	strBuf = "<a href=""http://" & url & """ target=""" & Target & """ " & strEstilo & ">" & url & "</a>"
Else
	strBuf = "<a href=""" & url & """ target=""" & Target & """ " & strEstilo & ">" & url & "</a>"
End If
 
ElseIf UCase(urlType) = "email" Then
strBuf = "<a href=""mailto:" & url & """ target=""" & Target & """ " & strEstilo & ">" & url & "</a>"
End If
 
GetHref = strBuf
End Function

Sub Redirecciona(pagina,mensaje)
If pagina="" Then
pagina="window.history.back();"
ElseIf isNumeric(pagina) Then
pagina="window.history.go(-"&pagina&")"
Else pagina="location.href='"&pagina&"';"
End If

Response.Write("<script language=""javascript"">")

If mensaje<>"" Then
Response.Write("alert('"&Mensaje&"');")
End If

Response.Write (pagina&"</script>")
Response.End
End Sub

<%
Call Redirecciona("form_ingreso_cursos.asp","El curso "&nom_curso&" se ingreso correctamente.")
%>

<%
    Call Redirecciona("","Los datos son erroneos.")
%>

function GetMax(param_arr)
 
Dim endLoop, maxValue
endLoop = UBound(param_arr) - 1
maxValue = 0 
   
   for i=0 to endLoop
	   if param_arr(i) > param_arr(i+1) and param_arr(i) => maxValue then
	   maxValue = param_arr(i)
	elseif arr(i + 1) > maxValue then 
	   maxValue = param_arr(i+1)
	end if
   next
  
   GetMax = maxValue
end function