C/S模式一般都是用winsock来相互通信,实现双方互动。
用ASP网页来连接(不能称之为通信),只能C对S发送信息或请求一些信息,
S是不能主动来连接C,发信息给C。
一、C端
既然是要访问ASP页,这里有二种方式。
1、API写的访问模块
Option Explicit
''<API 宣告,API 常数> Public Declare Function InternetOpen Lib "wininet.dll" _ Alias "InternetOpenA" _ (ByVal lpszCallerName As String,_ ByVal dwAccessType As Long,_ ByVal lpszProxyName As String,_ ByVal lpszProxyBypass As String,_ ByVal dwFlags As Long) As Long Public Declare Function InternetConnect Lib "wininet.dll" _ Alias "InternetConnectA" _ (ByVal hInternetSession As Long,_ ByVal lpszServerName As String,_ ByVal nProxyPort As Integer,_ ByVal lpszUsername As String,_ ByVal lpszPassword As String,_ ByVal dwService As Long,_ ByVal dwFlags As Long,_ ByVal dwContext As Long) As Long Public Declare Function InternetReadFile Lib "wininet.dll" _ (ByVal hFile As Long,_ ByVal sBuffer As String,_ ByVal lNumBytesToRead As Long,_ lNumberOfBytesRead As Long) As Integer Public Declare Function HttpOpenRequest Lib "wininet.dll" _ Alias "HttpOpenRequestA" _ (ByVal hInternetSession As Long,_ ByVal lpszVerb As String,_ ByVal lpszObjectName As String,_ ByVal lpszVersion As String,_ ByVal lpszReferer As String,_ ByVal lpszAcceptTypes As Long,_ ByVal dwContext As Long) As Long Public Declare Function HttpSendRequest Lib "wininet.dll" _ Alias "HttpSendRequestA" _ (ByVal hHttpRequest As Long,_ ByVal sHeaders As String,_ ByVal lHeadersLength As Long,_ ByVal sOptional As String,_ ByVal lOptionalLength As Long) As Boolean Public Declare Function InternetCloseHandle Lib "wininet.dll" _ (ByVal hInternetHandle As Long) As Boolean Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" _ Alias "HttpAddRequestHeadersA" _ (ByVal hHttpRequest As Long,_ ByVal lModifiers As Long) As Integer Public Function PostInfo(ByVal WebServerAddress As String,_ ByVal Port As String,_ ByVal WebPageName As String,_ ByVal CommandString As String,_ Optional ByVal PostData As String = "") As String Dim hInternetOpen As Long Dim hInternetConnect As Long Dim hHttpOpenRequest As Long Dim bRet As Boolean hInternetOpen = 0 hInternetConnect = 0 hHttpOpenRequest = 0 'Use registry access settings. Const INTERNET_OPEN_TYPE_PRECONFIG = 0 hInternetOpen = InternetOpen("http generic",_ INTERNET_OPEN_TYPE_PRECONFIG,_ vbNullString,_ 0) If hInternetOpen <> 0 Then 'Type of service to access. Const INTERNET_SERVICE_HTTP = 3 Const INTERNET_DEFAULT_HTTP_PORT = 80 'Change the server to your server name hInternetConnect = InternetConnect(hInternetOpen,_ WebServerAddress,_ Port,_ "HTTP/1.0",_ INTERNET_SERVICE_HTTP,_ 0,_ 0) If hInternetConnect <> 0 Then 'Brings the data across the wire even if it locally cached. Const INTERNET_FLAG_RELOAD = &H80000000 hHttpOpenRequest = HttpOpenRequest(hInternetConnect,_ "POST",_ WebPageName & CommandString,_ INTERNET_FLAG_RELOAD,_ 0) If hHttpOpenRequest <> 0 Then Dim sHeader As String Const HTTP_ADDREQ_FLAG_ADD = &H20000000 Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000 sHeader = "Content-Type: application/x-www-form-urlencoded" & vbCrLf 'sHeader = "Content-Type: multipart/form-data" & vbCrLf bRet = HttpAddRequestHeaders(hHttpOpenRequest,_ sHeader,Len(sHeader),HTTP_ADDREQ_FLAG_REPLACE _ Or HTTP_ADDREQ_FLAG_ADD) Dim lpszPostData As String Dim lPostDataLen As Long lpszPostData = PostData 'lPostDataLen = Len(lpszPostData) lPostDataLen = LenB(StrConv(lpszPostData,vbFromUnicode)) bRet = HttpSendRequest(hHttpOpenRequest,_ lpszPostData,_ lPostDataLen) Dim bDoLoop As Boolean Dim sReadBuffer As String * 4096 Dim lNumberOfBytesRead As Long Dim sBuffer As String bDoLoop = True While bDoLoop sReadBuffer = vbNullString bDoLoop = InternetReadFile(hHttpOpenRequest,_ sReadBuffer,Len(sReadBuffer),lNumberOfBytesRead) sBuffer = sBuffer & _ Left(sReadBuffer,lNumberOfBytesRead) If Not CBool(lNumberOfBytesRead) Then bDoLoop = False Wend PostInfo = sBuffer bRet = InternetCloseHandle(hHttpOpenRequest) End If bRet = InternetCloseHandle(hInternetConnect) End If bRet = InternetCloseHandle(hInternetOpen) End If PostInfo = sBuffer End Function Public Sub SplitAddr(ByVal addr$,srv$,script$) 'Inputs: The full url including http:// ' Two variables that will be changed ' 'Returns: Splits the addr$ var into the server name ' and the script path Dim i% i = InStr(addr$,"/") srv$ = Mid(addr$,i + 2,Len(addr$) - (i + 1)) i = InStr(srv$,"/") script$ = Mid(srv$,i,Len(srv$) + 1 - i) srv$ = Left$(srv$,i - 1) End Sub 以上代码可以在网上搜索到,我修改了一下,支持中文传输。
把以上代码放到一个模块中即可。
调用PostInfo时,给出正确的参数即可。
这个函数的返回值就是你得到的信息,一个字符串,由S端生成。
2、可以用XMLHTTP来访问,我给出一个我实际用的upload file的函数
Public Function UploadFile() As Boolean On Error GoTo UploadFile_Error
m_UploadMessage = "" If Len(m_sFileName) = 0 Then m_UploadMessage = "未设置上传的文件。" UploadFile = False Exit Function End If Dim XMLDocument As New DOMDocument Dim ADOStream As New Stream Dim DOMElement As IXMLDOMElement Dim MyXMLHttp As New XMLHTTP XMLDocument.loadXML ("<?xml version=""1.0"" ?> <root/>") XMLDocument.documentElement.setAttribute "xmlns:dt","urn:schemas-microsoft-com:datatypes" Set DOMElement = XMLDocument.createElement("File") DOMElement.dataType = "bin.base64" ADOStream.Type = adTypeBinary ADOStream.Open ADOStream.LoadFromFile m_sFileName DOMElement.nodeTypedValue = ADOStream.Read ADOStream.Close XMLDocument.documentElement.appendChild DOMElement
MyXMLHttp.Open "POST",m_sWebPage,False,m_sUserName,m_sPassWord MyXMLHttp.send XMLDocument m_UploadMessage = MyXMLHttp.responseText If m_UploadMessage = "OK" Then m_UploadMessage = "" UploadFile = True Else UploadFile = False End If UploadFile_Exit: m_sFileName = "" Set XMLDocument = Nothing Set ADOStream = Nothing Set DOMElement = Nothing Set MyXMLHttp = Nothing Exit Function UploadFile_Error: UploadFile = False Debug.Print CStr(Now()) & "--->" & vbCrLf & _ "ErrAddress: VanFileTransfer->VanFileDownLoad->UploadFile" & vbCrLf & _ "ErrNumber: " & Err.Number & vbCrLf & _ "Description: " & Err.Description & vbCrLf Err.Clear Resume UploadFile_Exit End Function
同样,代码中的m_UploadMessage就是返回来的信息.
二、接着说S端
需要引用microsoft active server pages object library
1、添加ASP页的接口类
Private gMyServer As Server Private gMySession As Session Private gMyApplication As Application Private gMyRequest As Request Private gMyResponse As Response
这几个是ASP的对象,会ASP的人一看就知道。
Public Function OnStartPage(MyScriptingContext As ScriptingContext) Set gMyServer = MyScriptingContext.Server Set gMySession = MyScriptingContext.Session Set gMyApplication = MyScriptingContext.Application Set gMyRequest = MyScriptingContext.Request Set gMyResponse = MyScriptingContext.Response End Function
Public Function OnEndPage() Set gMyServer = Nothing Set gMySession = Nothing Set gMyApplication = Nothing Set gMyRequest = Nothing Set gMyResponse = Nothing End Function 这二个是ASP加载时和关闭时事件。我们用来得到对象实例和释放对象。
下面就是入口函数
public function MySubMain()
'gMyRequest中就是C给过来的一些数据,处理他
gMyResponse.Write “返回给C的数据”
end function
三、ASP页内容
<% setMyObject = server.createobject("工程名.接口类名") MyObject.MySubMain set MyObject = nothing %>
把ASP页架起来就OK了。
C/S就可以通信了。
PS:如果有兴趣的朋友,可以向我索要最简单的完整实例。 (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|