form1.frm

HTTP 2 SOCKET的完整开发包 HTTP 2 SOCKET的完整开发包.rar

intCurrentMode As Long
intDataOverride As Long
End Type
'-------------------------------------------------------------
Private Declare Function H_Start Lib "httport.dll" () As Long
Private Declare Function H_SetOption Lib "httport.dll" (ByVal intOption As Long, ByVal intCount As Long, ByRef ptrParams As TOptions) As Long
Private Declare Function H_CreateMapping Lib "httport.dll" (ByRef ptrMapping As TMappingParameters) As Long
Private Declare Function H_GetListeningPort Lib "httport.dll" (ByVal intMappingId As Long, ByRef intPort As Long) As Long
Private Declare Function H_GetMappingStats Lib "httport.dll" (ByVal intMappingId As Long, ByRef ptrStats As TMappingStats) As Long
Private Declare Function H_GetProxyStats Lib "httport.dll" (ByRef ptrProxyStats As TProxyStats) As Long
Private Declare Function H_DestroyMapping Lib "httport.dll" (ByVal intMappingId As Long) As Long
Private Declare Function H_Stop Lib "httport.dll" () As Long

Dim intMappingId As Long
Dim intConnectionMode As Long
Dim intDataOverride As Long

Dim intSavedConnectionMode As Long   ' FAKE EXTERNAL CONFIG
Dim intSavedDataOverride As Long

Dim intAlreadyRetrying As Long

Private Sub Connect_Click()

 Dim Options As TOptions
 Dim MappingParams As TMappingParameters
 Dim LocalPort As Long
 
 If Connect.Caption = "Connect" Then
 
  '---------------- SET DATA_OVERRIDE AS CURRENTLY KNOWN
 
  Options.strParam1 = Trim(Str(intDataOverride))
  If H_SetOption(H_OPTION_DATA_OVERRIDE, 1, Options) <> H_SUCCESS Then
   MsgBox "H_SetOption(dataoverride) failed"
  End If
 
  '---------------- SET HTTP PROXY
 
  Options.strParam1 = ProxyHost.Text  ' http proxy host
  Options.strParam2 = ProxyPort.Text  ' http proxy port
  If H_SetOption(H_OPTION_PROXY, 2, Options) <> H_SUCCESS Then
   MsgBox "H_SetOption(proxy) failed"
  End If
 
  '---------------- SET PROXY USER INFO - USERNAME, PASSWORD, USER-AGENT
 
  Options.strParam1 = ProxyUsername.Text
  Options.strParam2 = ProxyPassword.Text
  Options.strParam3 = "httport/dll" ' arbitrary user-agent string
  If H_SetOption(H_OPTION_USER_INFO, 3, Options) <> H_SUCCESS Then
   MsgBox "H_SetOption(userinfo) failed"
  End If
 
  '---------------- SET KNOWN HTTHOST LIST, HOSTS SHOULD BE DIFFERENT IN REAL LIFE OF COURSE
  '                 CAN BE MORE THAN 3, REQUIRES TOptions REDEFINITION THOUGH
 
  Options.strParam1 = HTTHostHost.Text & ":" & HTTHostPort.Text
  Options.strParam2 = HTTHostHost.Text & ":" & HTTHostPort.Text
  Options.strParam3 = HTTHostHost.Text & ":" & HTTHostPort.Text
  If H_SetOption(H_OPTION_HOST_LIST, 3, Options) <> H_SUCCESS Then
   MsgBox "H_SetOption(hostlist) failed"
  End If
 
  '---------------- WHEN ALL OPTIONS ARE SET, START THE LIBRARY
 
  If H_Start <> H_SUCCESS Then
   MsgBox "H_Start failed"
  End If
 
  '---------------- CREATE A SINGLE TEST MAPPING
 
  MappingParams.intAllowLocalOnly = 1
  MappingParams.intMode = intConnectionMode
  MappingParams.intStrucSize = 28 ' ACTUALLY SIZEOF(MappingParams)
  MappingParams.strRemoteHost = RemoteHost.Text
  MappingParams.wLocalPort = 0
  MappingParams.wRemotePort = Int(RemotePort.Text)
 
  If H_CreateMapping(MappingParams) <> H_SUCCESS Then
   MsgBox "CreateMapping failed"
  End If
 
  intMappingId = MappingParams.intMappingId
 
  '---------------- WAIT UNTIL LOCAL LISTENING PORT IS KNOWN
  '                 IF wLocalPort <> 0, THIS STEP IS NOT NECESSARY
 
  LocalPort = 0
  While LocalPort = 0
  
   If H_GetListeningPort(intMapping, LocalPort) <> H_SUCCESS Then
    MsgBox "H_GetListeningPort failed"
    GoTo GLPFailed
   End If
  
   If LocalPort = 0 Then
    DoEvents
   End If
  
  Wend
  
GLPFailed:

  '---------------- THE EASIEST PART - CONNECT TO LOCALHOST

  If LocalPort <> 0 Then
  
   WinSock.RemoteHost = "127.0.0.1"
   WinSock.RemotePort = LocalPort
   WinSock.Connect
   
  End If
  
 Else
  Call WinSock_Close
 End If

End Sub

Private Sub Form_Load()
 
 ' IMPORTANT:
 ' RESTORE CONFIG FROM SOME STORAGE (INI FILE OR REGISTRY ETC.)
 ' CONFIG INCLUDES SAVED CONNECTION MODE AND DATA_OVERIDE OPTION
 
 intSavedConnectionMode = CONN_USE_AUTO     ' THIS IS A FAKE CONFIG LOAD
 intSavedDataOverride = 0                   ' ALSO THIS IS THE BEST DEFAULTS IF NO CONFIG KNOWN YET
 
 intConnectionMode = intSavedConnectionMode ' THESE WILL BE ACTUALLY USED
 intDataOverride = intSavedDataOverride
 
 intAlreadyRetrying = 0
 intMappingId = -1
 
End Sub

Private Sub Form_Unload(Cancel As Integer)

 ' IMPORTANT: SAVE CONFIG

 intSavedDataOverride = intDataOverride
 intSavedConnectionMode = intConnectionMode

End Sub

Private Sub Send_Click()

 WinSock.SendData SendLine.Text & Chr(13) & Chr(10)
 Data.Text = Data.Text & SendLine.Text & Chr(13) & Chr(10)
 SendLine.Text = ""

End Sub


Private Sub SendLine_Change()

 Send.Enabled = (SendLine.Text <> "") And (Connect.Caption = "Disconnect")

End Sub

Private Sub SendLine_KeyPress(KeyAscii As Integer)

 If (KeyAscii = 13) And (Send.Enabled) Then
  Call Send_Click
 End If
 
End Sub

Private Sub WinSock_Close()

 Dim Stats As TMappingStats
 Dim ProxyStats As TProxyStats

 WinSock.Close
 
 If intMappingId <> -1 Then
  
  '------------ GET THE ACTUAL PROXY CONFIG. THIS MUST BE DUNE WHILE MAPPING(S) EXIST
 
  ProxyStats.intStrucSize = 20  ' ACTUALLY SIZEOF(ProxyStats)
  If H_GetProxyStats(ProxyStats) <> H_SUCCESS Then
   MsgBox "H_GetProxyStats failed"
  End If
 
  intConnectionMode = ProxyStats.intCurrentMode
  intDataOverride = ProxyStats.intDataOverride
 
  ' GET MAPPING STATISTICS
  ' THIS CAN BE DONE AT ANY TIME WHILE MAPPING EXISTS
  
  Stats.intStrucSize = 44   ' ACTUALLY SIZEOF(Stats)
  If H_GetMappingStats(intMappingId, Stats) <> H_SUCCESS Then
   MsgBox "H_GetMappingStats failed"
  End If
  
  Data.Text = Data.Text & _
              "*** KBytes Transferred: " & Stats.intKBytesTransferred & Chr(13) & Chr(10) & _
              "*** WinSock errors: " & Stats.intSockErrors & Chr(13) & Chr(10) & _
              "*** HTTHost errors: " & Stats.intHostErrors & Chr(13) & Chr(10) & _
              "*** Timeout errors: " & Stats.intTimeoutErrors & Chr(13) & Chr(10) & _
              "*** Protocol errors: " & Stats.intProtocolErrors & Chr(13) & Chr(10) & _
              "*** Memory errors: " & Stats.intMemoryErrors & Chr(13) & Chr(10) & _
              "*** CONNECT errors: " & Stats.intConnectErrors & Chr(13) & Chr(10) & _
              "*** Other errors: " & Stats.intOtherErrors & Chr(13) & Chr(10) & _
              "*** Fatal errors: " & Stats.intFatalErrors & Chr(13) & Chr(10)

  ' DESTROY MAPPING
  
  If H_DestroyMapping(intMappingId) <> H_SUCCESS Then
   MsgBox "H_DestroyMapping failed"
  End If
  
  intMappingId = -1
  
 End If

 Data.Text = Data.Text & "*** DISCONNECTED" & Chr(13) & Chr(10)
 Connect.Caption = "Connect"
 
 '------------ STOP THE LIBRARY
 
 If H_Stop <> H_SUCCESS Then
  MsgBox "H_Stop failed"
 End If
 
 '------------ CHECK WHETHER THE DE-FACTO PROXY CONFIG REQUIRES DATA_OVERRIDE
 ' SINCE WE DID SET IT TO 0 AT START, THE ONLY WAY IT CAN NOW BE <> 0,
 ' IS THAT PROXY IS BAD, WILL NOW RETRY WITH NON-ZERO DATA_OVERRIDE
 ' THIS SHOULD BE DONE SILENTLY, AND ONLY ONCE
 ' I WILL POP A MESSAGE BOX JUST CAUSE IT'S DEMO
 
 If (ProxyStats.intDataOverride <> 0) And (intAlreadyRetrying = 0) Then
  MsgBox "The proxy appears to be not fully HTTP compatible. The connection will now be retried with different library settings."
  intAlreadyRetrying = 1
  Connect_Click
 End If
 
End Sub

Private Sub WinSock_Connect()

 Data.Text = "*** CONNECTED" & Chr(13) & Chr(10)
 Connect.Caption = "Disconnect"
 Call SendLine_Change
 
End Sub

Private Sub WinSock_DataArrival(ByVal bytesTotal As Long)

 Dim NewData As Variant
 WinSock.GetData NewData, vbString
 Data.Text = Data.Text & NewData

End Sub