📄 myproxy.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form myproxy
BorderStyle = 1 'Fixed Single
Caption = "简单得HTTP代理服务器"
ClientHeight = 5100
ClientLeft = 45
ClientTop = 330
ClientWidth = 6660
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
LinkTopic = "Form2"
MaxButton = 0 'False
ScaleHeight = 340
ScaleMode = 3 'Pixel
ScaleWidth = 444
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtLog
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 3735
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 480
Width = 6375
End
Begin VB.CommandButton Command2
Caption = "停止服务"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3000
TabIndex = 1
Top = 4440
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "启动服务"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1800
TabIndex = 0
Top = 4440
Width = 1215
End
Begin MSWinsockLib.Winsock insocket
Index = 0
Left = 480
Top = 4320
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock outsocket
Index = 0
Left = 1080
Top = 4320
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label1
Caption = "简单代理服务器"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 3
Top = 120
Width = 1455
End
End
Attribute VB_Name = "myproxy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public blnManagingData As Boolean
Public blnNewConnection As Boolean
Public socketNum As Integer
Public Sub addLog(strEvent, intEventType)
'象文本框加入信息
With myproxy.txtLog
.Text = .Text & Date$ & " " & Time$ & " " & strEvent & vbCrLf
.SelStart = Len(.Text)
End With
End Sub
Private Sub Command1_Click()
On Error Resume Next
insocket(0).LocalPort = 6666
insocket(0).Listen
addLog "开始启动服务，端口是6666。", 0
End Sub
Private Sub Command2_Click()
On Error Resume Next
insocket(0).Close
outsocket(0).Close
addLog "停止服务。", 0
End Sub
Private Sub Form_Load()
addLog "程序启动，欢迎使用本代理", 0
End Sub
Private Sub insocket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'如果收到连接请求，接受
'insocket(0).Close
blnNewConnection = True
socketNum = socketNum + 1
Load insocket(socketNum)
Load outsocket(socketNum)
' Debug.Print Index '& "connect insock"
' Debug.Print Index '& "socketNum insock"
insocket(socketNum).Accept requestID
addLog "接收连接来自于 " & insocket(0).RemoteHostIP, 0
End Sub
Private Sub insocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'改子程序等待浏览器发送HTTP请求头
'当所有必须的信息获得以后，连接到真正的目的服务器，然后传送
'请求头信息
'错误处理
On Error Resume Next
'变量声名
Static strInBuffer As String '接受缓冲区
Static blnHeaderRead As Boolean '是否读HTTP头
Dim strDataReceived As String '已经获得的数据
Dim strDestinationHost As String '目标主机
Dim strDestinationPort As String '目标端口
Dim intPos As Integer, intPos2 As Integer '字符串位置
'通知其他程序，数据已经被处理
blnManagingData = True
'如果是新连接，重新设置缓冲区和
If blnNewConnection Then
strInBuffer = ""
strDestinationHost = ""
strDestinationPort = ""
blnHeaderRead = False
blnNewConnection = False
End If
'获取数据
insocket(Index).GetData strDataReceived
Debug.Print strDataReceived
'如果HTTP头完成，然后进行外部连接
'然后退出
If blnHeaderRead Then
outsocket(Index).SendData strDataReceived
Exit Sub
End If
'把数据放入缓冲区
strInBuffer = strInBuffer & strDataReceived
'从请求头信息中获取远处计算机的主机地址
intPos = InStr(strInBuffer, "Host: ")
If intPos > 0 Then
intPos = intPos + Len("Host: ")
intPos2 = InStr(intPos + 1, strInBuffer, vbCrLf)
If intPos2 > 0 Then
'如果查到主机地址，然后获得端口号
'默认的端口是80
strDestinationHost = Mid$(strInBuffer, intPos, intPos2 - intPos)
intPos = InStr(strDestinationHost, ":")
If intPos > 0 Then
strDestinationPort = Int(Right$(strDestinationHost, Len(strDestinationHost) - intPos + 1))
strDestinationHost = Left$(strDestinationHost, intPos - 1)
Else
strDestinationPort = 80
End If
addLog "连接到" & strDestinationHost & ":" & strDestinationPort, 0
'打开外部连接
' MsgBox "连接到:" & strDestinationHost & " 站点"
' MsgBox "连接到:" & strDestinationHost & " 站点"
outsocket(Index).Connect strDestinationHost, strDestinationPort
'等待连接成功
While outsocket(Index).State <> sckConnected
DoEvents
Wend
'发送目前缓冲区的信息
outsocket(Index).SendData strInBuffer
'表示头信息已经被阅读
blnHeaderRead = True
End If
End If
'通知其他程序表示已经完成
blnManagingData = False
End Sub
Private Sub outsocket_Close(Index As Integer)
On Error Resume Next
addLog "外部连接关闭", 0
While blnManagingData
DoEvents
Wend
DoEvents
'insocket(Index).Close
Debug.Print Index & "关闭"
End Sub
Private Sub outsocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'接受外部数据
'然后把数据传送给请求的客户
On Error Resume Next
Dim strDataReceived As String
outsocket(Index).GetData strDataReceived
insocket(Index).SendData strDataReceived
End Sub
'出现错误，关闭连接
Private Sub outsocket_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next
addLog "外部连接关闭", 0
DoEvents
' insocket(Index).Close
'insocket(Index).Listen
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -