" & Join(vSplit, "
" & vbCrLf & "" & Index & ": ") & "
" & vbCrLf & _ 134 | "" & Index & ": Current time is " & Now & "
" & _ 135 | "" & Index & ": RemoteHostIP is " & ctxServer(Index).RemoteHostIP & "
" & vbCrLf & _ 136 | "" & Index & ": RemotePort is " & ctxServer(Index).RemotePort & "
" & vbCrLf & _ 137 | "" & vbCrLf 138 | ctxServer(Index).SendData "HTTP/1.1 200 OK" & vbCrLf & _ 139 | "Content-Type: text/html" & vbCrLf & _ 140 | "Content-Length: " & Len(sBody) & vbCrLf & vbCrLf & _ 141 | sBody 142 | End If 143 | Debug.Print "ctxServer(" & Index & ")_DataArrival, done", Timer 144 | End Sub 145 | 146 | Private Sub ctxServer_CloseEvent(Index As Integer) 147 | Unload ctxServer(Index) 148 | End Sub 149 | 150 | Private Sub ctxServer_Close(Index As Integer) 151 | ctxServer_CloseEvent Index 152 | End Sub 153 | 154 | Private Sub ctxServer_OnServerCertificate(Index As Integer, Socket As Object, Certificates As Object, PrivateKey As Object, Confirmed As Boolean) 155 | Debug.Print "ctxServer(" & Index & ")_OnServerCertificate, SniRequested=" & Socket.SniRequested 156 | End Sub 157 | 158 | Private Sub ctxServer_Error(Index As Integer, ByVal Number As Long, Description As String, ByVal Scode As UcsErrorConstants, Source As String, HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 159 | MsgBox Description & " &H" & Hex$(Number) & " [" & Source & "]", vbCritical, "ctxServer(" & Index & ")_Error" 160 | End Sub 161 | 162 | -------------------------------------------------------------------------------- /test/Winsock/Form2.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form Form2 3 | Caption = "Form2" 4 | ClientHeight = 2952 5 | ClientLeft = 108 6 | ClientTop = 456 7 | ClientWidth = 3624 8 | LinkTopic = "Form1" 9 | ScaleHeight = 2952 10 | ScaleWidth = 3624 11 | StartUpPosition = 3 'Windows Default 12 | Begin VB.CommandButton Command4 13 | Caption = "HTTPS Server" 14 | Height = 516 15 | Left = 252 16 | TabIndex = 3 17 | Top = 2268 18 | Width = 1524 19 | End 20 | Begin VB.CommandButton Command3 21 | Caption = "HTTPS request" 22 | Height = 516 23 | Left = 252 24 | TabIndex = 2 25 | Top = 1596 26 | Width = 1524 27 | End 28 | Begin VB.CommandButton Command2 29 | Caption = "HTTP Server" 30 | Height = 516 31 | Left = 252 32 | TabIndex = 1 33 | Top = 924 34 | Width = 1524 35 | End 36 | Begin WinsockNative.ctxWinsock ctxServer 37 | Index = 0 38 | Left = 2604 39 | Top = 840 40 | _ExtentX = 677 41 | _ExtentY = 677 42 | End 43 | Begin VB.CommandButton Command1 44 | Caption = "HTTP request" 45 | Height = 516 46 | Left = 252 47 | TabIndex = 0 48 | Top = 252 49 | Width = 1524 50 | End 51 | Begin WinsockNative.ctxWinsock ctxWinsock 52 | Left = 2604 53 | Top = 252 54 | _ExtentX = 677 55 | _ExtentY = 677 56 | End 57 | End 58 | Attribute VB_Name = "Form2" 59 | Attribute VB_GlobalNameSpace = False 60 | Attribute VB_Creatable = False 61 | Attribute VB_PredeclaredId = True 62 | Attribute VB_Exposed = False 63 | Option Explicit 64 | 65 | Private Sub Command1_Click() 66 | ctxWinsock.Protocol = UcsProtocolConstants.sckTCPProtocol 67 | ctxWinsock.Connect "bgdev.org", 80 68 | End Sub 69 | 70 | Private Sub Command3_Click() 71 | ctxWinsock.Protocol = UcsProtocolConstants.sckTLSProtocol 72 | ctxWinsock.Connect "bgdev.org", 443 73 | End Sub 74 | 75 | Private Sub Command2_Click() 76 | ctxServer(0).Close_ 77 | ctxServer(0).Protocol = UcsProtocolConstants.sckTCPProtocol 78 | ctxServer(0).Bind 8088, "127.0.0.1" 79 | ctxServer(0).Listen 80 | Shell "cmd /c start http://localhost:8088/" 81 | End Sub 82 | 83 | Private Sub Command4_Click() 84 | ctxServer(0).Close_ 85 | ctxServer(0).Protocol = UcsProtocolConstants.sckTLSProtocol 86 | ctxServer(0).Bind 8088, "127.0.0.1" 87 | ctxServer(0).Listen ' CertSubject:="68b5220077de8bbeaed8e1c2540fec6c16b418a8" 88 | Shell "cmd /c start https://localhost:8088/" 89 | End Sub 90 | 91 | Private Sub ctxWinsock_Connect() 92 | Dim lIdx As Long 93 | 94 | Debug.Print "Connected to " & ctxWinsock.RemoteHostIP, Timer 95 | ctxWinsock.SendData "GET / HTTP/1.0" & vbCrLf & _ 96 | "Host: www.bgdev.org" & vbCrLf & _ 97 | "Connection: close" & vbCrLf & vbCrLf 98 | For lIdx = 1 To 5000 99 | ctxWinsock.SendData String(1000, "a") 100 | Next 101 | End Sub 102 | 103 | Private Sub ctxWinsock_DataArrival(ByVal bytesTotal As Long) 104 | Dim sBuffer As String 105 | 106 | Debug.Print "DataArrival", bytesTotal 107 | ctxWinsock.PeekData sBuffer 108 | ctxWinsock.GetData sBuffer 109 | Debug.Print sBuffer; 110 | End Sub 111 | 112 | Private Sub ctxWinsock_Error(ByVal Number As Long, Description As String, ByVal Scode As UcsErrorConstants, Source As String, HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 113 | MsgBox Description & " &H" & Hex$(Number) & " [" & Source & "]", vbCritical, "ctxWinsock_Error" 114 | End Sub 115 | 116 | Private Sub ctxServer_ConnectionRequest(Index As Integer, ByVal requestID As Long) 117 | Debug.Print "ctxServer(" & Index & ")_ConnectionRequest, requestID=" & requestID & ", RemoteHostIP=" & ctxServer(Index).RemoteHostIP & ", RemotePort=" & ctxServer(Index).RemotePort, Timer 118 | Load ctxServer(ctxServer.UBound + 1) 119 | ctxServer(ctxServer.UBound).Accept requestID 120 | ' Debug.Print "ctxServer(" & ctxServer.UBound & ").Protocol=" & ctxServer(ctxServer.UBound).Protocol 121 | End Sub 122 | 123 | Private Sub ctxServer_DataArrival(Index As Integer, ByVal bytesTotal As Long) 124 | Dim sRequest As String 125 | Dim vSplit As Variant 126 | Dim sBody As String 127 | 128 | Debug.Print "ctxServer(" & Index & ")_DataArrival, bytesTotal=" & bytesTotal, Timer 129 | ctxServer(Index).GetData sRequest 130 | vSplit = Split(sRequest, vbCrLf) 131 | If UBound(vSplit) >= 0 Then 132 | Debug.Print vSplit(0) 133 | sBody = "" & Join(vSplit, "
" & vbCrLf & "" & Index & ": ") & "
" & vbCrLf & _ 134 | "" & Index & ": Current time is " & Now & "
" & _ 135 | "" & Index & ": RemoteHostIP is " & ctxServer(Index).RemoteHostIP & "
" & vbCrLf & _ 136 | "" & Index & ": RemotePort is " & ctxServer(Index).RemotePort & "
" & vbCrLf & _ 137 | "" & vbCrLf 138 | ctxServer(Index).SendData "HTTP/1.1 200 OK" & vbCrLf & _ 139 | "Content-Type: text/html" & vbCrLf & _ 140 | "Content-Length: " & Len(sBody) & vbCrLf & vbCrLf & _ 141 | sBody 142 | End If 143 | Debug.Print "ctxServer(" & Index & ")_DataArrival, done", Timer 144 | End Sub 145 | 146 | Private Sub ctxServer_CloseEvent(Index As Integer) 147 | Unload ctxServer(Index) 148 | End Sub 149 | 150 | Private Sub ctxServer_Close(Index As Integer) 151 | ctxServer_CloseEvent Index 152 | End Sub 153 | 154 | Private Sub ctxServer_OnServerCertificate(Index As Integer, Socket As Object, Certificates As Object, PrivateKey As Object, Confirmed As Boolean) 155 | Debug.Print "ctxServer(" & Index & ")_OnServerCertificate, SniRequested=" & Socket.SniRequested 156 | End Sub 157 | 158 | Private Sub ctxServer_Error(Index As Integer, ByVal Number As Long, Description As String, ByVal Scode As UcsErrorConstants, Source As String, HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 159 | MsgBox Description & " &H" & Hex$(Number) & " [" & Source & "]", vbCritical, "ctxServer(" & Index & ")_Error" 160 | End Sub 161 | 162 | -------------------------------------------------------------------------------- /test/Winsock/Form3.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Object = "{710A6B30-6CD9-4F61-8399-1E51A1E65B86}#2.0#0"; "WinsockTls.ocx" 3 | Begin VB.Form Form2 4 | Caption = "Form2" 5 | ClientHeight = 2952 6 | ClientLeft = 108 7 | ClientTop = 456 8 | ClientWidth = 3624 9 | LinkTopic = "Form1" 10 | ScaleHeight = 2952 11 | ScaleWidth = 3624 12 | StartUpPosition = 3 'Windows Default 13 | Begin VB.CommandButton Command4 14 | Caption = "HTTPS Server" 15 | Height = 516 16 | Left = 252 17 | TabIndex = 3 18 | Top = 2268 19 | Width = 1524 20 | End 21 | Begin VB.CommandButton Command3 22 | Caption = "HTTPS request" 23 | Height = 516 24 | Left = 252 25 | TabIndex = 2 26 | Top = 1596 27 | Width = 1524 28 | End 29 | Begin VB.CommandButton Command2 30 | Caption = "HTTP Server" 31 | Height = 516 32 | Left = 252 33 | TabIndex = 1 34 | Top = 924 35 | Width = 1524 36 | End 37 | Begin WinsockTls.ctxWinsock ctxServer 38 | Index = 0 39 | Left = 2604 40 | Top = 840 41 | _extentx = 677 42 | _extenty = 677 43 | End 44 | Begin VB.CommandButton Command1 45 | Caption = "HTTP request" 46 | Height = 516 47 | Left = 252 48 | TabIndex = 0 49 | Top = 252 50 | Width = 1524 51 | End 52 | Begin WinsockTls.ctxWinsock ctxWinsock 53 | Left = 2604 54 | Top = 252 55 | _extentx = 677 56 | _extenty = 677 57 | End 58 | End 59 | Attribute VB_Name = "Form2" 60 | Attribute VB_GlobalNameSpace = False 61 | Attribute VB_Creatable = False 62 | Attribute VB_PredeclaredId = True 63 | Attribute VB_Exposed = False 64 | Option Explicit 65 | 66 | Private Sub Command1_Click() 67 | ctxWinsock.Protocol = sckTCPProtocol 68 | ctxWinsock.Connect "bgdev.org", 80 69 | End Sub 70 | 71 | Private Sub Command3_Click() 72 | ctxWinsock.Protocol = sckTLSProtocol 73 | ctxWinsock.Connect "bgdev.org", 443 74 | End Sub 75 | 76 | Private Sub Command2_Click() 77 | ctxServer(0).Close_ 78 | ctxServer(0).Protocol = sckTCPProtocol 79 | ctxServer(0).Bind 8088, "127.0.0.1" 80 | ctxServer(0).Listen 81 | Shell "cmd /c start http://localhost:8088/" 82 | End Sub 83 | 84 | Private Sub Command4_Click() 85 | ctxServer(0).Close_ 86 | ctxServer(0).Protocol = sckTLSProtocol 87 | ctxServer(0).Bind 8088, "127.0.0.1" 88 | ctxServer(0).Listen ' CertSubject:="68b5220077de8bbeaed8e1c2540fec6c16b418a8" 89 | Shell "cmd /c start https://localhost:8088/" 90 | End Sub 91 | 92 | Private Sub ctxServer_Error(Index As Integer, ByVal Number As Long, Description As String, ByVal Scode As UcsErrorConstants, Source As String, HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 93 | MsgBox Description & " &H" & Hex$(Number) & " [" & Source & "]", vbCritical, "ctxServer(" & Index & ")_Error" 94 | End Sub 95 | 96 | Private Sub ctxWinsock_Connect() 97 | Dim lIdx As Long 98 | 99 | Debug.Print "Connected to " & ctxWinsock.RemoteHostIP, Timer 100 | ctxWinsock.SendData "GET / HTTP/1.0" & vbCrLf & _ 101 | "Host: www.bgdev.org" & vbCrLf & _ 102 | "Connection: close" & vbCrLf & vbCrLf 103 | For lIdx = 1 To 5000 104 | ctxWinsock.SendData String(1000, "a") 105 | Next 106 | End Sub 107 | 108 | Private Sub ctxWinsock_DataArrival(ByVal bytesTotal As Long) 109 | Dim sBuffer As String 110 | 111 | Debug.Print "DataArrival", bytesTotal 112 | ctxWinsock.PeekData sBuffer 113 | ctxWinsock.GetData sBuffer 114 | Debug.Print sBuffer; 115 | End Sub 116 | 117 | Private Sub ctxServer_ConnectionRequest(Index As Integer, ByVal requestID As Long) 118 | Debug.Print "ctxServer(" & Index & ")_ConnectionRequest, requestID=" & requestID & ", RemoteHostIP=" & ctxServer(Index).RemoteHostIP & ", RemotePort=" & ctxServer(Index).RemotePort, Timer 119 | Load ctxServer(ctxServer.UBound + 1) 120 | ctxServer(ctxServer.UBound).Protocol = ctxServer(Index).Protocol 121 | ctxServer(ctxServer.UBound).Accept requestID 122 | End Sub 123 | 124 | Private Sub ctxServer_DataArrival(Index As Integer, ByVal bytesTotal As Long) 125 | Dim sRequest As String 126 | Dim vSplit As Variant 127 | Dim sBody As String 128 | 129 | Debug.Print "ctxServer(" & Index & ")_DataArrival, bytesTotal=" & bytesTotal, Timer 130 | ctxServer(Index).GetData sRequest 131 | vSplit = Split(sRequest, vbCrLf) 132 | If UBound(vSplit) >= 0 Then 133 | Debug.Print vSplit(0) 134 | sBody = "" & Join(vSplit, "
" & vbCrLf & "" & Index & ": ") & "
" & vbCrLf & _ 135 | "" & Index & ": Current time is " & Now & "
" & _ 136 | "" & Index & ": RemoteHostIP is " & ctxServer(Index).RemoteHostIP & "
" & vbCrLf & _ 137 | "" & Index & ": RemotePort is " & ctxServer(Index).RemotePort & "
" & vbCrLf & _ 138 | "" & vbCrLf 139 | ctxServer(Index).SendData "HTTP/1.1 200 OK" & vbCrLf & _ 140 | "Content-Type: text/html" & vbCrLf & _ 141 | "Content-Length: " & Len(sBody) & vbCrLf & vbCrLf & _ 142 | sBody 143 | End If 144 | Debug.Print "ctxServer(" & Index & ")_DataArrival, done", Timer 145 | End Sub 146 | 147 | Private Sub ctxServer_CloseEvent(Index As Integer) 148 | Unload ctxServer(Index) 149 | End Sub 150 | 151 | Private Sub ctxServer_Close(Index As Integer) 152 | ctxServer_CloseEvent Index 153 | End Sub 154 | 155 | Private Sub ctxWinsock_Error(ByVal Number As Long, Description As String, ByVal Scode As UcsErrorConstants, Source As String, HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 156 | MsgBox Description & " &H" & Hex$(Number) & " [" & Source & "]", vbCritical, "ctxWinsock_Error" 157 | End Sub 158 | -------------------------------------------------------------------------------- /test/Winsock/Group3.vbg: -------------------------------------------------------------------------------- 1 | VBGROUP 5.0 2 | StartupProject=Project3.vbp 3 | Project=..\..\contrib\dll\WinsockTls.vbp 4 | -------------------------------------------------------------------------------- /test/Winsock/Project1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form1.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 4 | UserControl=..\..\contrib\ctxWinsock.ctl 5 | Class=cAsyncSocket; ..\..\src\cAsyncSocket.cls 6 | Class=cTlsSocket; ..\..\src\cTlsSocket.cls 7 | Module=mdTlsThunks; ..\..\src\mdTlsThunks.bas 8 | Class=cTlsRemaster; ..\..\contrib\cTlsRemaster.cls 9 | Form=frmRemaster.frm 10 | Class=cClientCallback; cClientCallback.cls 11 | IconForm="Form1" 12 | Startup="Form1" 13 | HelpFile="" 14 | ExeName32="Project1.exe" 15 | Command32="" 16 | Name="WinsockTest" 17 | HelpContextID="0" 18 | CompatibleMode="0" 19 | MajorVer=1 20 | MinorVer=0 21 | RevisionVer=0 22 | AutoIncrementVer=0 23 | ServerSupportFiles=0 24 | VersionCompanyName="Unicontsoft" 25 | CompilationType=0 26 | OptimizationType=0 27 | FavorPentiumPro(tm)=0 28 | CodeViewDebugInfo=0 29 | NoAliasing=0 30 | BoundsCheck=0 31 | OverflowCheck=0 32 | FlPointCheck=0 33 | FDIVCheck=0 34 | UnroundedFP=0 35 | StartMode=0 36 | Unattended=0 37 | Retained=0 38 | ThreadPerObject=0 39 | MaxNumberOfThreads=1 40 | -------------------------------------------------------------------------------- /test/Winsock/Project2.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form2.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 4 | UserControl=..\..\contrib\ctxWinsock.ctl 5 | Class=cAsyncSocket; ..\..\src\cAsyncSocket.cls 6 | Class=cTlsSocket; ..\..\src\cTlsSocket.cls 7 | Module=mdTlsNative; ..\..\src\mdTlsNative.bas 8 | IconForm="Form2" 9 | Startup="Form2" 10 | HelpFile="" 11 | ExeName32="Project2.exe" 12 | Command32="" 13 | Name="WinsockNative" 14 | HelpContextID="0" 15 | CompatibleMode="0" 16 | MajorVer=1 17 | MinorVer=0 18 | RevisionVer=0 19 | AutoIncrementVer=0 20 | ServerSupportFiles=0 21 | VersionCompanyName="Unicontsoft" 22 | CompilationType=0 23 | OptimizationType=0 24 | FavorPentiumPro(tm)=0 25 | CodeViewDebugInfo=0 26 | NoAliasing=0 27 | BoundsCheck=0 28 | OverflowCheck=0 29 | FlPointCheck=0 30 | FDIVCheck=0 31 | UnroundedFP=0 32 | StartMode=0 33 | Unattended=0 34 | Retained=0 35 | ThreadPerObject=0 36 | MaxNumberOfThreads=1 37 | -------------------------------------------------------------------------------- /test/Winsock/Project3.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form3.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 4 | Object={710A6B30-6CD9-4F61-8399-1E51A1E65B86}#2.0#0; WinsockTls.ocx 5 | IconForm="Form2" 6 | Startup="Form2" 7 | HelpFile="" 8 | ExeName32="Project2.exe" 9 | Command32="" 10 | Name="WinsockCompiled" 11 | HelpContextID="0" 12 | CompatibleMode="0" 13 | MajorVer=1 14 | MinorVer=0 15 | RevisionVer=0 16 | AutoIncrementVer=0 17 | ServerSupportFiles=0 18 | VersionCompanyName="Unicontsoft" 19 | CompilationType=0 20 | OptimizationType=0 21 | FavorPentiumPro(tm)=0 22 | CodeViewDebugInfo=0 23 | NoAliasing=0 24 | BoundsCheck=0 25 | OverflowCheck=0 26 | FlPointCheck=0 27 | FDIVCheck=0 28 | UnroundedFP=0 29 | StartMode=0 30 | Unattended=0 31 | Retained=0 32 | ThreadPerObject=0 33 | MaxNumberOfThreads=1 34 | -------------------------------------------------------------------------------- /test/Winsock/cClientCallback.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "cClientCallback" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Public Index As Long 17 | Public Parent As frmRemaster 18 | Public WithEvents Socket As cTlsRemaster 19 | Attribute Socket.VB_VarHelpID = -1 20 | 21 | Private Sub Socket_DataArrival(ByVal bytesTotal As Long) 22 | Parent.OnDataArrival Index, bytesTotal 23 | End Sub 24 | 25 | Private Sub Socket_CloseSck() 26 | Parent.OnCloseSck Index 27 | End Sub 28 | 29 | -------------------------------------------------------------------------------- /test/Winsock/frmRemaster.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmRemaster 3 | Caption = "frmRemaster" 4 | ClientHeight = 2952 5 | ClientLeft = 108 6 | ClientTop = 456 7 | ClientWidth = 3624 8 | LinkTopic = "Form1" 9 | ScaleHeight = 2952 10 | ScaleWidth = 3624 11 | StartUpPosition = 3 'Windows Default 12 | Begin VB.CommandButton Command4 13 | Caption = "HTTPS Server" 14 | Height = 516 15 | Left = 252 16 | TabIndex = 3 17 | Top = 2268 18 | Width = 1524 19 | End 20 | Begin VB.CommandButton Command3 21 | Caption = "HTTPS request" 22 | Height = 516 23 | Left = 252 24 | TabIndex = 2 25 | Top = 1596 26 | Width = 1524 27 | End 28 | Begin VB.CommandButton Command2 29 | Caption = "HTTP Server" 30 | Height = 516 31 | Left = 252 32 | TabIndex = 1 33 | Top = 924 34 | Width = 1524 35 | End 36 | Begin VB.CommandButton Command1 37 | Caption = "HTTP request" 38 | Height = 516 39 | Left = 252 40 | TabIndex = 0 41 | Top = 252 42 | Width = 1524 43 | End 44 | End 45 | Attribute VB_Name = "frmRemaster" 46 | Attribute VB_GlobalNameSpace = False 47 | Attribute VB_Creatable = False 48 | Attribute VB_PredeclaredId = True 49 | Attribute VB_Exposed = False 50 | Option Explicit 51 | 52 | Private WithEvents m_oClient As cTlsRemaster 53 | Attribute m_oClient.VB_VarHelpID = -1 54 | Private WithEvents m_oServer As cTlsRemaster 55 | Attribute m_oServer.VB_VarHelpID = -1 56 | Private m_cConnPool As New Collection 57 | Attribute m_cConnPool.VB_VarHelpID = -1 58 | 59 | Private Sub Command1_Click() 60 | Set m_oClient = New cTlsRemaster 61 | m_oClient.Protocol = RemasterProtocolConstants.sckTCPProtocol 62 | m_oClient.Connect "bgdev.org", 80 63 | End Sub 64 | 65 | Private Sub Command3_Click() 66 | Set m_oClient = New cTlsRemaster 67 | m_oClient.Protocol = RemasterProtocolConstants.sckTLSProtocol 68 | m_oClient.Connect "bgdev.org", 443 69 | End Sub 70 | 71 | Private Sub Command2_Click() 72 | Set m_oServer = New cTlsRemaster 73 | m_oServer.Protocol = RemasterProtocolConstants.sckTCPProtocol 74 | m_oServer.Bind 8088, "127.0.0.1" 75 | m_oServer.Listen 76 | Shell "cmd /c start http://localhost:8088/" 77 | End Sub 78 | 79 | Private Sub Command4_Click() 80 | Set m_oServer = New cTlsRemaster 81 | m_oServer.Protocol = RemasterProtocolConstants.sckTLSProtocol 82 | m_oServer.Bind 8088, "127.0.0.1" 83 | m_oServer.Listen ' CertSubject:="68b5220077de8bbeaed8e1c2540fec6c16b418a8" 84 | Shell "cmd /c start https://localhost:8088/" 85 | End Sub 86 | 87 | Private Sub m_oClient_Connect() 88 | Dim lIdx As Long 89 | 90 | Debug.Print "Connected to " & m_oClient.RemoteHostIP, Timer 91 | m_oClient.SendData "GET / HTTP/1.0" & vbCrLf & _ 92 | "Host: www.bgdev.org" & vbCrLf & _ 93 | "Connection: close" & vbCrLf & vbCrLf 94 | For lIdx = 1 To 5000 95 | m_oClient.SendData String(1000, "a") 96 | Next 97 | End Sub 98 | 99 | Private Sub m_oClient_DataArrival(ByVal bytesTotal As Long) 100 | Dim sBuffer As String 101 | 102 | Debug.Print "DataArrival", bytesTotal 103 | m_oClient.PeekData sBuffer 104 | m_oClient.GetData sBuffer 105 | Debug.Print sBuffer; 106 | End Sub 107 | 108 | Private Sub m_oServer_ConnectionRequest(ByVal requestID As Long) 109 | Dim oCallback As cClientCallback 110 | 111 | Debug.Print "m_oServer_ConnectionRequest, requestID=" & requestID & ", RemoteHostIP=" & m_oServer.RemoteHostIP & ", RemotePort=" & m_oServer.RemotePort, Timer 112 | Set oCallback = New cClientCallback 113 | m_cConnPool.Add oCallback 114 | oCallback.Index = m_cConnPool.Count 115 | Set oCallback.Parent = Me 116 | Set oCallback.Socket = New cTlsRemaster 117 | oCallback.Socket.Accept requestID 118 | Debug.Print "oCallback.Socket.Protocol=" & oCallback.Socket.Protocol 119 | End Sub 120 | 121 | Public Sub OnDataArrival(Index As Long, ByVal bytesTotal As Long) 122 | Dim sRequest As String 123 | Dim vSplit As Variant 124 | Dim sBody As String 125 | Dim oCallback As cClientCallback 126 | 127 | Set oCallback = m_cConnPool.Item(Index) 128 | Debug.Print "OnDataArrival, Index=" & Index & ", bytesTotal=" & bytesTotal, Timer 129 | oCallback.Socket.GetData sRequest 130 | vSplit = Split(sRequest, vbCrLf) 131 | If UBound(vSplit) >= 0 Then 132 | Debug.Print vSplit(0) 133 | sBody = "" & Join(vSplit, "
" & vbCrLf & "" & Index & ": ") & "
" & vbCrLf & _ 134 | "" & Index & ": Current time is " & Now & "
" & _ 135 | "" & Index & ": RemoteHostIP is " & oCallback.Socket.RemoteHostIP & "
" & vbCrLf & _ 136 | "" & Index & ": RemotePort is " & oCallback.Socket.RemotePort & "
" & vbCrLf & _ 137 | "" & vbCrLf 138 | oCallback.Socket.SendData "HTTP/1.1 200 OK" & vbCrLf & _ 139 | "Content-Type: text/html" & vbCrLf & _ 140 | "Content-Length: " & Len(sBody) & vbCrLf & vbCrLf & _ 141 | sBody 142 | End If 143 | Debug.Print "OnDataArrival, Index=" & Index & ", done", Timer 144 | End Sub 145 | 146 | Public Sub OnCloseSck(Index As Long) 147 | m_cConnPool.Remove Index 148 | If m_cConnPool.Count >= Index Then 149 | m_cConnPool.Add Nothing, Before:=Index 150 | End If 151 | Do While m_cConnPool.Count > 0 152 | If Not m_cConnPool.Item(m_cConnPool.Count) Is Nothing Then 153 | Exit Do 154 | End If 155 | m_cConnPool.Remove m_cConnPool.Count 156 | Loop 157 | End Sub 158 | 159 | 'Private Sub m_oClient_Error(ByVal Number As Long, Description As String, ByVal sCode As UcsErrorConstants, Source As String, HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 160 | ' MsgBox Description & " &H" & Hex$(Number) & " [" & Source & "]", vbCritical, "m_oClient_Error" 161 | 'End Sub 162 | 163 | 'Private Sub m_oServer_Error(Index As Integer, ByVal Number As Long, Description As String, ByVal sCode As UcsErrorConstants, Source As String, HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 164 | ' MsgBox Description & " &H" & Hex$(Number) & " [" & Source & "]", vbCritical, "m_oServer(" & Index & ")_Error" 165 | 'End Sub 166 | 167 | --------------------------------------------------------------------------------