Foros del web, para los que viven de bits

<%
	Function FileSize(Path, FileName, Tipo)
		set FSO = Server.CreateObject("Scripting.FileSystemObject")
		set oFile = FSO.GetFile(Server.MapPath(Path & FileName))
	
		FileSize = oFile.Size
		
		select case Tipo
			case 2:
				FileSize = Round(FileSize / 1024, 2)
			case 3:
				FileSize = Round(FileSize / 1048576, 2)
			case 4:
				FileSize = FileSize & " Bytes"
			case 5:
				FileSize = Round(FileSize / 1024, 2) & " KB"
			case 6:
				FileSize = Round(FileSize / 1048576, 2) & " MB"
			case 7:
				if FileSize > 0 and FileSize < 1024 then
					FileSize = FileSize & " Bytes"
				elseif FileSize >= 1024 and FileSize < 1048576 then
					FileSize = Round(FileSize / 1024, 2) & " KB"
				elseif FileSize >= 1048576 then
					FileSize = Round(FileSize / 1048576, 2) & " MB"
				end if
			case else
				FileSize = FileSize
		end select
		
		set oFile = nothing
		set FSO = nothing
	End Function
%>

tamano_archivo = FileSize("ruta_del_archivo", "nombre_del_archivo", 1)

<%
sub SendEmail(de, nick, para, asunto, mensaje)
		Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
		
		with Mailer
			.FromName = FromName
			.FromAddress = de
			.RemoteHost = RemoteHost
			.AddRecipient nick, para
			.Subject = asunto
			.ContentType = "text/html"
			.BodyText = mensaje
			if .SendMail = false then
				response.write("Error al enviar el E-Mail:<br>")
				response.write("<strong>Mensaje: </strong>" & .Response & "<br>")
			end if
		end with
		
		set Mailer = nothing
	end sub
	
	sub SendJMailEmail(de, nick, para, asunto, mensaje)
		Set objJMail = Server.CreateObject("JMail.SMTPMail")
		if isnumeric(body_tipo) = false then body_tipo = 0
		
		with objJMail
			.ServerAddress = RemoteHost
			.Sender = de
			.SenderName = nick
			.AddRecipient para
			.Subject = asunto
			if body_tipo = 1 then
				.Body = mensaje
			else
				.HTMLBody = mensaje
			end if
			.Silent = True
			.Priority = 3
			bSuccess = .Execute()
			if bSuccess = false then
				response.write("Error al enviar el E-Mail:<br>")
				response.write("<strong>Código: </strong>" & .ErrorCode & "<br>")
				response.write("<strong>Mensaje: </strong>" & .ErrorMessage & "<br>")
			end if
		end with
		
		Set objJMail = Nothing
	end sub
%>

call SendEmail(de, nick, para, asunto, mensaje)

call SendJMailEmail(de, nick, para, asunto, mensaje)

function InsertFlash(Path, FileName, Width, Height)
		with response
			.write("<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" " _
			& " codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""" & Width & """ " _
			& "height=""" & Height & """>")
			.write("<param name=""movie"" value=""" & Path & FileName & """>") & vbcrlf
			.write("<param name=menu value=false>") & vbcrlf
			.write("<param name=""quality"" value=""high"">") & vbcrlf
			.write("<embed src=""" & Path & FileName & """ quality=""high"" menu=""false"" pluginspage=""http://www.macromedia.com/go/getflashplayer""  " _
			& "type=""application/x-shockwave-flash"" width=""" & Width & """ height=""" & Height & """></embed>") & vbcrlf
			.write("</object>") & vbcrlf
		end with
	end function

call InsertFlash("ruta_del_swf", "archivo.swf", "Ancho_del_archivo", "alto_del_archivo")

Function FormatFecha(TIPO,FEC)
	dim myFEC
	SELECT CASE TIPO
		CASE "DMA"
			myFEC = (day(FEC)&"/"&month(FEC)&"/"&year(FEC))
		CASE "MDA"
			myFEC = (month(FEC)&"/"&day(FEC)&"/"&year(FEC))		
		CASE "ADM"				
			myFEC = (year(FEC)&"/"&day(FEC)&"/"&month(FEC))		
		CASE "AMD"				
			myFEC = (year(FEC)&"/"&month(FEC)&"/"&day(FEC))			
	END SELECT
	FormatFecha = myFEC
End Function

 
 
<%
Dim mensaje_error,hay_error
mensaje_error = ""
hay_error = false
 
sub manejoerror(error)
hayerror = true
mensaje_error = mensaje_error & error & ", "
response.write(vbCrLf & "<fieldset><legend><strong>ADVERTENCIA: Se ha producido un error</strong></legend>")
response.write(vbCrLf & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Error #:</b> " & err.number & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Fuente del Error:</b> " & err.source & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Descripci&oacute;n del Error:</b> " & err.description & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Fecha y Hora:</b> " & now() & "<br>")
response.write(vbCrLf & "	 <b>&nbsp;Pagina:</b> " & request.servervariables("SCRIPT_NAME") & "<br>")
		if request.cookies("login") = "" then
response.write(vbCrLf & "	 <b>&nbsp;Usuario:</b> An&oacute;nimo <br>")
else 
response.write(vbCrLf & "	 <b>&nbsp;Usuario:</b> " & request.cookies("login") & "<br>")
end if
response.write(vbCrLf & "<br>")
		response.write(vbCrLf & "<input type=""submit"" name=""Submit"" value=""Enviar a Soporte"" onClick=""javascript:window.location.href='enviar.asp';""> ")
		response.write(vbCrLf & "<input type=""submit"" name=""Submit"" value=""Imprimir Reporte"" onClick=""javascript:print();"">")
response.write(vbCrLf & "</fieldset>")
end sub
on error resume next
%>
<html><head></head><body></body></html>
<%
If err.number <> 0 Then
	manejoerror err.description
End If
%>

function FormatoNum(num,digitos)
largo = Len(Cstr(num))
dif = digitos - largo
if dif < 0 then exit function
if largo < digitos Then
x = String(dif,"0") & Cstr(num)
else
x = Cstr(num)
end if
FormatoNum = x
End Function

Function ultimodiadelmes(mes, ano)
DIm messig
messig = DateAdd("m", 1, DateSerial(ano, mes, "01"))
ultimodiadelmes = Day(DateAdd("d", -1, messig))
End Function

Response.Write "Ultimo día del mes Enero de 2005:" & ultimodiadelmes(1,2005)

 Borrar archivo 
 
Function BorrarArchivo(archivo)
	dim fs
	Set fs = Server.CreateObject("Scripting.FileSystemObject") 
	if fs.FileExists(archivo) then fs.DeleteFile(archivo)
	Set fs = Nothing
End function
 
arch = "c:\proyecto1\a.txt"
BorrarArchivo(arch)

Borrar Carpeta
 
Function BorrarCarpeta(carpeta)
	Dim fs
	Set fs = Server.CreateObject("Scripting.FileSystemObject")
	if fs.FolderExists(carpeta) then fs.DeleteFolder(carpeta)
	Set fs = Nothing
End Function
 
carp = "c:\proyecto1"
BorrarCarpeta(carp)

'session.lcid=1033 'setea la fecha en mmddyy
session.lcid=1034 'setea la fecha en ddmmyy

function dateToIwsDate(str)
	if isdate(str) = true then
		ano = year(str)
		mes = month(str)
		dia = day(str)
		hora= hour(str)
		minuto = minute(str)
		segundo = second(str)
		if len(ano) < 4 then ano = "20" & ano
		if len(mes) < 2 then mes = "0" & mes
		if len(dia) < 2 then dia = "0" & dia
		if len(hora) < 2 then hora = "0" & hora
		if len(minuto) < 2 then minuto = "0" & minuto
		if len(segundo) < 2 then segundo = "0" & segundo
		dateToIwsDate = ano&mes&dia&hora&minuto&segundo
	else
		dateToIwsDate= "19000101000000"
	end if
end function


function iwsDateToDate(str)
	if len(str) = 14 then
		ano = left(str,4)
		mes = mid(str,5,2)
		dia = mid(str,7,2)
		hora = mid(str,9,2)
		minuto = mid(str,11,2)
		segundo = right(str,2)
		x_fecha = ano & "/" & mes & "/" & dia & " " & hora & ":" & minuto & ":" & segundo
		if isdate(x_fecha) = true then
			iwsDateToDate = cdate(x_fecha)
		else
			iwsDateToDate = cdate(iwsDateToDate("19000101000000"))
		end if
	else
		iwsDateToDate = cdate(iwsDateToDate("19000101000000"))
	end if
end function

<% 
if request("url") <>"" then
set http_obj = createObject("Microsoft.XMLHTTP")
ulr=request("url")
http_obj.Open "GET",url,false
http_obj.Send()
codigo = Server.HTMLEncode(http_obj.responseText)
%>
<%=codigo%>
<%end if%>

<% 
if request("traducir") = "yes" then
set http_obj = createObject("Microsoft.XMLHTTP")
cadena2 = "http://babelfish.altavista.com/babelfish/tr?doit=done&intl=1&tt=urltext&urltext="&request("palabra")&"&lp=es_en" 
http_obj.Open "GET",cadena2,false
http_obj.Send()
codigo = Server.HTMLEncode(http_obj.responseText)
pos = instr(codigo, "10px;&gt;")
codigo = mid(codigo,pos+9,len(codigo))
pos2 = instr(codigo ,"&")
codigo = mid(codigo,1,pos2-1)
end if
%>
<form action="babel.asp" method="get">
<textarea name="palabra" cols="40" rows="10"><%=request("palabra")%></textarea><br>
<input type="hidden" name="traducir" value="yes">
<input type="submit"><br>
</form>
<%=codigo%>

<%
if request("traducir") = "yes" then
set http_obj = createObject("Microsoft.XMLHTTP")
cadena2 = "http://www.google.es/search?num=100&hl=es&q="&request("palabra")
http_obj.Open "GET",cadena2,false
http_obj.Send()
codigo = Server.HTMLEncode(http_obj.responseText)
codigo = replace(codigo,"&lt;","<")
codigo = replace(codigo,"&gt;",">")
codigo = replace(codigo,"<a","<a target=""new""")
pos = instr(codigo,"class=g")
codigo = mid(codigo,pos-3,len(codigo))
pos = instr(codigo,"clear=all")
codigo = mid(codigo,1,pos)
codigo = replace(codigo,"/search?","google.asp?")
codigo = "<table><tr><td>" & codigo
end if
%>
<html>
	<head>
		<style>
		<!--
body,td,div,.p,a{font-family:verdana }
div,td{color:#000}
.f,.fl:link{color:#6f6f6f}
a:link,.w,a.w:link,.w a:link{color:#800000;text-decoration:none;}
a:visited,.fl:visited{color:#551a8b}
a:active,.fl:active{color:#f00}
.t a:link,.t a:active,.t a:visited,.t{color:#000}
.t{background-color:#e5ecf9}
.k{background-color:#36c}
.j{width:34em}
.h{color:#36c}
.i,.i:link{color:#a90a08}
.a,.a:link{color:#008000}
.z{display:none}
div.n {margin-top: 1ex}
.n a{font-size:10pt; color:#000}
.n .i{font-size:10pt; font-weight:bold}
.q a:visited,.q a:link,.q a:active,.q {color: #00c; }
.b{font-size: 12pt; color:#00c; font-weight:bold}
.ch{cursor:pointer;cursor:hand}
.e{margin-top: .75em; margin-bottom: .75em}
.g{margin-top: 1em; margin-bottom: 1em}
//-->
</style>
	</head>
<body>
<form action="google.asp" method="get">
<input type="text" name="palabra" size="50"value="<%=request("palabra")%>"><br>
<input type="hidden" name="traducir" value="yes">
<input type="submit"><br>
</form>
<%=codigo%>

</body>
</html>

 
Sub calculartiempo(dia, mes, ano, f)
Dim fecha, formatosalida,t
fecha= dia & "/" & mes& "/" & ano
if f = 1 then
formatosalida = "d"
end if
if f =2 then 
formatosalida = "m"
end if
if f = 3 then
formatosalida = "yyyy"
end if
t = DateDiff(formatosalida,fecha,Date())
response.write t
End Sub

sub redirecionar(url)
	escribe "<script>"
	escribe "window.location ="""& url &""";"
	escribe "</script>"
end sub

parametro = request("parametro")
if len(parametro) = 0 then
            mensaje "Se esperaba parametro"
            redireccionar "default.asp"
            termina
end if

sub redirecionar(url)
   response.redirect url
end sub

redireccionar "mipagina.asp"

 
sub redirecionar(url,target) 
   if target = 1 then
	  target = "window"
   end if
   if target = 2 then
	  target = "self"
   end if
   if target = 3 then
	  target = "top"
   end if
   if target = 4 then
	  target = "parent"
   end if
   if target = 5 then
	  target = "blank"
   end if
 
escribe "<script>"
escribe target &".location ="""& url &""";"
escribe "</script>"
end sub

 
' esto nos ubica la pagina default.asp en la ventana principal
redireccionar "default.asp", 1

 
' esta nos ubica la pagina en un marco especificado
' donde dice mimarco se debe colocar el nombre de
' tu frame donde deseas qeu aparezca la pagina.
redireccionar "default.asp", "mimarco"