📄 怎么在程序里向服务器的cgi提交数据.txt
字号:
下 面 的 文 章 来 自 新 闻 组 ， 作 者 不 详 。 其 原 理 是 利 用 VB设 计 一 个 Active Dll， 然 后 在 ASP中 调 用 。 这 个 例 子 是 采 用 GET方 式 提 交 数 据 ， 你 可 以 修 改 VB程 序 使 其 支 持 POST方 式 。 如 果 你 仅 仅 是 编 写 一 个 客 户 端 的 程 序 。 只 需 要 参 考 Active Dll的 代 码 就 可 以 了 。
使 用 ASP建 立 Http组 件
关 键 词 ： ASP, 组 件 Components
生 成 HTTP组 件
自 己 动 手 ， 丰 衣 足 食 ， 下 面 介 绍 如 何 生 成 自 己 的 AspHttp组 件 。
使 用 Winsock控 件 ， 下 面 将 介 绍 怎 么 来 建 立 一 个 简 单 的 HTTP组 件 。
记 住 先 选 择 mswinsck.ocx控 件 。
下 面 的 代 码 是 在 VB6中 编 译 的 。
代 码 如 下 ：
Private WithEvents objWinSock As MSWinsockLib.Winsock
Private strURL As String
Private strURI As String
Private strServer As String
Private nPort As Long
Private strHead As String
Private strData As String
Private bConnected As Boolean
Public Function httpGet(URL As String) As String
Set objWinSock = New MSWinsockLib.Winsock
strURL = URL
ParseURL
Connect
SendRequest
objWinSock.Close
strHead = Left(strData, InStr(strData, vbCrLf &
vbCrLf))
strData = Right(strData, Len(strData) -
InStr(strData, vbCrLf & vbCrLf))
httpGet = strData
End Function
Private Sub ParseURL()
If LCase(Left(strURL, 7)) = "http://" Then
If InStr(8, strURL, "/") = 0 Then
strServer = Right(strURL, Len(strURL) -
7)
strURI = "/"
Else
strServer = Mid(strURL, 8, InStr(8,
strURL, "/") - 8)
strURI = Right(strURL, Len(strURL) -
InStr(8, strURL, "/") + 1)
End If
If InStr(strServer, ":") <> 0 Then
nPort = CLng(Right(strServer,
Len(strServer) - InStr(strServer,
":")))
strServer = Left(strServer,
InStr(strServer, ":") - 1)
End If
If nPort = 0 Then nPort = 80
Else
Err.Raise vbObjectError, "Error", "错 误 的 URL"
End If
End Sub
Private Sub Connect()
Dim dtStart As Date
dtStart = Now()
objWinSock.RemoteHost = strServer
objWinSock.RemotePort = nPort
objWinSock.Connect
Do Until bConnected
DoEvents
If DateDiff("s", dtStart, Now) > 30 Then
Err.Raise vbObjectError, "Error", "连 接 超
时 "
End If
Loop
End Sub
Private Sub SendRequest()
Dim strCmd
Dim dtStart As Date
dtStart = Now()
strCmd = "GET " & strURI & " HTTP/1.0" & vbCrLf
strCmd = strCmd & "User-Agent: aspHttp.http" &
vbCrLf
strCmd = strCmd & "Accept: */*" & vbCrLf
strCmd = strCmd & vbCrLf
objWinSock.SendData strCmd
Do Until objWinSock.State = sckClosing
DoEvents
If DateDiff("s", dtStart, Now) > 60 Then
Err.Raise vbObjectError, "Error", "请 求 超
时 "
End If
Loop
End Sub
Public Property Get Head() As Variant
Head = strHead
End Property
Public Property Get Body() As Variant
Body = strData
End Property
Private Sub objWinSock_DataArrival(ByVal bytesTotal As
Long)
Dim strTemp
objWinSock.GetData strTemp, vbString
strData = strData & strTemp
End Sub
Private Sub objWinSock_Connect()
bConnected = True
End Sub
Private Sub objWinSock_Error(ByVal Number As Integer,
Description As String, _
ByVal Scode As Long, ByVal Source As String, ByVal
HelpFile As String, _
ByVal HelpContext As Long, CancelDisplay As Boolean)
Err.Raise vbObjectError, "Error", "Winsock Error: "
& Number &
vbCrLf & Description
CancelDisplay = True
End Sub
编 译 该 组 件 ， 然 后 按 照 下 面 的 步 骤 注 册 该 组 件
C:\net stop iisadmin /y
C:\mtxstop
编 译 成 Active Dll
C:\net start w3svc
在 ASP中 调 用 这 个 组 件
<%@ Language=VBScript %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio
6.0">
</HEAD>
<BODY>
<%
Dim obj
Set obj = Server.CreateObject("aspHttp.http")
Response.Write obj.httpGet("http://www.chinaasp.com.cn")
%>
</BODY>
</HTML>
<END>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -