68.txt

来自「介绍VB里的各种控件的使用方法,窗口控制,图像编程以及OCX等内容,还提供了一个」· 文本 代码 · 共 375 行 · 第 1/2 页

　　　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

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

　　　Do
　　　　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

　　 
　　' 本函数可以对用户输入的数据进行URL解码
　　Public Function UrlDecode(ByVal sEncoded As String) As String
　　　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系统保留字符，将把它们转换成汉字
　　　Do
　　　　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>
　　<form action="/cgi-bin/guest.exe" method="post">
　　　您的姓名: <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>

　　　<input type="submit" value=" 留言 ">
　　</form>
　　</body></html> 

* 联系地址 清华大学22#楼603房 张移山 邮编 100084
　电子邮件 [e-mail] 电话 62782064