---- 由 于 编 译 使 用 这 个CGI 程 序 的 做 法 与 上 面 完 全 相 同， 故 下 面 仅 给 源 程 序 代 码：

Option Explicit
Const BOOK_FILE = "guestbk.csv" '存放客户
数据的文件，自动生成，可用Excel97调阅
Declare Sub Sleep Lib "kernel32"
(ByVal dwMilliseconds As Long)
Sub CGI_Main()
If CGI_RequestMethod = "POST" Then
EnterGuest
Beep
Else
ReturnForm
End If
End Sub'

---- 一 当Web 客 户 要 求CGI 连 接， 服 务 器 执 行ReturnForm()， 送 出 征 求 建 议 的 表 单：
Sub ReturnForm()
Send "Content-type: text/html"
Send ""
Send ("< HTML >< HEAD >< TITLE >贵州大学
< /TITLE >< /HEAD >")
Send ("< BODY >< H2 >欢迎您访问贵州
大学计算机软件与理论研究所WWW站点< /H1 >")
Send ("我们的e-mail是< A HREF=""mailto:"
& CGI_ServerAdmin & _
""" >lixiang@gzu.edu.cn:< /A >")
Send ("< HR >")
Send ("请填下表，留下您的宝贵建议：")
Send ("< FORM ACTION="""
& CGI_ExecutablePath & """ METHOD=""POST"" >")
Send ("< PRE > 您的姓名:
< INPUT SIZE=25 NAME=""name"" >")
Send (" E-mail地址:
< INPUT SIZE=25 NAME=""email"" >")
Send ("您给我们的建议:< TEXTAREA COLS=40
ROWS=4 WRAP=VIRTUAL NAME=""comments"" >")
Send ("< /TEXTAREA >< /PRE >")
Send ("请击此处将您的建议送我们:
< INPUT TYPE=""submit""")
Send ("VALUE=""发送您的建议"" >")
Send ("< HR >")
Send ("< /FORM >< /BODY >< /HTML >")
End Sub

'获取客户建议表单数据，将所填数据存入文件guestbk.csv并向客户返回一个信息
Sub EnterGuest()
Dim iLockTries As Integer
Dim sDate As String
Dim sName As String
Dim sEmail As String
Dim sComments As String
'Dim sBrowser As String
Dim sFirstName As String
Dim fn As Integer
'提取建议的有关数据：
sName = GetSmallField("name")
sEmail = GetSmallField("email")
sComments = GetSmallField("comments")
iLockTries = 0
fn = FreeFile
On Error GoTo gLockFail
gRetryLock:
Open App.Path + "/" + BOOK_FILE For
Append Lock Read Write As #fn
On Error GoTo 0
sDate = Now
Write #fn, sDate, sName, sEmail,
sComments, CGI_RemoteAddr
Close #fn
sFirstName = Trim$(Left$(sName,
InStr(sName, " ")))
If sFirstName < > ""
Then sFirstName = sFirstName & ", "
Send ("Content-type: text/html")
Send ("")
Send ("< HTML >< HEAD >< TITLE >谢谢您!
< /TITLE >< /HEAD >")
Send ("您的签名与建议是:< PRE >")
Send ("日期: " & sDate)
Send ("姓名: " & sName)
Send ("E-Mail: " & sEmail)
Send ("Host address:
[" & CGI_RemoteAddr & "]")
Send ("建议:< /PRE >")
Send (sComments)
Send ("< H2 >谢谢您!< /H2 >")
Send ("< /BODY >< /HTML >")
Exit Sub
gLockFail:
Sleep (1000)
iLockTries = iLockTries + 1
Resume gRetryLock
End Sub

Sub Inter_Main()
MsgBox "这是CGI程序，
需要在Web服务器中运行。", 16, "CGI.BAS"
End Sub

 2/2   首页 上一页 1 2