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. Como ya lo propusieron por ahi, la idea es publicar clases, funciones y subrutinas de uso cotidiano que automaticen tediosas lineas de codigo que repetimos ...

  #1 (permalink)  
Antiguo 13/10/2004, 18:46
Avatar de Muzztein  
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 21 años, 7 meses
Puntos: 16
Exclamación Biblioteca de Clases,Funciones y Sub-rutinas.

Como ya lo propusieron por ahi, la idea es publicar clases, funciones y subrutinas de uso cotidiano que automaticen tediosas lineas de codigo que repetimos una y otra vez.

¿El fin ultimo ?

1) Lograr hacer un seudo lenguaje propio de nosotros que separe correctamente el "Que hacer" del "Como hacerlo".

2) Hacer un codigo mas facil de leer para facilitar la mantencion de nuestros sistemas.

3) Ahorrar tiempo de mantencion y elaboracion

4) Ayudarnos mutuamente

Como hacerlo: Pegar el codigo y comentar para que sirve y en que circunstancias sirve.

Reglas :
1) Los codigos pueden ser modificados y son de uso público.
2) Las clases, funciones o sub rutinas , deben tener nombres en español y explicitar claramente para que sirven.

Empecemos.

Última edición por Muzztein; 13/10/2004 a las 18:57
  #2 (permalink)  
Antiguo 13/10/2004, 18:55
Avatar de Muzztein  
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 21 años, 7 meses
Puntos: 16
Nivel: Facilitas

Sub Rutina hecha para ahorrarse el escribir de mas.
Escribe en pantalla el string deseado seguido de un salto de carro, ideal para armar xml y escribir java scripts dinamicamente o cosas por el estilo.
Código:
sub escribe(str)
response.write str & chr(10)
end sub


Sub rutina familiar a la anterior, la diferencia que en vez de salto de carro imprime un br de HTML lo que permite imprimir en pantalla mas ordenadamente algun dato X.
Código:
sub imprime(str)
response.write str & "<br>"
end sub

Sub rutina que termina la ejecucion, Hecha con el finde de escribir poco.
Código:
sub termina()
response.end
end sub


Sub rutina que imprime un mensaje de alerta de Java Script, Depende de la funcion "escribe".
Código:
sub mensaje(txt)
escribe "<script>"
escribe "alert(""" & txt & """)"
escribe "</script>" 
end sub



Sub rutina que dado un pop up, lo cierra y recarga el marco que abrio dicho pop up. Especial para mantenedores que actualizan datos en otras pantallas.
Código:
sub cierra_y_recarga
escribe "<script>" 
escribe "window.opener.location.reload();"
escribe "window.close();"
escribe "</script>" 
end sub
  #3 (permalink)  
Antiguo 14/10/2004, 11:11
Avatar de u_goldman
Moderador
 
Fecha de Ingreso: enero-2002
Mensajes: 8.031
Antigüedad: 22 años, 2 meses
Puntos: 98
Útil para ver los elementos que llegan de un querystring o de un form

Código:
Sub Depura(accion)
 If accion = "qs" Then
   For each elemento in request.querystring
      Response.Write elemento & " = " & request.querystring(elemento) & "<br>"
   Next
 ElseIf accion = "frm" Then
   For each elemento in request.form
      Response.Write elemento & " = " & request.form(elemento) & "<br>"   
   Next
 End If
 Response.End
End Sub
Depura "frm"

Salu2,
__________________
"El hombre que ha empezado a vivir seriamente por dentro, empieza a vivir más sencillamente por fuera."
-- Ernest Hemingway

Última edición por u_goldman; 14/10/2004 a las 11:12
  #4 (permalink)  
Antiguo 14/10/2004, 15:45
Avatar de AlZuwaga
Colaborador
 
Fecha de Ingreso: febrero-2001
Ubicación: 34.517 S, 58.500 O
Mensajes: 14.550
Antigüedad: 23 años
Puntos: 535
Una recién salida del horno
Sirve para generar un <select> con opciones obtenidas de una base de datos.
Hay que aclarar que la conexión a la BD y el recordset ya deben estar presentes en el script:


Código:
Function genera_select(txtNombre_ID, numLineas, Multi, txtClass, txt1erOpcion, objRecordset, campoValue, campoDesc)
	If Multi = "Multiple No" Then Multi = "" Else Multi = "Multiple"
	Response.Write "<select name=""" & txtNombre_ID & """ id=""" & txtNombre_ID & """ size=""" & numLineas & """ class=""" & txtClass & """" & Multi & ">" & VBCrLf
	If txt1erOpcion <> "" Then Response.Write "<option value="""">" & txt1erOpcion & "</option>" & VBCrLf
	Do While Not objRecordset.EOF
		Response.Write "<option value=""" & objRecordset(campoValue) & """>" & objRecordset(campoDesc) & "</option>" & VBCrLf
	objRecordset.MoveNext
	Loop
	Response.Write "</select>" & VBCrLf
End Function

Se la llama así:

Código:
genera_select "nombre_del_select", "cantidad_de_lineas", "es_multiple", "nombre_de_clase", "primero_a_mostrar", nombre_del_recordset, "campo_en_value", "campo_a_mostrar"

En donde:
Cita:
nombre_del_select es el nombre que se le dará al select (alfanumerico)
cantidad_de_lineas es la cantidad de líneas que mostrará (numérico)
es_multiple indica si permitirá selecciones múltiples (alfanumerico. "Multiple No" para NO y vacío o cualquier otra cosa para SI)
nombre_de_clase le asigna un estilo al <select> (alfanumerico)
primero_a_mostrar el primer elemento del <select> (alfanumerico. Dejar vacío para ignorarlo)
nombre_del_recordset es el nombre del objeto recordset del que tomaran los datos (objeto. no va entre comillas)
campo_en_value es el nombre del campo de la BD que se le asignará al value del <select> (alfanumerico)
campo_a_mostrar es el nombre del campo de la BD que se le asignará a lo que muestre el <select> (alfanumerico)

Ejemplo de uso:

Código:
<form...>
<% genera_select "MiSelect", "1", "Multiple No", "estilo10", "Seleccione una opción", Rs, "ID", "Descripcion"  %>
</form>
__________________
...___...
  #5 (permalink)  
Antiguo 14/10/2004, 16:59
Avatar de lexus  
Fecha de Ingreso: enero-2002
Ubicación: Cali - Colombia
Mensajes: 2.234
Antigüedad: 22 años, 2 meses
Puntos: 4
se usa en el caso en qeu tengamos muchas bases de datos en un mismo sitio,

Código:
 
function conx_bd(nombre_bd)
'#####################################
  'CONEXION A BASE DE DATOS 
  'EL PARAMETRO nombre_bd CORRESPONDE AL NOMBRE DE LA
' BASE DE DATOS QUE SE DESEE ABRIR
'#####################################
con = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
"Data Source="& Server.MapPath("carpeta/"&nombre_bd&".mdb")&";"  & _
"Jet OLEDB:Database Password=tuclaveaqui;"
set conx = Server.Createobject("adodb.connection")
conx.open con
conx_bd = conx
end function

el llamado lo hacemos asi.

Código:
 
sql= "SELECT * FROM tutabla"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open sql, conx_bd("tubasededatossinextencion"),  3, 3
a simple vista no parece util, pero cuanto tienes muchas bases de datos veras qeu te facilita mucho las cosas.

por cierto muy buena idea la de crear este post, se que nos sera muy util a todos.. espero qeu todos aportemos para hacer crecer esta biblioteca de funciones y subrutinas
__________________
Control de Visitantes, Control de Accesos, Minutas digitales, Manejo de Correspondencia
http://www.controldevisitantes.com
  #6 (permalink)  
Antiguo 14/10/2004, 18:30
Avatar de u_goldman
Moderador
 
Fecha de Ingreso: enero-2002
Mensajes: 8.031
Antigüedad: 22 años, 2 meses
Puntos: 98
Obtiene el máximo valor de un campo campo en "x" tabla, se necesita una conexión activa (en negritas), si es fin de archivo (EOF), regresa un 0

Código:
<%
Function GetMyMaxId(table, field)
	Set rsGetMyMaxId = Server.CreateObject("ADODB.Recordset")
	strSQLGetMyMaxId = "SELECT MAX(" & field & ") AS myMax FROM " & table
	rsGetMyMaxId.Open strSQLGetMyMaxId, ObjConn, 3, 3
	fnctMyMaxId = rsGetMyMaxId("myMax")
	If IsNull(fnctMyMaxId) Then
		fnctMyMaxId = 0
	End If
	rsGetMyMaxId.Close
	Set rsGetMyMaxId = Nothing
	GetMyMaxId = fnctMyMaxId
End Function
%>
Llamada a la función
Cita:
MaxID = GetMyMaxId("tabla", "campo")
Salu2,
__________________
"El hombre que ha empezado a vivir seriamente por dentro, empieza a vivir más sencillamente por fuera."
-- Ernest Hemingway

Última edición por u_goldman; 15/10/2004 a las 10:44
  #7 (permalink)  
Antiguo 15/10/2004, 08:34
Avatar de Myakire
Colaborador
 
Fecha de Ingreso: enero-2002
Ubicación: Centro de la república
Mensajes: 8.849
Antigüedad: 22 años, 1 mes
Puntos: 146
Sirve para ver las tablas que existen en la BD's.

Código:
<!-- #INCLUDE File="adovbs.inc" -->
<script runat=server LANGUAGE="VBSCRIPT">
  Dim oConn,rstSchema
  Set oConn = Server.CreateObject("ADODB.Connection")
  Set rstSchema = Server.createobject("ADODB.Recordset")
  oConn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("rebe_pad.mdb"))
  Set rstSchema = oConn.OpenSchema(adSchemaTables)
	response.write "<table>"
  Do Until rstSchema.EOF
     Response.Write "<tr><td>Tabla: " & rstSchema("TABLE_NAME")
     Response.Write "<td>Tipo: " & rstSchema("TABLE_TYPE")
     rstSchema.MoveNext
  Loop
  rstSchema.Close 
  oConn.Close
</script>
  #8 (permalink)  
Antiguo 15/10/2004, 08:38
Avatar de Myakire
Colaborador
 
Fecha de Ingreso: enero-2002
Ubicación: Centro de la república
Mensajes: 8.849
Antigüedad: 22 años, 1 mes
Puntos: 146
Obtiene el total de registros de una BD's (a mi me los han preguntado, ¿qué se le va a hacer?, tal vez a otro también se los pregunten, ), solo falta agregar la conexión.

Código:
set adoRs = Server.CreateObject("adodb.recordset")
Query = "SELECT name FROM  sysobjects WHERE (xtype = 'U') AND (status > 0)"
adoRs.Open Query,cnn
suma = 0
%>
<table><tr><td>Nombre de la tabla<td>registros<%
while Not adoRs.EOF
     set adoRs2 = Server.CreateObject("adodb.recordset")
     adoRs2.CursorLocation = adUseClient
     sql = "Select count(*) as reg from "&adoRs("name")	 
    adoRs2.Open sql,cnn
%><tr><td><%=adoRs("name")%><td><%=adoRs2("reg")%></tr><%
    suma = suma + adoRs2("reg")
    adors2.Close
    adors2 = null		
    adoRs.moveNext
wend
%></Table><%
response.write "<hr><br>Registros Totales: " & Suma
%>
  #9 (permalink)  
Antiguo 15/10/2004, 10:04
 
Fecha de Ingreso: mayo-2003
Mensajes: 866
Antigüedad: 20 años, 10 meses
Puntos: 0
Cita:
Iniciado por Myakire
Sirve para ver las tablas que existen en la BD's.

Código:
<!-- #INCLUDE File="adovbs.inc" -->
<script runat=server LANGUAGE="VBSCRIPT">
  Dim oConn,rstSchema
  Set oConn = Server.CreateObject("ADODB.Connection")
  Set rstSchema = Server.createobject("ADODB.Recordset")
  oConn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("rebe_pad.mdb"))
  Set rstSchema = oConn.OpenSchema(adSchemaTables)
	response.write "<table>"
  Do Until rstSchema.EOF
     Response.Write "<tr><td>Tabla: " & rstSchema("TABLE_NAME")
     Response.Write "<td>Tipo: " & rstSchema("TABLE_TYPE")
     rstSchema.MoveNext
  Loop
  rstSchema.Close 
  oConn.Close
</script>
Se puede poner tambien esto:
Response.Write "<td>Ubicacion: " & rstSchema("TABLE_CATALOG")
Saludos
  #10 (permalink)  
Antiguo 15/10/2004, 11:25
Avatar de AlZuwaga
Colaborador
 
Fecha de Ingreso: febrero-2001
Ubicación: 34.517 S, 58.500 O
Mensajes: 14.550
Antigüedad: 23 años
Puntos: 535
Reemplaza los retornos de carro por un salto de línea HTML e interpreta TAB's en el texto.

ATENCIÓN: Eliminar de &-#09; el guión rojo (ocurre que el foro interpreta el TAB en vez de muestrar su código)


Código:
<%
Function txt2htm(txt)
	txt2htm = txt
	txt2htm = Replace(txt2htm, VBCrLf, "<br>" & VBCrLf)
	txt2htm = Replace(txt2htm, CHR(9), "<pre style='display:inline'>&-#09;</pre>")
End Function
%>
Se la llama así:
Código:
<% Response.Write txt2htm(Fuente_de_datos) %>
En donde Fuente_de_datos puede ser el campo de una BD, el contenido de un archivo de texto, el de un campo de formulario, etc.


Editado el 18/10/2004 porque me tengo que quitar la maldita costumbre de meter "responseS.writeS" dentro de la funciones
__________________
...___...

Última edición por AlZuwaga; 18/10/2004 a las 18:09
  #11 (permalink)  
Antiguo 17/10/2004, 16:47
Avatar de Bravenap  
Fecha de Ingreso: noviembre-2002
Ubicación: Los Arroyos, El Escorial, Madrid
Mensajes: 2.084
Antigüedad: 21 años, 4 meses
Puntos: 4
Presentar un texto tabulado en una tabla

A veces, se tienen ciertos archivos de texto que funcionan como una base de datos: cada línea es un registro y los campos están separados por un tabulador.

Esta es una subrutina para poder presentar en una tabla esos datos y que sea más fácil su lectura. La acabo de hacer y funciona, aunque claro está, es muy depurable y adaptable.

La subrutina es la siguiente:

Código:
Sub tabularTexto(archivo)

Dim objFSO
Dim objTextStream
Dim registro()
Dim numCampos,numRegistros
Dim campo
Dim i,n

Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(archivo) Then
	Set objTextStream = objFSO.OpenTextFile(archivo, 1) 'Método 1: "sólo lectura"
	i=0
	Do while not objTextStream.AtEndOfStream
      		Redim Preserve registro(i)
		registro(i) = objTextStream.ReadLine
		i = i + 1
	Loop


	numCampos = Ubound(Split(registro(0),Chr(9)))+1
	numRegistros = i

	Response.Write("<table border=1>")
	Response.Write("<tr>")
	For n=0 to numCampos-1
		Response.Write("<th>Campo " & n & "</th>")
	Next
	Response.Write("</tr>")
	For i=0 to Ubound(registro)
		Response.Write("<tr>")
		campo = Split(registro(i),Chr(9))
		For n=0 to numCampos-1
			Response.Write("<td>")
			Response.Write(campo(n))
			Response.Write("</td>")
		Next
		Response.Write("</tr>")
	Next
	Response.Write("</table>")
	Response.Write("Campos: " & numCampos & "<br>Registros: " & i)

Else
	Response.Write("No existe el archivo " & archivo)
End If

End Sub
Se le pasa la ruta completa del archivo a leer, por ejemplo:

tabularTexto(Server.MapPath("ejemplo.txt"))

y el contenido de ejemplo.txt es algo así:

Código:
campoA1	campoA2
campoB1	campoB2
Si en lugar de tabuladores tenemos, por ejemplo, puntos y comas (;) no hay más que cambiar esta línea:

Código:
campo = Split(registro(i),";")
Un saludo.
__________________
¡¡NO A LA GUERRA!!
Si ponemos a nuestros mensajes títulos adecuados, la gente se animará más a abrirlos y resultarán más útiles en las busquedas. ¡No a los ayuuudaaa, urgenteee y similares!
  #12 (permalink)  
Antiguo 18/10/2004, 06:39
Avatar de Muzztein  
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 21 años, 7 meses
Puntos: 16
Conexiones a base de datos.

a todos !

Aqui ahora les coloco una conjunto de rutinas y funciones que permiten conectarse a cualquier base de datos transaccional sin DSN (probado en sql server y oracle)

En un include colocar

Código:
	dim dbcSuperConexion
	db_provider = "sqloledb" 'tipo de conexion
	db_userid = "test" ' usuario a usar 
	db_password = "test" ' password del usuario a usar
	db_database = "test" ' nombre de la base de datos
	db_datasource = "10.10.10.10" ' Numero IP o Nombre del servidor que contiene la base de datos



sub abre_conexion

Set dbcSuperConexion = Server.CreateObject("ADODB.Connection")
  On Error Resume Next
            dbcSuperConexion.Open "Provider=" & db_Provider & ";" _
                    & "Data Source=" & db_DataSource & ";" _
                    & "User Id=" & db_UserID & ";" _
                    & "Password=" & db_Password & ";" _
                    & "Database=" & db_Database & ";"
                    
   If Err.Number <> 0 Then
	 escribe "Error en la Conexion a la Base de Datos"
   end if
end sub


sub cierra_conexion
dbcSuperConexion.Close
Set dbcSuperConexion = Nothing
end sub


function ejecuta(strsql)
	on error resume next
	Set dbcRec = Server.CreateObject("ADODB.RecordSet")
        Set dbcRec = dbcSuperConexion.Execute(strSQL)
        If Err.Number <> 0 Then
        	ejecuta = False
        else
        	ejecuta = True
        end if
        dbcRec.Close
	Set dbcRec = Nothing
end function
y el codigo quedaria asi de simplecito y facil de leer

Código:
abre_conexion
strsql = "poner aqui string sql a ejecutar"
ejecuta(strsql)
cierra_conexion
TA DA !!!!!!!!
  #13 (permalink)  
Antiguo 18/10/2004, 10:36
Avatar de AlZuwaga
Colaborador
 
Fecha de Ingreso: febrero-2001
Ubicación: 34.517 S, 58.500 O
Mensajes: 14.550
Antigüedad: 23 años
Puntos: 535
Reemplaza la comilla simple, que jode a las sentencias SQL, por dos de ellas seguidas. Además, evita el "SQL injection"

Código:
<%
Function RyL(elemento)
	'RyL significa Recibe y Limpia
	If Request.QueryString(elemento).Count > 0 Then RyL = Request.QueryString(elemento)
	If Request.Form(elemento).Count > 0 Then RyL = Request.Form(elemento)
	RyL = Replace(RyL, "'", "''")
	' Agregar aquí todos los Replace() que crean necesarios
End Function
%>

Ejemplo de uso:

Código:
SQL = "INSERT INTO tabla (Campo1, Campo2) VALUES ('"& RyL("Elemento1") &"', '"& RyL("Elemento2") &"')"
__________________
...___...

Última edición por AlZuwaga; 18/10/2004 a las 10:39
  #14 (permalink)  
Antiguo 18/10/2004, 16:02
Avatar de AlZuwaga
Colaborador
 
Fecha de Ingreso: febrero-2001
Ubicación: 34.517 S, 58.500 O
Mensajes: 14.550
Antigüedad: 23 años
Puntos: 535
Función para hacer insert's "simples" a una tabla (está en desarrollo)
Si se trata de un insert algo más complejo con "parseo" de cadenas, validaciones server-side, etc, mejor dejar esto de lado y construir la sentencia SQL normalmente

Todos los campos del formulario deberán llamarse como los campos de la tabla donde se insertarán y tendrán como prefijo uno de los siguientes (para todos los casos, sin las comillas):
- "str" para datos que se inserten en campos text *
- "num" para datos que se inserten en campos numéricos
- "s_n" para datos que se inserten en campos si/no
- "ni_" para todo campo del formulario que no se desee insertar en la BD (ej: el botón submit )

Los campos tipo 'si/no' deberán tener valor predeterminado = No en la tabla.
El motivo de esto es que si el checkbox no ha sido 'checkeado', no aparece en la colección FORM. Y si no aparece, no se puede establecer el valor como FALSE... quedando su valor como el valor predeterminado del campo en la tabla (o ninguno)


Código:
<%
Function Insertar(Tabla)
	' Empiezo a construir la sentencia SQL
	SQL = "INSERT INTO " & Tabla & " ("
	' Reviso la colección FORM para colocar el nombre de los campos en la sentencia SQL
	For i = 1 to Request.Form.Count()
		Campo = Request.Form.key(i)
		' Verifico que el campo sea "insertable"
		If Left(Campo, 3) <> "ni_" Then
			'El campo es "insertable"
			Campo = Replace(Campo, "str", "")
			Campo = Replace(Campo, "num", "")
			Campo = Replace(Campo, "s_n", "")
			SQL = SQL & Campo & ", "
		End if
	next 
	'Quito la última comilla, el espacio final y concateno
	SQL = Mid(SQL, 1, Len(SQL) - 2)
	SQL = SQL & ") VALUES ("
	'Recorro nuevamente la colección FORM para seguir generando la sentencia SQL
	For i = 1 to Request.Form.count()
		' Obtengo el tipo de dato, el nombre de campo y el valor del mismo
		Tipo = Left(Request.Form.key(i), 3)
		Campo = Mid(Request.Form.key(i),4 , Len(Request.Form.key(i)))
		Valor = Request.Form.item(i)
		
		' Si se trata de una campo text lo coloco entre apóstrofes
		If Tipo = "str" Then SQL = SQL & "'" & Replace(Valor, "'", "''") & "', "
		' Si se trata de un campo numérico va sin los apóstrofes
		If Tipo = "num" Then
			SQL = SQL & Valor & ", "
			' Si el valor ingresado no es un número, arroja un mensaje de error y detiene el proceso
			If NOT IsNumeric(Valor) Then
				Response.Write "<STRONG>Error:</STRONG> " _
					& "El campo '" & campo & "' recibe valores incorrectos" _
					& " (<span style='color:#FF0000'>" & Valor & "</span>). Debería ser un número válido.<br>" _
					& "La operación no se ha efectuado."
				Response.End
			End if
		End if
		' Si es un campo si/no convierto a True (-1) si es que ha sido 'checkeado'.
		' Si no ha sido 'checkeado' no lo puedo identificar, así que el campo en la tabla deberá...
		'... tener como valor predeterminado False (0, No o lo que corresponda)
		If Tipo = "s_n" Then
			If Valor <> "" Then Valor = -1 Else Valor = 0
			SQL = SQL & Valor & ", "
		End if
		
	next 
	' Nuevamente elimino la última comilla y el espacio
	SQL = Mid(SQL, 1, Len(SQL) - 2)
	' Finalmente, cierro la sentencia SQL
	SQL = SQL & ")"
	
	' Le doy a la función el valor de la sentencia SQL
	Insertar = SQL
End Function
%>

Formulario de ejemplo:

Código:
<form ...>
Nombre: <input name="strNombre" type="text">
Apellido: <input name="strApellido" type="text">
Edad: <input name="numEdad" type="text">
Este no se guarda: <input name="ni_Control" type="text">
Activo? <input name="s_nActivado" type="checkbox" value="checkbox">
<input name="ni_Submit" type="submit" value="Enviar">
</form>

Se la llama así:

Código:
<%
'Reemplazar Response.Write por objetoConexion.Execute
Response.Write(Insertar("MiTabla"))
%>

Todavía no la usé ni sé si vale la pena usarla, pero se me ocurrió hacerla


Correcciones:
- 21/10/2004 La línea marcada con * decía "txt", como prefijo, cuando debía decir "str". Fue modificado en el texto original.
__________________
...___...

Última edición por AlZuwaga; 21/10/2004 a las 12:28
  #15 (permalink)  
Antiguo 18/10/2004, 18:20
Avatar de AlZuwaga
Colaborador
 
Fecha de Ingreso: febrero-2001
Ubicación: 34.517 S, 58.500 O
Mensajes: 14.550
Antigüedad: 23 años
Puntos: 535
Sirve para cortar cadenas de caracteres muy largas (que no contengan espacios) y así evitar que desformen nuestras tablas al, por ejemplo, dejar un mensaje en un foro.
Importante: Hace uso de la función txt2htm(txt) así que ésta también debe estar presente al momento de usarla.


Código:
<%
Function CortarLargos(a_cortar, Largo, Separador)

arrCadena = Split(a_cortar, " ")

For i = 0 to UBound(arrCadena)
If Len(arrCadena(i)) > Largo Then

Veces = (Len(arrCadena(i)) \ Largo) + 1

For j = 1 To Veces
Tmp = Mid(arrCadena(i),(j*Largo) - (Largo - 1), Largo)
Tmp2 = Tmp2 & Tmp & Separador
Next

Tmp2 = Left(Tmp2, Len(Tmp2) - Len(Separador))
arrCadena(i) = Tmp2
End if

Next

CortarLargos = Join(arrCadena)
CortarLargos = txt2htm(CortarLargos)

End Function
%>
Se la llama así
Código:
<% Response.Write CortarLargos(Fuente_de_datos, "Cantidad_de_caracteres", "separador_usado") %>
En donde:

-Fuente_de_datos puede ser el campo de una BD, etc.. (variable)
-Cantidad_de_caracteres es la cantidad máxima de caracteres permitidos para una palabra laaaaargaaaa (numerico)
-separador_usado será lo que divida la palabra larga que se exceda de Cantidad_de_caracteres (string)
__________________
...___...

Última edición por AlZuwaga; 07/07/2005 a las 15:27
  #16 (permalink)  
Antiguo 20/10/2004, 14:18
Avatar de AlZuwaga
Colaborador
 
Fecha de Ingreso: febrero-2001
Ubicación: 34.517 S, 58.500 O
Mensajes: 14.550
Antigüedad: 23 años
Puntos: 535
Muestra el criterio buscado en el contexto del texto donde se encuentre.
Cuando buscamos una palabra en, por ejemplo, una base de datos de noticias, lo que solemos hacer es mostrar los, supongamos, 250 primeros caracteres de un campo. Qué pasa si la palabra buscada no aparece dentro de esos 250 caracteres? Pues, obvio: que no se muestra en ese pequeño extracto. Para solventar ese inconveniente, se me ocurrió hacer esto:


Código:
Function MostrarResult(numLongitud, strTxt, strCriterio)

	varAparicion1 = InStr(LCase(strTxt), LCase(strCriterio))
	
	If varAparicion1 > numLongitud Then
		Mitad = (numLongitud - Len(strCriterio)) \ 2
		PrimerMitad = Mid(strTxt, varAparicion1 - Mitad, Mitad)
		SegundaMitad = Mid(strTxt, varAparicion1 + Len(strCriterio), Mitad)
		Recorte = "...<EM>" & PrimerMitad & "<STRONG>" & strCriterio & "</STRONG>" & SegundaMitad & "</EM>..."
	Else
		Recorte = Left(strTxt, numLongitud + Len(strCriterio))
		Recorte = "<EM>" & Replace(Recorte, strCriterio, "<STRONG>" & strCriterio & "</STRONG>",1,1000,1) & "</EM>..."
	End if
	MostrarResult = Recorte
End Function
Se la llama así:
Código:
Response.Write MostrarResult(cantidad_caracteres, Fuente_de_datos, el_criterio)
En donde:
-cantidad_caracteres es la cantidad de caracteres que se mostrará a manera de extracto
-Fuente_de_datos puede ser el campo de una BD, etc..
-el_criterio es justamente lo que se está buscando dentro de Fuente_de_datos

Estaría bueno modificarla para que, además de hacerlo para la primer coincidencia, haga lo mismo para las coincidencias restantes dentro del texto.. pero eso para otra oportunidad
__________________
...___...
  #17 (permalink)  
Antiguo 23/10/2004, 10:09
Avatar de Muzztein  
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 21 años, 7 meses
Puntos: 16
Exclamación EscribeEnDisco

Funcion que toma un texto y lo guarda en un archivo en el disco duro..


Obviamente se necesita tener poder de escritura sobre la carpeta donde se esta guardando el archivo.
Si es que se ejecuta multiples veces, la funcion abrirá el documento y le anexara la nueva entrada de texto.

Es especial para hacer tus propios LOGS y sistemas de control por el estilo.


Código:
Function EscribeEnDisco(texto,archivo)
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
   Dim fso, f, ts
   Set fso = CreateObject("Scripting.FileSystemObject")
   
   On Error Resume next
   Set f = fso.GetFile(archivo) 

  
   if Err.number <> 0 then
	 fso.CreateTextFile archivo  
	 Set f = fso.GetFile(archivo)
   End if
   
   Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)
   ts.Write texto & Vbcrlf
   ts.Close
   Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
   EscribeEnDisco = ts.ReadLine
   ts.Close
End Function
Para llamarla se hace asi.


Código:
EscribeEnDisco now , "c:\testing_datos.txt"
este ejemplo escribira la fecha actual en un documento y lo guardara en el archivo que se especifica.


  #18 (permalink)  
Antiguo 23/10/2004, 12:09
Avatar de Muzztein  
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 21 años, 7 meses
Puntos: 16
Funciones para hacer lo9gins e inserts mas seguros

Esta funcioncita lo que hace es preparar un string para hacer un login y evitar posibles jaqueos como el de insertar trozos de SQL para engañar la validacion del usuario, entre otras cosas.


Código:
function prepara_str_para_login(str)
str = trim(str)
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,">","]")
prepara_str_para_login = str
end function
y esta otra funcioncita prepara un string para una insercion evitando las comillas y que te coloquen html, es la misma idea que el anterior , pero mas ajustada al asunto de los inserts

Código:
function prepara_str_para_insert(str)
str = trim(str)
str = replace(str,"'","''")
str = replace(str,"<","[")
str = replace(str,">","]")
prepara_str_para_insert = str
end function
  #19 (permalink)  
Antiguo 23/10/2004, 12:38
Avatar de trasgukabi  
Fecha de Ingreso: septiembre-2004
Mensajes: 2.749
Antigüedad: 19 años, 6 meses
Puntos: 18
más prevención de sql injection

Se pueden añadir estas líneas a la función de Muzztein:

Código:
 
  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","")
  str=replace(str,"--","")
  #20 (permalink)  
Antiguo 24/10/2004, 16:41
Avatar de Muzztein  
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 21 años, 7 meses
Puntos: 16
Checa numerico con valores por defecto

topisimo, eso si. una consulta. Por que hay que tener cuidado con el "--"



aqui va otra funcioncita muy util

Sirve para chequear si es que un valor en una variable es numerico o no, en el caso de que no sea numerico o venga vacio o sea nulo, le asigna un valor por defecto.

Especial para chequear la entrada de algun ID

Código:
function checa_numerico_con_defecto(id,defecto)
	if id = "" or isnumeric(id) = false or isnull(id) = true then 
	checa_numerico_con_defecto = defecto
	else
	checa_numerico_con_defecto = id
	end if
end function

ejemplo:

id_class = checa_numerico_con_defecto(request("id_class"),2)


Última edición por Muzztein; 24/10/2004 a las 16:45
  #21 (permalink)  
Antiguo 24/10/2004, 17:41
Avatar de trasgukabi  
Fecha de Ingreso: septiembre-2004
Mensajes: 2.749
Antigüedad: 19 años, 6 meses
Puntos: 18
Muzztein: Vete a http://clusty.com y escribe en la caja de texto
sql "--" , por ejemplo. ya verás que risas, ya.

"--" se usa para comentarios SQL en algunas bases de datos, pero en las que no, puede causar lo que ves ahí.

Un saludo.




Un buen artículo sobre SQL Injection en dos partes en el cual viene explicado el mal uso de -- (AY, PILLÍN, PILLÍN!!!! :-p ) en esta técnica:

**Los artículos son de Kriptopolis

1ª Parte

2ª Parte

Última edición por trasgukabi; 25/10/2004 a las 12:25 Razón: MÁS DATOS
  #22 (permalink)  
Antiguo 25/10/2004, 10:57
Avatar de Muzztein  
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 21 años, 7 meses
Puntos: 16
Funcion que evita el inundamiento o flood

Funcion util para evitar que un usuario ejecute una accion repetidas veces, como; inserciones,actualizaciones o busquedas que apañen el desempeño del sistema.

ejemplo de uso

Ejemplo que obliga esperar 30 segundos entre ejecucion de busquedas.

Código:
ultima_busqueda = session("ultima_busqueda")
hora_actual = now

if permite_accion(ultima_busqueda,hora_actual,"s",30) = true then
	session("ultima_busqueda") = now
	response.write  "puede ejecutar la busqueda"
else
	response.write  "NO puede ejecutar la busqueda"
end if


Codigo



Código:
function permite_accion(fecha_ultima_accion,fecha_intento_accion,Hora_Minuto_o_Segundo,cantidad_de_espera)

	if isdate(fecha_ultima_accion) = false or isdate(fecha_intento_accion)= false then
		permite_accion = true
	end if

   Select Case lcase(Hora_Minuto_o_Segundo)
      Case "hora"	     Hora_Minuto_o_Segundo = "h"
      Case "minuto"		 Hora_Minuto_o_Segundo = "n"
      Case "segundo"     Hora_Minuto_o_Segundo = "s"
      Case "h"			 Hora_Minuto_o_Segundo = "h"
      Case "m"			 Hora_Minuto_o_Segundo = "n"
      Case "s"			 Hora_Minuto_o_Segundo = "s"
      Case Else			 Hora_Minuto_o_Segundo = "n"
   End Select

   if isnumeric(cantidad_de_espera) = false or isnull(cantidad_de_espera) = true or cantidad_de_espera="" then
		permite_accion = true
   end if

	intervalo = datediff(hora_minuto_o_segundo,fecha_ultima_accion,fecha_intento_accion)
	
	if intervalo < cantidad_de_espera then
		permite_accion = false
	else
		permite_accion = true
	end if
end function


  #23 (permalink)  
Antiguo 25/10/2004, 20:16
Avatar de edu007ar  
Fecha de Ingreso: septiembre-2003
Ubicación: Buenos Aires
Mensajes: 118
Antigüedad: 20 años, 5 meses
Puntos: 0
Esta función sirve para generar claves aleatorias especificando el listado de caracteres que puede incluir dicha clave.

-----------------------------------------------
Function generadordeclaves(longituddeclave)
char_array = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c")
Randomize()
Do While Len(salida) < longituddeclave
salida = salida & char_array(Int(8 * Rnd()))
Loop
generadordeclaves = salida
End Function
-----------------------------------------------

y se la llama de la siguiente manera

response.write generadordeclaves(9)
  #24 (permalink)  
Antiguo 25/10/2004, 20:18
Avatar de edu007ar  
Fecha de Ingreso: septiembre-2003
Ubicación: Buenos Aires
Mensajes: 118
Antigüedad: 20 años, 5 meses
Puntos: 0
Esta otra función sirve para elegir un número aleatorio especificando un mínimo y un máximo:

---------------------------------------------
Function RandomNumber(inicio, fin)
Randomize()
RandomNumber = Int((fin - inicio + 1) * Rnd + inicio)
End Function
---------------------------------------------

y se la llama de la siguiente manera:

response.write RandomNumber(8, 55)

Esto va a devolver un número aleatorio entre 8 y 55
  #25 (permalink)  
Antiguo 25/10/2004, 20:21
Avatar de edu007ar  
Fecha de Ingreso: septiembre-2003
Ubicación: Buenos Aires
Mensajes: 118
Antigüedad: 20 años, 5 meses
Puntos: 0
Y esta otra sirve para saber si un número es par o impar:

----------------------------------------------------
function paroimpar(num)
select Case abs(num) mod 2
case 0: paroimpar = "par"
case 1: paroimpar = "impar"
end select
end function
---------------------------------------------------

y se la llama de la siguiente manera:

response.write paroimpar(6324)
  #26 (permalink)  
Antiguo 26/10/2004, 12:17
Avatar de Muzztein  
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 21 años, 7 meses
Puntos: 16
Imprime_Variables_servidor

que buenas funciones.


aqui les dejo una SUB rutina muy util que Educa y entretiene

Lo que hace es una tablita conlos valores que existen en una sesion.

Ideal para saber como captar:

1) El ip del usuario que me visita
2) De donde me visita
3) Que sistema operativo tiene

entre otras cosas muy utiles.



Código:
Sub Imprime_Variables_servidor

	escribe "<TABLE border=""1""><TR><TD><B>Nombre Varaible de servidor</B></TD><TD><B>Valor</B></TD></TR>"
	For Each name In Request.ServerVariables 
		escribe "<TR><TD>" & name & "</TD><TD>" & Request.ServerVariables(name) & "</TD></TR>"
	Next
	escribe "</TABLE>"

end sub
Pruebenla, y recuerden que esta usando la sub rutina "escribe"

  #27 (permalink)  
Antiguo 29/10/2004, 10:54
Avatar de AlZuwaga
Colaborador
 
Fecha de Ingreso: febrero-2001
Ubicación: 34.517 S, 58.500 O
Mensajes: 14.550
Antigüedad: 23 años
Puntos: 535
Crea enlaces en textos.
Acepta targets y estilos personalizados.
Los enlaces deben comenzar por http, es decir que no acepta direcciones del tipo www.loquesea.com ni ventas.loquesea.com



Código:
<%
Function CrearEnlaces(varTexto, strTarget, strClass)
	arrTexto = Split(varTexto, " ")
	
	For i = 0 To UBound(arrTexto)
		UltimoCaracter = Right(arrTexto(i), 1)
			If UltimoCaracter = "." Then arrTexto(i) = Left(arrTexto(i), Len(arrTexto(i)) - 1) & " " & UltimoCaracter
			If UltimoCaracter = "," Then arrTexto(i) = Left(arrTexto(i), Len(arrTexto(i)) - 1) & " " & UltimoCaracter
			If UltimoCaracter = ";" Then arrTexto(i) = Left(arrTexto(i), Len(arrTexto(i)) - 1) & " " & UltimoCaracter
		varTextoArreglado = Join(arrTexto)
	Next
	
	arrTexto2 = Split(varTextoArreglado, " ")
	
	For i = 0 To UBound(arrTexto2)
		HTTP = Left(LCase(arrTexto2(i)), 4)
			If HTTP = "http" Then
				URL = "<a href=""" & arrTexto2(i) & """ target=""" & strTarget & """ class=""" & strClass & """>" & arrTexto2(i) & "</a>"
				arrTexto2(i) = URL
			End if
		varTextoArreglado2 = Join(arrTexto2)
	Next
	varTextoArreglado2 = Replace(varTextoArreglado2, " . ", ". ")
	varTextoArreglado2 = Replace(varTextoArreglado2, " , ", ", ")
	varTextoArreglado2 = Replace(varTextoArreglado2, " ; ", "; ")
	CrearEnlaces = varTextoArreglado2
End Function
%>

Demo:
Código:
<%
Texto = "La siguiente es una dirección que tiene un punto al final (aunque podría haber tenido una coma u otro sígno de puntuación): http://www.forosdelweb.com/. Esta otra no http://www.google.com pero tiene un espacio y no tiene barra. Esta última no tiene nada al final, porque está al final del string y además tiene parámetros: http://www.google.com/search?hl=en&q=%22Club+Atl%C3%A9tico+Boca+Juniors%22"
Response.Write Texto
Response.Write "<br>"
Response.Write "<br>"
Response.Write CrearEnlaces(Texto, "_blank", "enlaces")
%>

Salud
PD: 100% mejorable
__________________
...___...
  #28 (permalink)  
Antiguo 01/11/2004, 17:08
Avatar de trasgukabi  
Fecha de Ingreso: septiembre-2004
Mensajes: 2.749
Antigüedad: 19 años, 6 meses
Puntos: 18
Conversión texto->binario->texto

Lo acabo de poner para responder a un post, pero mejor estará aquí:

DE TEXTO A BINARIO:

Código:
<%
Dim C
Dim DD
Dim EE
Dim BinArray(7)
Dim temporal
Dim nuevacadena
cadena="Hola"
For C = 1 To Len(cadena)
			DD = Asc(Mid(cadena, C, 1))
			
			BinArray(7) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(6) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(5) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(4) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(3) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(2) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(1) = CStr(DD Mod 2)
			DD = DD \ 2
			BinArray(0) = CStr(DD Mod 2)
			
			For EE = 0 To UBound(BinArray)
				temporal = temporal & BinArray(EE)
			Next
			
			nuevacadena = nuevacadena & temporal
			
			temporal = ""
			
		Next
		response.Write(nuevacadena)
	%>
DE BINARIO A TEXTO:
Código:
<%
Bintext="01001000011011110110110001100001"
Dim BinChar
		Dim CharX
		Dim convertido
		Dim Z
		Dim NewChar
		Dim Bx
		Dim BBx
		
		For Bx = 1 To Len(BinText)
			BinChar = Mid(BinText, Bx, 8)
			Z = 128
			NewChar = 0
			
			For BBx = 1 To 8
				CharX = Mid(BinChar, BBx, 1)
				If CharX = "1" Then
					NewChar = NewChar + Z
					Z = Z / 2
				Else
					Z = Z / 2
				End If
			Next
			
			convertido = convertido & Chr(NewChar)
			Bx = Bx + 7
			
		Next
		
		BinText = convertido
		response.Write(bintext)
	%>
Saludos, monstruos.

Última edición por trasgukabi; 01/11/2004 a las 17:10 Razón: No es mío. lo he sacado de un proyecto VB libre que no tiene créditos para poder mentarlos...
  #29 (permalink)  
Antiguo 03/11/2004, 04:35
 
Fecha de Ingreso: octubre-2004
Mensajes: 15
Antigüedad: 19 años, 4 meses
Puntos: 0
Funcion para quitar acentos
Código:
Function SinAcentos(str) 
  	Dim intI, strCar, Dev
    	Dev = ""
    	For intI = 1 To Len(str)
      		strCar = Mid(str, intI, 1)
      		Select Case strCar
			Case "à": Dev = Dev & "a"
			Case "á": Dev = Dev & "a"
			Case "è": Dev = Dev & "e"
			Case "é": Dev = Dev & "e"
			Case "í": Dev = Dev & "i"
			Case "ò": Dev = Dev & "o"
			Case "ó": Dev = Dev & "o"
			Case "ú": Dev = Dev & "a"
			Case Else: Dev = Dev & strCar
      		End Select
    	Next
    	SinAcentos = Dev
End Function
__________________
Salu2 :golpeado:
[email protected]
  #30 (permalink)  
Antiguo 03/11/2004, 04:41
 
Fecha de Ingreso: octubre-2004
Mensajes: 15
Antigüedad: 19 años, 4 meses
Puntos: 0
Y aqui paso algunas funciones de WMI (Windows Management Instrumentation). Tienes que tener unas variables globales, llamadas WMIUSER, WMISERVER y WMIPASSWD (El usuario y password deben de tener permisos en las maquinas destino.)

Devuelve el nombre de la maquina si introduces una IP en WMIServer
Código:
Function Nombre()
	Dim objLocator, objService, objInstance, item
	Nombre = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select caption from win32_computersystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		Nombre = Nombre & item.caption & "|"
	Next
	Nombre = Left(Nombre,Len(Nombre)-1)
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing	
End Function
Devuelve la Marca de la maquina
Código:
Function Marca()
	Dim objLocator, objService, objInstance, item
	Marca = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select manufacturer from win32_computersystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		Marca = Marca & item.manufacturer & "|"
	Next
	Marca = Left(Marca,Len(Marca)-1)
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function
Devuelve el modelo de la maquina
Código:
Function Modelo()
	Dim objLocator, objService, objInstance, item
	Modelo = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select model from win32_computersystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		Modelo = Modelo & item.model & "|"
	Next
	Modelo = Left(Modelo,Len(Modelo)-1)
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function
Devuelve el numero de CPUS
Código:
Function NumCPUS()	
	Dim objLocator, objService, objInstance, item
	NumCPUS = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select numberofprocessors from win32_computersystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		NumCPUS = NumCPUS & item.numberofprocessors & "|"
	Next
	NumCPUS = Left(NumCPUS,Len(NumCPUS)-1)
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function
Devolver el Sistema Operativo
Código:
Function SistemaOperativo()
	Dim objLocator, objService, objInstance, item
	SistemaOperativo = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select Caption from win32_operatingsystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		SistemaOperativo = SistemaOperativo & item.Caption & "|"
	Next
	SistemaOperativo = Left(SistemaOperativo, Len(SistemaOperativo)-1) 
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function
Devolver el Service Pack del Sistema Operativo
Código:
Function ServicePack()
	Dim objLocator, objService, objInstance, item
	ServicePack = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select ServicePackMajorVersion, ServicePackMinorVersion from win32_operatingsystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		ServicePack = ServicePack & item.ServicePackMajorVersion & "." & item.ServicePackMinorVersion & "|"
	Next
	ServicePack = Left(ServicePack, Len(ServicePack)-1) 
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function
Idioma del Sistema Operativo
Código:
Function Idioma()
	Dim objLocator, objService, objInstance, item
	Idioma = ""
	if WMIServer = "" then Exit Function
	Set objLocator = Server.CreateObject("WbemScripting.sWbemLocator")
	Set objService = objLocator.ConnectServer(WMIServer,"root\cimv2",WMIUser,WMIPasswd)
	Query = "select oslanguage from win32_operatingsystem"
	Set objInstance = objService.ExecQuery(query)
	For Each item In objInstance
		Idioma = Idioma & NombreIdioma(Hex(item.oslanguage)) & "|"
	Next
	Idioma = Left(Idioma, Len(Idioma)-1) 
	Set objInstance = Nothing
	Set objService = Nothing
	Set objLocator = Nothing
End Function

Private Function NombreIdioma(value)
	Dim dictLang
        Set dictLang = Server.CreateObject("Scripting.Dictionary")
        dictLang.Add "409","Ingles (US)"
        dictLang.add "809","Ingles (Britanico)"
        dictLang.Add "1009","Ingles (Canada)I"
        dictLang.Add "1409","Ingles (Nueva Zelanda)"
        dictLang.Add "0c09","Ingles (Australia)"
        dictLang.Add "1809","Ingles (Irlanda)"
        dictLang.Add "1c09","Ingles (America del Sur)"
        dictLang.Add "2009","Ingles (Jamaica)"
        dictLang.Add "2409","Ingles (Caribe)"
        dictLang.Add "40c","Frances (Estandard)"
        dictLang.Add "80c","Frances (Belgica)"
        dictLang.Add "100c","Frances (Suiza)"
        dictLang.Add "c0c","Frances (Canada)"
        dictLang.Add "140c","Frances (Luxemburgo)"
        dictLang.Add "407","Aleman (Estandard)"
        dictLang.Add "807","Aleman (Suiza)"
        dictLang.Add "c07","Aleman (Austria)"
        dictLang.Add "1007","Aleman (Luxemburgo)"
        dictLang.Add "1407","Aleman (Liechtenstein)"
        dictLang.Add "411","Japones"
        dictLang.Add "80a","Español (Mejico)"
        dictLang.Add "40a","Español (Tradicional)"
        dictLang.Add "c0a","Español (Moderno)"

        NombreIdioma = dictLang.Item(lcase(cstr(value)))
        Set dictLang = Nothing
End Function
Espero que sean de utilidad
__________________
Salu2 :golpeado:
[email protected]
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)




La zona horaria es GMT -6. Ahora son las 20:06.