Tengo un cgi en vb6 y funciona bien pero lo cambio a vb5 y me manda el error 502.2.
Saben porque pasa eso?
este es el código:
Option Explicit
'Little Tiny VB CGI.
'
'Requires a reference to Microsoft Scripting Runtime.
Dim FSO As New Scripting.FileSystemObject
Dim sin As Scripting.TextStream
Dim sout As Scripting.TextStream
Dim datospost() As String
Dim ct As Integer
Public Const CGI_AUTH_TYPE As String = "AUTH_TYPE"
Public Const CGI_CONTENT_LENGTH As String = "CONTENT_LENGTH"
Public Const CGI_CONTENT_TYPE As String = "CONTENT_TYPE"
Public Const CGI_GATEWAY_INTERFACE As String = "GATEWAY_INTERFACE"
Public Const CGI_HTTP_ACCEPT As String = "HTTP_ACCEPT"
Public Const CGI_HTTP_REFERER As String = "HTTP_REFERER"
Public Const CGI_HTTP_USER_AGENT As String = "HTTP_USER_AGENT"
Public Const CGI_PATH_INFO As String = "PATH_INFO"
Public Const CGI_PATH_TRANSLATED As String = "PATH_TRANSLATED"
Public Const CGI_QUERY_STRING As String = "QUERY_STRING"
Public Const CGI_REMOTE_ADDR As String = "REMOTE_ADDR"
Public Const CGI_REMOTE_HOST As String = "REMOTE_HOST"
Public Const CGI_REMOTE_USER As String = "REMOTE_USER"
Public Const CGI_REQUEST_METHOD As String = "REQUEST_METHOD"
Public Const CGI_SCRIPT_NAME As String = "SCRIPT_NAME"
Public Const CGI_SERVER_NAME As String = "SERVER_NAME"
Public Const CGI_SERVER_PORT As String = "SERVER_PORT"
Public Const CGI_SERVER_PROTOCOL As String = "SERVER_PROTOCOL"
Public Const CGI_SERVER_SOFTWARE As String = "SERVER_SOFTWARE"
Public Const CGI_APPL_PHYSICAL_PATH As String = "APPL_PHYSICAL_PATH"
Declare Function GetEnvironmentVariable Lib "Kernel32" Alias "GetEnvironmentVariableA" (ByVal bsName As String, ByVal buff As String, ByVal ch As Long) As Long
Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Private Declare Function GetStdHandle Lib "Kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function WriteFile Lib "Kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
Private Declare Function ReadFile Lib "Kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function AllocConsole Lib "Kernel32" () As Long
Private Declare Function FreeConsole Lib "Kernel32" () As Long
Const STD_INPUT_HANDLE = -10&
Const STD_OUTPUT_HANDLE = -11&
Private OutStdHandle As Long
Private InStdHandle As Long
Public Function LeerHTML() As String
Dim lBytesLeidos As Long
Dim sCadenaLeida As String * 255
Dim x As Long
' Lectura de la entrada estándar
x = ReadFile(InStdHandle, sCadenaLeida, 254, lBytesLeidos, 0)
LeerHTML = sCadenaLeida
End Function
Sub Sen(ByVal Text As String)
sout.Write Text
End Sub
Sub Send(Optional ByVal Text As String = "")
sout.WriteLine Text
End Sub
Sub Headers()
Send "Content-type: text/html"
Send
End Sub
Sub Main()
Dim cm As Integer
' Creación de la consola
AllocConsole
'Set sin = FSO.GetStandardStream(StdIn)
Set sout = FSO.GetStandardStream(StdOut)
Dim x As Integer
Dim sDatos As String
Dim Value As String
Dim Vp As String
ct = 0
Value = Environ$(CGI_QUERY_STRING)
Headers
Send "<HTML><HEAD>"
Send "<TITLE>Vero</TITLE>"
Send "</HEAD><BODY>"
If Value = "" Then ' viene de un form metodo post
' Recuperación del handle de la salida estándar
OutStdHandle = GetStdHandle(STD_OUTPUT_HANDLE)
' Recuperación del handle de la entrada estándar
InStdHandle = GetStdHandle(STD_INPUT_HANDLE)
' Obtención de los datos del formulario
sDatos = LeerHTML
SeparaDatos (sDatos)
Send "<p>valores del formulario:</p>"
For cm = 0 To ct - 1
Send "<p>" & datospost(cm, 1) & " = " & datospost(cm, 2) & "</p>"
Next cm
If FieldPresent("T5") Then
Send "<p>T5 si esta</p>"
Else
Send "<p>T5 no esta</p>"
End If
cm = GetSmallField("T")
Send "<p>Valor: " & cm & "</p>"
Else ' viene de una liga
' Recuperación del handle de la salida estándar
OutStdHandle = GetStdHandle(STD_OUTPUT_HANDLE)
' Recuperación del handle de la entrada estándar
InStdHandle = GetStdHandle(STD_INPUT_HANDLE)
sDatos = LeerHTML
Send "<p>" & Value & "</p>"
If IsNull(sDatos) Then
Send "<p>" & sDatos & "</p>"
Else
Send "<p> sDatos esta vacia </p>"
End If
Vp = Environ$("SCRIPT_NAME")
Send "<p>" & Vp & "</p>"
End If
Send "</BODY></HTML>"
Set sout = Nothing
'Set sin = Nothing
FreeConsole
End Sub
Sub SeparaDatos(Datos As String)
Dim xc As Integer
Dim pos As Integer
Dim pos2 As Integer
Dim cad1 As String
Dim cad2 As String
ct = 0
For xc = 1 To Len(Datos)
pos = InStr(xc, Datos, "=")
If pos > 0 Then
ct = ct + 1
End If
Next xc
ReDim datospost(ct + 1, 2)
ct = 0
For xc = 1 To Len(Datos)
pos = InStr(xc, Datos, "&")
If pos > 0 Then 'encontro &
cad1 = Mid(Datos, xc, pos - xc)
xc = pos
Else ' no encontró y es el último valor
cad1 = Mid(Datos, xc)
xc = Len(Datos)
End If
pos2 = InStr(1, cad1, "=")
cad2 = Mid(cad1, 1, pos2 - 1)
datospost(ct, 1) = cad2 ' nombre de la variable
cad2 = Mid(cad1, pos2 + 1)
datospost(ct, 2) = cad2 ' valor de la variable
ct = ct + 1
Next xc
End Sub
Function FieldPresent(key As String) As Integer
Dim I As Integer
FieldPresent = False ' Assume failure
If ct = 0 Then Exit Function
For I = 0 To ct - 1
If datospost(I, 1) = key Then
FieldPresent = True ' Found it
Exit Function ' ** DONE **
End If
Next I
End Function
Function GetSmallField(key As String) As String
Dim I As Integer
For I = 0 To ct - 1
If datospost(I, 1) = key Then
GetSmallField = Trim$(datospost(I, 2))
Exit Function ' ** DONE **
End If
Next I
'
' Field does not exist
'
'Error ERR_NO_FIELD
End Function
Gracias
