Foros del web, para los que viven de bits

sub escribe(str)
response.write str & chr(10)
end sub

sub imprime(str)
response.write str & "<br>"
end sub

sub termina()
response.end
end sub

sub mensaje(txt)
escribe "<script>"
escribe "alert(""" & txt & """)"
escribe "</script>" 
end sub

sub cierra_y_recarga
escribe "<script>" 
escribe "window.opener.location.reload();"
escribe "window.close();"
escribe "</script>" 
end sub

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

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

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"

<form...>
<% genera_select "MiSelect", "1", "Multiple No", "estilo10", "Seleccione una opción", Rs, "ID", "Descripcion"  %>
</form>

 
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

 
sql= "SELECT * FROM tutabla"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open sql, conx_bd("tubasededatossinextencion"),  3, 3

<%
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
%>

<!-- #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>

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
%>

<%
Function txt2htm(txt)
	txt2htm = txt
	txt2htm = Replace(txt2htm, VBCrLf, "<br>" & VBCrLf)
	txt2htm = Replace(txt2htm, CHR(9), "<pre style='display:inline'>&-#09;</pre>")
End Function
%>

<% Response.Write txt2htm(Fuente_de_datos) %>

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

campoA1	campoA2
campoB1	campoB2

campo = Split(registro(i),";")

	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

abre_conexion
strsql = "poner aqui string sql a ejecutar"
ejecuta(strsql)
cierra_conexion

<%
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
%>

SQL = "INSERT INTO tabla (Campo1, Campo2) VALUES ('"& RyL("Elemento1") &"', '"& RyL("Elemento2") &"')"

<%
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
%>

<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>

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

<%
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
%>

<% Response.Write CortarLargos(Fuente_de_datos, "Cantidad_de_caracteres", "separador_usado") %>

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

Response.Write MostrarResult(cantidad_caracteres, Fuente_de_datos, el_criterio)

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

EscribeEnDisco now , "c:\testing_datos.txt"

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

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

 
  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,"--","")