📄 cgi32.bas
字号:
Global CGI_NumFormTuples As Integer ' # of live entries in array
Global CGI_HugeTuples(MAX_HUGE_TUPLES) As HugeTuple ' Form "huge tuples
Global CGI_NumHugeTuples As Integer ' # of live entries in array
Global CGI_FileTuples(MAX_FILE_TUPLES) As FileTuple ' File upload tuples
Global CGI_NumFileTuples As Integer ' # of live entries in array
'
' ----------------
' System Variables
' ----------------
'
Global CGI_GMTOffset As Variant ' GMT offset (time serial)
Global CGI_ContentFile As String ' Content/Input file pathname
Global CGI_OutputFile As String ' Output file pathname
Global CGI_DebugMode As Integer ' Script Tracing flag from server
'
'
' ========================
' Windows API Declarations
' ========================
'
' NOTE: Declaration of GetPrivateProfileString is specially done to
' permit enumeration of keys by passing NULL key value. See GetProfile().
' Both the 16-bit and 32-bit flavors are given below. We DO NOT
' recommend using 16-bit VB4 with WebSite!
'
#If Win32 Then
Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
#Else
Declare Function GetPrivateProfileString Lib "Kernel" _
(ByVal lpSection As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Integer, _
ByVal lpFileName As String) As Integer
#End If
'
'
' ===============
' Local Variables
' ===============
'
Dim CGI_ProfileFile As String ' Profile file pathname
Dim CGI_OutputFN As Integer ' Output file number
Dim ErrorString As String
'---------------------------------------------------------------------------
'
' 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)
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: ")
Send ("<A HREF=""mailto:" & CGI_ServerAdmin & """>")
Send ("<ADDRESS><" + CGI_ServerAdmin + "></ADDRESS>")
Send ("</A></BODY></HTML>")
Close #CGI_OutputFN
'======
End ' Terminate the program
'======
End Sub
'---------------------------------------------------------------------------
'
' 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
Do While ((i < l) And (n < MAX_ACCTYPE)) ' Safety stop here
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
'---------------------------------------------------------------------------
'
' 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
'---------------------------------------------------------------------------
'
' GetExtraHeaders() - Create the array of extra header structs
'
' Enumerate the keys in the [Extra Headers] section of the profile file,
' then get the value for each of the keys.
'---------------------------------------------------------------------------
Private Sub GetExtraHeaders()
Dim sList As String
Dim i As Integer, j As Integer, l As Integer, n As Integer
sList = GetProfile("Extra Headers", "") ' Get key list
l = Len(sList) ' Length incl. trailing null
i = 1 ' Start at 1st character
n = 0 ' Index in array
Do While ((i < l) And (n < MAX_XHDR)) ' Safety stop here
j = InStr(i, sList, Chr$(0)) ' J -> next null
CGI_ExtraHeaders(n).key = Mid$(sList, i, j - i) ' Get Key, then value
CGI_ExtraHeaders(n).value = GetProfile("Extra Headers", CGI_ExtraHeaders(n).key)
i = j + 1 ' Bump pointer
n = n + 1 ' Bump array index
Loop
CGI_NumExtraHeaders = n ' Fill in global count
End Sub
'---------------------------------------------------------------------------
'
' GetFormTuples() - Create the array of POST form input key=value pairs
'
'---------------------------------------------------------------------------
Private Sub GetFormTuples()
Dim sList As String
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim s As Long
Dim buf As String
Dim extName As String
Dim extFile As Integer
Dim extlen As Long
n = 0 ' Index in array
ReDim Preserve CGI_FormTuples(n) As Tuple ' Increase array size
'
' Do the easy one first: [Form Literal]
'
sList = GetProfile("Form Literal", "") ' Get key list
l = Len(sList) ' Length incl. trailing null
i = 1 ' Start at 1st character
Do While i < l ' Safety stop here
j = InStr(i, sList, Chr$(0)) ' J -> next null
CGI_FormTuples(n).key = Mid$(sList, i, j - i) ' Get Key, then value
CGI_FormTuples(n).value = GetProfile("Form Literal", CGI_FormTuples(n).key)
i = j + 1 ' Bump pointer
n = n + 1 ' Bump array index
ReDim Preserve CGI_FormTuples(n) As Tuple ' Increase array size
Loop
'
' Now do the external ones: [Form External]
'
sList = GetProfile("Form External", "") ' Get key list
l = Len(sList) ' Length incl. trailing null
i = 1 ' Start at 1st character
extFile = FreeFile
Do While i < l ' Safety stop here
j = InStr(i, sList, Chr$(0)) ' J -> next null
CGI_FormTuples(n).key = Mid$(sList, i, j - i) ' Get Key, then pathname
buf = GetProfile("Form External", CGI_FormTuples(n).key)
k = InStr(buf, " ") ' Split file & length
extName = Mid$(buf, 1, k - 1) ' Pathname
k = k + 1
extlen = CLng(Mid$(buf, k, Len(buf) - k + 1)) ' Length
'
' Use feature of GET to read content in one call
'
Open extName For Binary Access Read As #extFile
CGI_FormTuples(n).value = String$(extlen, " ") ' Breathe in...
Get #extFile, , CGI_FormTuples(n).value 'GULP!
Close #extFile
i = j + 1 ' Bump pointer
n = n + 1 ' Bump array index
ReDim Preserve CGI_FormTuples(n) As Tuple ' Increase array size
Loop
CGI_NumFormTuples = n ' Number of fields decoded
n = 0 ' Reset counter
'
' Next, the [Form Huge] section. Will this ever get executed?
'
sList = GetProfile("Form Huge", "") ' Get key list
l = Len(sList) ' Length incl. trailing null
i = 1 ' Start at 1st character
Do While i < l ' Safety stop here
j = InStr(i, sList, Chr$(0)) ' J -> next null
CGI_HugeTuples(n).key = Mid$(sList, i, j - i) ' Get Key
buf = GetProfile("Form Huge", CGI_HugeTuples(n).key) ' "offset length"
k = InStr(buf, " ") ' Delimiter
CGI_HugeTuples(n).offset = CLng(Mid$(buf, 1, (k - 1)))
CGI_HugeTuples(n).length = CLng(Mid$(buf, k, (Len(buf) - k + 1)))
i = j + 1 ' Bump pointer
n = n + 1 ' Bump array index
ReDim Preserve CGI_FormTuples(n) As Tuple ' Increase array size
Loop
CGI_NumHugeTuples = n ' Fill in global count
n = 0 ' Reset counter
'
' Finally, the [Form File] section.
'
sList = GetProfile("Form File", "") ' Get key list
l = Len(sList) ' Length incl. trailing null
i = 1 ' Start at 1st character
Do While ((i < l) And (n < MAX_FILE_TUPLES)) ' Safety stop here
j = InStr(i, sList, Chr$(0)) ' J -> next null
CGI_FileTuples(n).key = Mid$(sList, i, j - i) ' Get Key
buf = GetProfile("Form File", CGI_FileTuples(n).key)
ParseFileValue buf, CGI_FileTuples(n) ' Complicated, use Sub
i = j + 1 ' Bump pointer
n = n + 1 ' Bump array index
Loop
CGI_NumFileTuples = n ' Fill in global count
End Sub
'---------------------------------------------------------------------------
'
' GetProfile() - Get a value or enumerate keys in CGI_Profile file
'
' Get a value given the section and key, or enumerate keys given the
' section name and "" for the key. If enumerating, the list of keys for
' the given section is returned as a null-separated string, with a
' double null at the end.
'
' VB handles this with flair! I couldn't believe my eyes when I tried this.
'---------------------------------------------------------------------------
Private Function GetProfile(sSection As String, sKey As String) As String
Dim retLen As Long
Dim buf As String * ENUM_BUF_SIZE
If sKey <> "" Then
retLen = GetPrivateProfileString(sSection, sKey, "", buf, ENUM_BUF_SIZE, CGI_ProfileFile)
Else
retLen = GetPrivateProfileString(sSection, 0&, "", buf, ENUM_BUF_SIZE, CGI_ProfileFile)
End If
If retLen = 0 Then
GetProfile = ""
Else
GetProfile = Left$(buf, retLen)
End If
End Function
'----------------------------------------------------------------------
'
' Get the value of a "small" form field given the key
'
' Signals an error if field does not exist
'
'----------------------------------------------------------------------
Function GetSmallField(key As String) As String
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -