?? vbcgi.bas
字號(hào):
n = n + 1 ' Bump array index
Loop
CGI_NumExtraHeaders = n ' Fill in global count
End Sub
'---------------------------------------------------------------------------
'
' GetArgs() - Parse the command line
'
' Chop up the command line, fill in the argument vector, return the
' argument count (similar to the Unix/C argc/argv handling)
'---------------------------------------------------------------------------
Private Function GetArgs(argv() As String) As Integer
Dim buf As String
Dim i As Integer, j As Integer, l As Integer, n As Integer
buf = Trim$(Command$) ' Get command line
l = Len(buf) ' Length of command line
If l = 0 Then ' If empty
GetArgs = 0 ' Return argc = 0
Exit Function
End If
i = 1 ' Start at 1st character
n = 0 ' Index in argvec
Do While ((i < l) And (n < MAX_CMDARGS)) ' Safety stop here
j = InStr(i, buf, " ") ' J -> next space
If j = 0 Then Exit Do ' Exit loop on last arg
argv(n) = Trim$(Mid$(buf, i, j - i)) ' Get this token, trim it
i = j + 1 ' Skip that blank
Do While Mid$(buf, i, 1) = " " ' Skip any additional whitespace
i = i + 1
Loop
n = n + 1 ' Bump array index
Loop
argv(n) = Trim$(Mid$(buf, i, (l - i + 1))) ' Get last arg
GetArgs = n + 1 ' Return arg count
End Function
'---------------------------------------------------------------------------
'
' GetAcceptTypes() - Create the array of accept type structs
'
' Enumerate the keys in the [Accept] section of the profile file,
' then get the value for each of the keys.
'---------------------------------------------------------------------------
Private Sub GetAcceptTypes()
Dim sList As String
Dim i As Integer, j As Integer, l As Integer, n As Integer
sList = GetProfile("Accept", "") ' Get key list
l = Len(sList) ' Length incl. trailing null
i = 1 ' Start at 1st character
n = 0 ' Index in array
j = InStr(i, sList, Chr$(0)) ' J -> next null
CGI_AcceptTypes(n).key = Mid$(sList, i, j - i) ' Get Key, then value
CGI_AcceptTypes(n).value = GetProfile("Accept", CGI_AcceptTypes(n).key)
i = j + 1 ' Bump pointer
n = n + 1 ' Bump array index
Loop
CGI_NumAcceptTypes = n ' Fill in global count
End Sub
'---------------------------------------------------------------------------
'
' FindExtraHeader() - Get the text from an "extra" header
'
' Given the extra header's name, return the stuff after the ":"
' or an empty string if not there.
'---------------------------------------------------------------------------
Public Function FindExtraHeader(key As String) As String
Dim i As Integer
For i = 0 To (CGI_NumExtraHeaders - 1)
If CGI_ExtraHeaders(i).key = key Then
FindExtraHeader = Trim$(CGI_ExtraHeaders(i).value)
Exit Function ' ** DONE **
End If
Next i
'
' Not present, return empty string
'
FindExtraHeader = ""
End Function
'----------------------------------------------------------------------
'
' ParseFileValue() - Parse [Form File] value strings -> file tuples
'
'----------------------------------------------------------------------
Private Sub ParseFileValue(buf As String, ByRef t As FileTuple)
Dim i, j, k, l As Integer
l = Len(buf)
i = InStr(buf, " ") ' First delimiter
t.file = Mid$(buf, 1, (i - 1)) ' [file]
t.file = Mid$(t.file, 2, Len(t.file) - 2) ' file
j = InStr((i + 1), buf, " ") ' Next delimiter
t.length = CLng(Mid$(buf, (i + 1), (j - i - 1)))
i = j
j = InStr((i + 1), buf, " ") ' Next delimiter
t.type = Mid$(buf, (i + 1), (j - i - 1))
i = j
j = InStr((i + 1), buf, " ") ' Next delimiter
t.encoding = Mid$(buf, (i + 1), (j - i - 1))
i = j
t.name = Mid$(buf, (i + 1), (l - i - 1)) ' [name]
t.name = Mid$(t.name, 2, Len(t.name) - 1) ' name
End Sub
'----------------------------------------------------------------------
'
' x2c() - Convert hex-escaped character to ASCII
'
'----------------------------------------------------------------------
Private Function x2c(s As String) As String
Dim t As String
t = "&H" & s
x2c = Chr$(CInt(t))
End Function
'----------------------------------------------------------------------
'
' Unescape() - Convert HTTP-escaped string to normal form
'
'----------------------------------------------------------------------
Public Function Unescape(s As String)
Dim i As Integer, l As Integer
Dim c As String
If InStr(s, "%") = 0 Then ' Catch simple case
Unescape = s
Exit Function
End If
l = Len(s)
Unescape = ""
For i = 1 To l
c = Mid$(s, i, 1) ' Next character
If c = "%" Then
If Mid$(s, i + 1, 1) = "%" Then
c = "%"
i = i + 1 ' Loop increments too
Else
c = x2c(Mid$(s, i + 1, 2))
i = i + 2 ' Loop increments too
End If
End If
Unescape = Unescape & c
Next i
End Function
'----------------------------------------------------------------------
'
' PlusToSpace() - Remove plus-delimiters from HTTP-encoded string
'
'----------------------------------------------------------------------
Public Sub PlusToSpace(s As String)
Dim i As Integer
i = 1
Do While True
i = InStr(i, s, "+")
If i = 0 Then Exit Do
Mid$(s, i) = " "
Loop
End Sub
'----------------------------------------------------------------------
'
' Return True/False depending on whether a form field is present.
' Typically used to detect if a checkbox in a form is checked or
' not. Unchecked checkboxes are omitted from the form content.
'
'----------------------------------------------------------------------
Function FieldPresent(key As String) As Integer
Dim i As Integer
FieldPresent = False ' Assume failure
For i = 0 To (CGI_NumFormTuples - 1)
If CGI_FormTuples(i).key = key Then
FieldPresent = True ' Found it
Exit Function ' ** DONE **
End If
Next i
' Exit with FieldPresent still False
End Function
'---------------------------------------------------------------------------
'
' WebDate - Return an HTTP/1.0 compliant date/time string
'
' Inputs: t = Local time as VB Variant (e.g., returned by Now())
' Returns: Properly formatted HTTP/1.0 date/time in GMT
'---------------------------------------------------------------------------
Function WebDate(dt As Variant) As String
Dim t As Variant
t = CVDate(dt - CGI_GMTOffset) ' Convert time to GMT
WebDate = Format$(t, "ddd dd mmm yyyy hh:mm:ss") & " GMT"
End Function
'---------------------------------------------------------------------------
'
' SendNoOp() - Tell browser to do nothing.
'
' Most browsers will do nothing. Netscape 1.0N leaves hourglass
' cursor until the mouse is waved around. Enhanced Mosaic 2.0
' oputs up an alert saying "URL leads nowhere". Your results may
' vary...
'
'---------------------------------------------------------------------------
Sub SendNoOp()
Send ("HTTP/1.0 204 No Response")
Send ("Server: " + CGI_ServerSoftware)
Send ("")
End Sub
'----------------------------------------------------------------------
'
' Send() - Shortcut for writing to output file
'
'----------------------------------------------------------------------
Sub Send(s As String)
Print #CGI_OutputFN, s
End Sub
'----------------------------------------------------------------------
'
' main() - CGI script back-end main procedure
'
' This is the main() for the VB back end. Note carefully how the error
' handling is set up, and how program cleanup is done. If no command
' line args are present, call Inter_Main() and exit.
'----------------------------------------------------------------------
Sub Main()
On Error GoTo ErrorHandler
If Trim$(Command$) = "" Then ' Interactive start
Inter_Main ' Call interactive main
Exit Sub ' Exit the program
End If
InitializeCGI ' Create the CGI environment
'===========
CGI_Main ' Execute the actual "script"
'===========
Cleanup:
Close #CGI_OutputFN
Exit Sub ' End the program
'------------
ErrorHandler:
Select Case Err ' Decode our "user defined" errors
Case ERR_NO_FIELD:
ErrorString = "Unknown form field"
Case Else:
ErrorString = Error$ ' Must be VB error
End Select
ErrorString = ErrorString & " (error #" & Err & ")"
On Error GoTo 0 ' Prevent recursion
ErrorHandler (Err) ' Generate HTTP error result
Resume Cleanup
'------------
End Sub
'---------------------------------------------------------------------------
'
' ErrorHandler() - Global error handler
'
' If a VB runtime error occurs dusing execution of the program, this
' procedure generates an HTTP/1.0 HTML-formatted error message into
' the output file, then exits the program.
'
' This should be armed immediately on entry to the program's main()
' procedure. Any errors that occur in the program are caught, and
' an HTTP/1.0 error messsage is generated into the output file. The
' presence of the HTTP/1.0 on the first line of the output file causes
' NCSA httpd for WIndows to send the output file to the client with no
' interpretation or other header parsing.
'---------------------------------------------------------------------------
Sub ErrorHandler(code As Integer)
On Error Resume Next ' Give it a good try!
Seek #CGI_OutputFN, 1 ' Rewind output file just in case
Send ("HTTP/1.0 500 Internal Error")
Send ("Server: " + CGI_ServerSoftware)
Send ("Date: " + WebDate(Now))
Send ("Content-type: text/html")
Send ("")
Send ("<HTML><HEAD>")
Send ("<TITLE>Error in " + CGI_ExecutablePath + "</TITLE>")
Send ("</HEAD><BODY>")
Send ("<H1>Error in " + CGI_ExecutablePath + "</H1>")
Send ("An internal Visual Basic error has occurred in " + CGI_ExecutablePath + ".")
Send ("<PRE>" + ErrorString + "</PRE>")
Send ("<I>Please</I> note what you were doing when this problem occurred,")
Send ("so we can identify and correct it. Write down the Web page you were using,")
Send ("any data you may have entered into a form or search box, and")
Send ("anything else that may help us duplicate the problem. Then contact the")
Send ("administrator of this service: ")
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -