VB6通过ASP网页实现C/S模式

 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 dwFlags 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 sHeaders As String, _
                  ByVal lHeadersLength 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, _
                                          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, _
                                                      vbNullString, _
                                                      "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, _
                                                            "HTTP/1.0", _
                                                            vbNullString, _
                                                            0, _
                                                            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, _
                                          vbNullString, _
                                          0, _
                                          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页内容

<%
    set MyObject = server.createobject("工程名.接口类名")
    MyObject.MySubMain
    set MyObject = nothing
%>

把ASP页架起来就OK了。

C/S就可以通信了。

PS：如果有兴趣的朋友，可以向我索要最简单的完整实例。