VFB_网络测试

'--------------------------------------------------------------------------------
Sub Form1_Command1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Dim aa As Long
   Dim hostname As String
   Dim path As String
   Dim ip As UInteger
   Dim s As SOCKET
   Dim sa As sockaddr_in
   Dim sendbuffer As String
   Dim recvbuffer As String
   Dim tob As String
   Dim bytes As Integer
   Dim duiko As Long
   '初始化WinSock
   aa = doInit()
   If aa Then
      text2.text = "初始化 WinSock 失败！！" & Str(aa)
      Return
   End If  
   '获取主机名
   'gethostname(@HostName,256)
   'tob= "主机名: " & HostName
   '获取主机信息
   'sHostEnt=gethostbyname(@HostName)
   '检查网址
   tob = Trim(text1.text)
   If Left(LCase(tob), 7) = "http://" Then
      tob = Mid(tob, 8)
      duiko = 80
   ElseIf Left(LCase(tob), 8) = "https://" Then
      tob = Mid(tob, 9)
      duiko = 80
   Else
      duiko = 80
   End If
   Cls
   Print Time & " 端口：" & duiko
   getHostAndPath(tob, hostname, path)
   If (Len(hostname) = 0) Then
      text2.text = "网址无效" & Chr(13, 10) & text1.text
      Return
   End If
   Print Time & " 域名：" & hostname
   Print Time & " 路径：" & path
   '解决名称
   'Print hostname
   ip = resolveHost(hostname)
   If (ip = 0) Then
      text2.text = "网址不能转换成IP" & Chr(13, 10) & hostname
      Return
   End If
   Print Time & " 数字IP：" & ip
   '' 打开 socket
   Print Time & " 打开 socket" & ip
   s = opensocket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
   'af为协议地址族,这里我们使用IPv4,必须为AF_INET
   'type为socket类型,如果使用TCP/IP,type设为SOCK_STREAM,如果使用UDP,则为SOCK_DGRAM
   'protocol在给定的地址族及socket类型有多个入口的情况下用来限定特定的传输,对于TCP其值为IPPROTO_TCP,而UDP则为IPPROTO_UDP
   If (s = 0) Then
      reportError("打开socket")
      Return
   End If
   '' 连接到主机
   sa.sin_port = htons(duiko)
   sa.sin_family = AF_INET
   sa.sin_addr.S_addr = ip
   Print Time & " 连接到主机", ip
   If (connect(s, Cast(PSOCKADDR, @sa), SizeOf(sa)) = SOCKET_ERROR) Then
      reportError("连接到主机connect()")
      closesocket(s) '关闭socket
      Return
   End If
   '' send HTTP 请求
   sendBuffer = "GET /" + path + " HTTP/1.0" + Chr(13, 10) + _
      "Host: " + hostname + Chr(13, 10) + _
      "Connection: close" + Chr(13, 10) + _
      "User-Agent: GetHTTP 0.0" + Chr(13, 10) + _
      Chr(13, 10)
   Print Time & " HTTP 请求:" & sendBuffer
   If (send(s, sendBuffer, Len(sendBuffer), 0) = SOCKET_ERROR) Then
      reportError("HTTP 请求 send()")
      closesocket(s)
      Return
   End If
   '' 接收直到连接关闭
   Print Time & " 接收直到连接关闭"
   Dim by(4097) As Byte
   tob = ""
   'recvbuffer=String(4096,0)
   Do
      bytes = recv(s, @by(0), 4096, 0)
      If (bytes <= 0) Then
         Exit Do
      End If
      recvbuffer = String(bytes, 0)
      memcpy SAdd(recvbuffer), @by(0), bytes
      'Peek(String,@by(0))
      tob + = Left(recvbuffer, bytes)
      '' 打印缓冲区作为字符串
      'Print *recvbuffer
   Loop
   Print Time & "完成"
   If Check1.Value Then
      tob = Utf8toStr(tob)
   End If
   'AfxMsg(Hex(StrPtr(tob)))
   text2.text = tob
   shutdown(s, 2) '关闭socket
   closesocket(s) '关闭socket
   WSACleanup '释放
End Sub
Sub reportError(ByRef msg As String) '显示错误
   text2.text = "发生错误：" & msg & Chr(13, 10) & ": error #" & WSAGetLastError()
End Sub
Function doInit() As Long  '初始化
   '' init winsock
   Dim wsaData As WSAData
   Return WSAStartup(MAKEWORD(1, 1), @wsaData)
End Function
Sub getHostAndPath(ByRef src As String, ByRef hostname As String, ByRef path As String)
   '分离网址与路径
   Dim p As Integer = InStr(src, "/")
   If p = 0 Then
      hostname = Trim(src)
      path = ""
   Else
      hostname = Trim(Left(src, p - 1))
      path = Trim(Mid(src, p + 1))
   End If
End Sub
'======================================================
Function Unicodetoutf8(ByVal Pswzunicode As WString Ptr) As String
   Dim Sutf8 As String
   Sutf8 = String(Len( * Pswzunicode), 0)
   WideCharToMultiByte(Cp_utf8, _                 '设为 Utf-8
      0, _                       '转换类型
      Cast(Lpcwstr, Pswzunicode), _  '原始的unicode字符串
      Len( * Pswzunicode), _       'Unicode 字符串长度
      Cast(Lpstr, StrPtr(Sutf8)), _     'utf-8 字符串
      Len(Sutf8), _              'utf-8长度
      ByVal 0, _
      ByVal 0)
   Function = Sutf8
End Function
'Function A2W(ZStrPtr as ZString Ptr, ZStrLen as UInteger = 0) as Any Ptr
   'If ZStrPtr Then
   'If ZStrLen = 0 Then
   'ZStrLen = Strlen(ZStrPtr)
   'EndIf
   'Dim WStrLen as Integer = MultiByteToWideChar(CP_ACP, 0, ZStrPtr, ZStrLen, Null, 0)
   'Dim WStrMem as WString Ptr = xRtl.TempMemory((WStrLen + 1) * SizeOf(WString))
   'MultiByteToWideChar(CP_ACP, 0, ZStrPtr, ZStrLen, WStrMem, WStrLen)
   'WStrMem[WStrLen] = 0
   'Return WStrMem
   'EndIf
   'End Function
   '
   'Function W2U(WStrPtr as WString Ptr, WStrLen as UInteger = 0) as Any Ptr
   'If WStrPtr Then
   'If WStrLen = 0 Then
   'WStrLen = wcslen(WStrPtr)
   'EndIf
   'Dim UTF8Len as Integer = WideCharToMultiByte(CP_UTF8, 0, WStrPtr, WStrLen, Null, 0, Null, Null)
   'Dim UTF8Mem as ZString Ptr = xRtl.TempMemory(UTF8Len + 1)
   'WideCharToMultiByte(CP_UTF8, 0, WStrPtr, WStrLen, UTF8Mem, UTF8Len, Null, Null)
   'UTF8Mem[UTF8Len] = 0
   'Return UTF8Mem
   'EndIf
   'End Function
   '
   'Function U2W(UTF8Ptr as ZString Ptr,UTF8Len as UInteger = 0) as Any Ptr
   'If UTF8Ptr Then
   'If UTF8Len = 0 Then
   'UTF8Len = Strlen(UTF8Ptr)
   'EndIf
   'Dim WStrLen as Integer = MultiByteToWideChar(CP_UTF8, 0, UTF8Ptr, UTF8Len, Null, 0)
   'Dim WStrMem as WString Ptr = xRtl.TempMemory((WStrLen + 1) * SizeOf(WString))
   'MultiByteToWideChar(CP_UTF8, 0, UTF8Ptr, UTF8Len, WStrMem, WStrLen)
   'WStrMem[WStrLen] = 0
   'Return WStrMem
   'EndIf
   'End Function
   '
   'Function A2U(ZStr as ZString Ptr, ZLen as UInteger = 0) as ZString Ptr
   'If ZStr Then
   'Dim TempMem as Any Ptr = A2W(ZStr, ZLen)
   'Return W2U(TempMem, 0)
   'EndIf
   'End Function
   '
   'Function U2A(UStr as ZString Ptr,ULen as UInteger = 0) as ZString Ptr
   'If UStr Then
   'Dim TempMem as Any Ptr = U2W(UStr, ULen)
   'Return W2A(TempMem, 0)
   'EndIf
   'End Function
   '
   'Function A2W_C(ZStrPtr as ZString Ptr, ZStrLen as UInteger = 0) as Any Ptr
   'If ZStrPtr Then
   'If ZStrLen = 0 Then
   'ZStrLen = Strlen(ZStrPtr)
   'EndIf
   'Dim WStrLen as Integer = MultiByteToWideChar(CP_ACP, 0, ZStrPtr, ZStrLen, Null, 0)
   'Dim WStrMem as WString Ptr = Allocate((WStrLen + 1) * SizeOf(WString))
   'MultiByteToWideChar(CP_ACP, 0, ZStrPtr, ZStrLen, WStrMem, WStrLen)
   'WStrMem[WStrLen] = 0
   'Return WStrMem
   'EndIf
   'End Function
   '
   'Function W2A_C(WStrPtr as WString Ptr, WStrLen as UInteger = 0) as Any Ptr
   'If WStrPtr Then
   'If WStrLen = 0 Then
   'WStrLen = wcslen(WStrPtr)
   'EndIf
   'Dim ZStrLen as Integer = WideCharToMultiByte(CP_ACP, 0, WStrPtr, WStrLen, Null, 0, Null, Null)
   'Dim ZStrMem as ZString Ptr = Allocate(ZStrLen + 1)
   'WideCharToMultiByte(CP_ACP, 0, WStrPtr, WStrLen, ZStrMem, ZStrLen, Null, Null)
   'ZStrMem[ZStrLen] = 0
   'Return ZStrMem
   'EndIf
   'End Function
   '
   'Function W2U_C(WStrPtr as WString Ptr, WStrLen as UInteger = 0) as Any Ptr
   'If WStrPtr Then
   'If WStrLen = 0 Then
   'WStrLen = wcslen(WStrPtr)
   'EndIf
   'Dim UTF8Len as Integer = WideCharToMultiByte(CP_UTF8, 0, WStrPtr, WStrLen, Null, 0, Null, Null)
   'Dim UTF8Mem as ZString Ptr = Allocate(UTF8Len + 1)
   'WideCharToMultiByte(CP_UTF8, 0, WStrPtr, WStrLen, UTF8Mem, UTF8Len, Null, Null)
   'UTF8Mem[UTF8Len] = 0
   'Return UTF8Mem
   'EndIf
   'End Function
   '
   'Function U2W_C(UTF8Ptr as ZString Ptr,UTF8Len as UInteger = 0) as Any Ptr
   'If UTF8Ptr Then
   'If UTF8Len = 0 Then
   'UTF8Len = Strlen(UTF8Ptr)
   'EndIf
   'Dim WStrLen as Integer = MultiByteToWideChar(CP_UTF8, 0, UTF8Ptr, UTF8Len, Null, 0)
   'Dim WStrMem as WString Ptr = Allocate((WStrLen + 1) * SizeOf(WString))
   'MultiByteToWideChar(CP_UTF8, 0, UTF8Ptr, UTF8Len, WStrMem, WStrLen)
   'WStrMem[WStrLen] = 0
   'Return WStrMem
   'EndIf
   'End Function
   '
   'Function A2U_C(ZStr as ZString Ptr, ZLen as UInteger = 0) as ZString Ptr
   'If ZStr Then
   'Dim TempMem as Any Ptr = A2W(ZStr, ZLen)
   'Return W2U_C(TempMem, 0)
   'EndIf
   'End Function
   '
   'Function U2A_C(UStr as ZString Ptr,ULen as UInteger = 0) as ZString Ptr
   'If UStr Then
   'Dim TempMem as Any Ptr = U2W(UStr, ULen)
   'Return W2A_C(TempMem, 0)
   'EndIf
   'End Function
   Sub Form1_Shown(hWndForm As hWnd, UserData As Integer)  '窗口完全显示后。UserData 来自显示窗口最后1个参数。
      
End Sub