用VB编写标准CGI程序（下）

扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条

本节将用VB编写一个处理主页客户留言簿的CGI程序。

来源：soft6 2008年5月13日

三、CGI编程实例
　　本节将用VB编写一个处理主页客户留言簿的CGI程序。除了要调用本文前面所介绍的Win32API函数外，程序中还调用了Win32API函数GetTempFileName()来获得一个唯一的临时文件名。程序中的函数UrlDecode()用来对客户端的输入进行URL译码。函数GetCgiValue()则用来分解字符串，根据表单元素的NAME属性获取其VALUE值，并调用UrlDecode()函数对其进行URL译码。

　　本程序要求在留言簿文件guests.html中使用一个定位串“<! ENDHEAD >”，将文件的开始部分和具体的客户留言部分分开。CGI程序将在“<! ENDHEAD >”所在的位置插入客户新的留言。guests.html应具有如下所示的样式：

　　<html>

　　<head><title>DHTML Zone </title></head>

　　<! ENDHEAD >

　　<P>……………………….

　　</body></html>

　　这种样式将保证最后的留言出现在留言簿的最前面。如果要想使最后的留言出现在留言簿的最后面，则只需将留言簿文件中的定位字符串“<! ENDHEAD >”移到留言簿文件中客户留言部分和HTML文件结尾部分之间的位置就行了。整个程序的完整代码如下所示：

　　''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

　　Do ''本循环体用于将留言簿中字符串"<! ENDHEAD >"前面的内容写入临时文件

　　Line Input #2, tempstring

　　Print #1, tempstring

　　Loop While tempstring <> "<! ENDHEAD >" And Not EOF(2)

　　''向临时文件中插入客户端用户的留言

　　Print #1, "<hr>" & vbCrLf

　　Print #1, "<ul>" & vbCrLf

　　Print #1, "<li><b>留言时间</b>：" & Date$ & " " & Time$ & vbCrLf

　　Print #1, "<li><b>姓名: </b>" & sName & vbCrLf

　　If Len(sEmail) <> 0 Then

　　 Print #1, "<li><b>E-mail: </b><a href=""mailto:" & sEmail & """ >" & sEmail & "</a>" & vbCrLf

　　End If

　　If Len(sURL) <> 0 Then

　　 Print #1, "<li><b>我的主页: </b> <a href=""" & sURL & """ >" & sURL & "</a>" & vbCrLf

　　End If

　　If Len(sfrom) <> 0 Then

　　 Print #1, "<li><b>我来自: </b>" & sfrom & vbCrLf

　　End If

　　Print #1, "<li><b>我的建议: </b>" & vbCrLf

　　Print #1, sComment & vbCrLf

　　Print #1, "</ul>" & vbCrLf

　　Do ''本循环体用于将留言簿剩余的东西写入留言簿

　　 Line Input #2, tempstring

　　 Print #1, tempstring

　　 Loop While Not EOF(2)

　　Close #1

　　Close #2

　　Kill guestbook ''删除旧的留言簿

　　Name tempFileName As guestbook ''将临时文件改成新的留言簿

　　OutPut "<P>非常感谢您的留言!" & chinesetail

　　OutPut "<P>欢迎您经常光顾本主页！" & chinesetail

　　OutPut "</FONT>"

　　End Sub

　　Sub OutPut(s As String) '' 本子程序用于向标准输出写信息

　　Dim lBytesWritten As Long

　　s = s & vbCrLf

　　WriteFile hStdOut, s, Len(s), lBytesWritten, ByVal 0&

　　End Sub

　　Public Function GetCgiValue(cgiName As String) As String

　　'' 本子程序可以获取表单上某一元素的数据

　　Dim delim2 As Long '' position of "="

　　Dim delim1 As Long '' position of "&"

　　Dim n As Integer

　　Dim pointer1 As Long，pointer2 As Long，length As Long，length1 As Long

　　Dim tmpstring1 As String，tmpstring2 As String

　　pointer1 = 1

　　pointer2 = 1

　　delim2 = InStr(pointer2, sFormData, "=")

　　pointer2 = delim2 + 1

　　 length = delim2 - pointer1

　　 tmpstring1 = Mid(sFormData, pointer1, length)

　　 delim1 = InStr(pointer1, sFormData, "&")

　　 pointer1 = delim1 + 1

　　 length1 = delim1 - pointer2

　　 If delim1 = 0 Then length1 = lContentLength + 1 - pointer2

　　 If tmpstring1 = cgiName Then

　　 tmpstring2 = Mid$(sFormData, pointer2, length1)

　　 GetCgiValue = UrlDecode(tmpstring2)

　　 Exit Do

　　 End If

　　 If delim1 = 0 Then

　　 Exit Do

　　 End If

　　 delim2 = InStr(pointer2, sFormData, "=")

　　 pointer2 = delim2 + 1

　　 Loop

　　End Function

　　Public Function UrlDecode(ByVal sEncoded As String) As String

　　'' 本函数可以对用户输入的数据进行URL解码

　　Dim pointer As Long '' sEncoded position pointer

　　Dim pos As Long '' position of InStr target

　　Dim temp As String

　　If sEncoded = "" Then Exit Function

　　pointer = 1

　　Do ''本循环体用于将"+"转换成空格

　　 pos = InStr(pointer, sEncoded, "+")

　　 If pos = 0 Then Exit Do

　　 Mid$(sEncoded, pos, 1) = " "

　　 pointer = pos + 1

　　 Loop

　　 pointer = 1

　　''本循环体用于将%XX转换成字符。对于两个连续的%XX，如果第一个%XX不是某些特指的Web系统保留字符，将把它们转换成汉字

　　 pos = InStr(pointer, sEncoded, "%")

　　 If pos = 0 Then Exit Do

　　 temp = Chr$("&H" & (Mid$(sEncoded, pos + 1, 2)))

　　 If Mid(sEncoded, pos + 3, 1) = "%" And (temp <> ":") And (temp <> "/") _

　　 And (temp <> "(") And (temp <> ")") And (temp <> ".") And (temp <> ",") _

　　 And (temp <> ";") And (temp <> "%") Then

　　 Mid$(sEncoded, pos, 2) = Chr$("&H" & (Mid$(sEncoded, pos + 1, 2)) _

　　 & (Mid$(sEncoded, pos + 4, 2)))

　　 sEncoded = Left$(sEncoded, pos) & Mid$(sEncoded, pos + 6)

　　 pointer = pos + 1

　　 Else

　　 Mid$(sEncoded, pos, 1) = temp

　　 sEncoded = Left$(sEncoded, pos) & Mid$(sEncoded, pos + 3)

　　 pointer = pos + 1

　　 End If

　　 Loop

　　 UrlDecode = sEncoded

　　 Exit Function

　　End Function

　　Public Function TempFile(sPath As String, sPrefix As String) As String

　　 ''本函数可以获得一个唯一的临时文件名

　　 Dim x As Long，rc As Long

　　 TempFile = String(127, Chr$(0))

　　 rc = GetTempFileName(sPath, sPrefix, ByVal 0&, TempFile)

　　 x = InStr(TempFile, Chr$(0))

　　 If x > 0 Then TempFile = Left$(TempFile, x - 1)

　　End Function

　　CGI程序guestbook.bas所要处理的表单如下所示：

　　<html><head><title>贵宾留言簿</title></head>

　　<body>

　　<h3>贵宾留言簿测试</h3>

　　您的姓名: <input type="text" name="name"><br>

　　您的Email信箱: <input type="text" name="email"><br>

　　您的主页的URL: <input type="text" name="URL"><br>

　　您的建议:<br> <textarea name="URL_Comment" rows=4 cols=30></textarea><br>

　　您来自: <input type="text" name="from"><br>

　　</form>

　　</body></html>

　　虽然目前已经有很多可以取代CGI且其性能较CGI要高的技术（例如ASP、ISAPI、NSAPI等），但使用它们时需要用到专门的知识和工具，并且利用这些技术所编制的程序只适用于特定的Web服务器或系统平台。考虑到CGI编程具有易用易学性、跨服务器平台特性等优点，因此，CGI程序还将在WWW上占有一席之地。

VIP专区

VIP用户

普通用户

邮件订阅

如果您非常迫切的想了解IT领域最新产品与技术信息，那么订阅至顶网技术邮件将是您的最佳途径之一。

重磅专题

往期文章

用VB编写标准CGI程序（下）

业界热点: