天天看點

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:如果有興趣的朋友,可以向我索要最簡單的完整執行個體。

繼續閱讀