整个程序的完整代码如下所示:
'guestbook.bas
Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any,ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long,ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long,lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA"(ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Public Const STD_INPUT_HANDLE = -10&
Public Const STD_OUTPUT_HANDLE = -11&
Public Const FILE_BEGIN = 0&
Public hStdIn As Long ' 标准输入文件句柄
Public hStdOut As Long ' 标准输出文件句柄
Public sFormData As String ' 用于存储没有经过URL译码的用户输入数据
Public lContentLength As Long
Public CGI_RequestMethod As String
Sub Main()
Dim CGI_ContentLength As String, CGI_QueryString As String, sBuff As String, chinesetail As String
Dim lBytesRead As Long, rc As Long,I As Long
Dim sEmail As String, sName As String, sURL As String, sfrom As String, tempstring As String
Dim sComment As String, tempFileName As String, guestbook As String
'CGI程序的初始化工作
hStdIn = GetStdHandle(STD_INPUT_HANDLE)
hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)
CGI_RequestMethod = Environ("REQUEST_METHOD")
CGI_QueryString = Environ("QUERY_STRING")
CGI_ContentLength = Environ("CONTENT_LENGTH")
lContentLength = Val(CGI_ContentLength)
sBuff = String(lContentLength, Chr$(0))
OutPut "Content-type: text/html" & vbCrLf ' 输出MIME类型
OutPut "<FONT SIZE=""+2"">"
If CGI_RequestMethod = "POST" Then
sBuff = String(lContentLength, Chr$(0))
rc = ReadFile(hStdIn, ByVal sBuff, lContentLength, lBytesRead, ByVal 0&)
sFormData = Left$(sBuff, lBytesRead)
ElseIf CGI_RequestMethod = "GET" Then
sFormData = CGI_QueryString
Else
OutPut "Unknow Form Method !"
End If
'为了在页面上正确显示中文,生成一个空格串以获取客户端用户的输入
chinesetail = String(400, " ")
sName = GetCgiValue("name")
sEmail = GetCgiValue("email")
sURL = GetCgiValue("URL")
sfrom = GetCgiValue("from")
sComment = GetCgiValue("URL_Comment")
'对客户端用户的输入进行检查
If Len(sName) = 0 Then
OutPut "<P>非常抱歉!您还没有填写姓名!" & chinesetail
Exit Sub
End If
If Len(sComment) = 0 Then
OutPut "<P>非常抱歉!您还没有提出建议!" & chinesetail
Exit Sub
End If
'获取唯一的临时文件名和留言簿文件并打开它们
tempFileName = TempFile("c:/windows/temp", "gbk")
guestbook = "e:/netscape/server/docs/guests.html"
Open tempFileName For Output As #1
Open guestbook For Input As #2