VB6做聊天系统出错

li_yuan_fang( 2016-02-17 08:40:56
每次打开那个叫做频道的窗口就显示35764错误，以下为频道窗口的代码
Private Sub Command1_Click()

Open App.Path & "\" & Label2.Caption & ".html" For Output As #1

Print #1, 登录.Text1.Text & "：" & Text1.Text

Close #1

Inet1.URL = "59.53.63.33"

Inet1.Protocol = 2

Inet1.UserName = "xiaowenwen"

Inet1.PassWord = "xiaowenwen"

Inet1.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html"

Do While Inet1.StillExecuting

DoEvents

Loop

Shell "cmd.exe /k & @echo off & del " & App.Path & "\" & Label2.Caption & ".html"

End Sub



Private Sub Command2_Click()

Open App.Path & "\" & Label2.Caption & ".html" For Output As #1

Print #1, "公告：" & Text1.Text

Close #1

Inet1.URL = "59.53.63.33"

Inet1.Protocol = 2

Inet1.UserName = "xiaowenwen"

Inet1.PassWord = "xiaowenwen"

Inet1.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html"

Do While Inet1.StillExecuting

DoEvents

Loop

Shell "cmd.exe /k & @echo off & del " & App.Path & "\" & Label2.Caption & ".html"

End Sub



Private Sub Form_Load()

If Val(登录.Text1.Text) = Val(Inet1.OpenURL("http://xiaowenwen.w16.i93133.com/Owner/" & Label2.Caption & ".html")) Then Command2.Visible = True

Open App.Path & "\Login.key" For Input As #1

Do While Not EOF(1)

Line Input #1, Nextline

Label2.Caption = Nextline

频道.Caption = "小文文畅聊 -频道 " & Nextline & " 群主：" & Val(Inet1.OpenURL("http://xiaowenwen.w16.i93133.com/Owner/" & Label2.Caption & ".html"))

Loop

Close #1

End Sub





Private Sub Timer1_Timer()

Label1.Caption = Inet1.OpenURL("http://xiaowenwen.w16.i93133.com/msg/" & Label2.Caption & ".html")

If Val(Label1.Caption) = Val(Label2.Caption) Then

Else

List1.AddItem Label1.Caption

Label2.Caption = Label1.Caption

End If

End Sub

经过调试，发现是这行代码出了问题，求解
Label1.Caption = Inet1.OpenURL("http://xiaowenwen.w16.i93133.com/msg/" & Label2.Caption & ".html")

源码：http://pan.baidu.com/s/1pJV3zh5 密码:2wuc
...全文
2642 19 打赏 收藏 转发到动态 举报
写回复
用AI写文章
19 条回复
切换为时间正序
请发表友善的回复…
发表回复
wq1282 2017-04-05
  • 打赏
  • 举报
 回复
只能表示，楼主还有很长的路要走！
前面人家说的 socket 就是 VB6 做聊天软件 的最佳方案了！
用网页做中间传输，也就只是玩玩而已，还走的是弯路！！！
vansoft 2016-03-01
  • 打赏
  • 举报
 回复
服了。真服了。雷锋啊。
一笑拔剑 2016-02-25
  • 打赏
  • 举报
 回复
我好服啊, 也只有你适合赵四他教了 你继续
赵4老师 2016-02-19
  • 打赏
  • 举报
 回复
对电脑而言没有乱码，只有二进制字节；对人脑才有乱码。啊 GBK:0xB0 0xA1,Unicode-16 LE:0x4A 0x55,Unicode-16 BE:0x55 0x4A,UTF-8:0xE5 0x95 0x8A 仅供参考：
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
'常用的代码页：
const cpUTF8   =65001
const cpGB2312 =  936
const cpGB18030=54936
const cpUTF7   =65000
Function MultiByteToUTF16(UTF8() As Byte, CodePage As Long) As String
    Dim bufSize As Long
    bufSize = MultiByteToWideChar(CodePage, 0&, UTF8(0), UBound(UTF8) + 1, 0, 0)
    MultiByteToUTF16 = Space(bufSize)
    MultiByteToWideChar CodePage, 0&, UTF8(0), UBound(UTF8) + 1, StrPtr(MultiByteToUTF16), bufSize
End Function

Function UTF16ToMultiByte(UTF16 As String, CodePage As Long) As Byte()
    Dim bufSize As Long
    Dim arr() As Byte
    bufSize = WideCharToMultiByte(CodePage, 0&, StrPtr(UTF16), Len(UTF16), 0, 0, 0, 0)
    ReDim arr(bufSize - 1)
    WideCharToMultiByte CodePage, 0&, StrPtr(UTF16), Len(UTF16), arr(0), bufSize, 0, 0
    UTF16ToMultiByte = arr
End Function

Private Sub Command1_Click()
    MsgBox MultiByteToUTF16(UTF16ToMultiByte("ab中,c", cpUTF8), cpUTF8)
End Sub
li_yuan_fang( 2016-02-19
  • 打赏
  • 举报
 回复
引用 11 楼 zhao4zhong1 的回复:
仅供参考：
Private Sub Command1_Click()
Dim strURL As String
Dim strlist As String
Dim strtitle As String
Dim i As Integer
Dim j As Integer
Dim t As String
Dim m As Integer
Dim n As Integer
Dim after As Double
On Error GoTo CCERR
    Command1.Enabled = False
    strURL = "http://www.xajh.com/DynaNews/SerialTitle.asp?site=1"
    strlist = Inet1.OpenURL(strURL, icString)
    Do
        i = InStr(strlist, "seriallist.asp?site=")
        If i > 0 Then
            strlist = Mid(strlist, i + 20)
            j = InStr(strlist, "'>")
            t = Mid(strlist, 1, j - 1)
            Debug.Print t
            strlist = Mid(strlist, j + 2)
            j = InStr(strlist, "<")
            Debug.Print Mid(strlist, 1, j - 1)
            strlist = Mid(strlist, j + 1)

            after = Now + 10# / 24# / 3600#
            Do
                DoEvents
                If Now > after Then Exit Do
            Loop
            strURL = "http://www.xajh.com/DynaNews/SerialTitle.asp?site=" & t
            strtitle = Inet1.OpenURL(strURL, icString)
            Do
                m = InStr(strtitle, "BoardList'>")
                If m > 0 Then
                    strtitle = Mid(strtitle, m + 11)
                    n = InStr(strtitle, "<")
                    Debug.Print Mid(strtitle, 1, n - 1)
                    strtitle = Mid(strtitle, n + 1)
                Else
                    Exit Do
                End If
            Loop
        Else
            Exit Do
        End If
    Loop
    Command1.Enabled = True
    Exit Sub
CCERR:
    Debug.Print "Err.Number="; Err.Number
    after = Now + 10# / 24# / 3600#
    Do
        DoEvents
        If Now > after Then Exit Do
    Loop
    Resume
End Sub

Private Sub Command2_Click()
'很多 World Wide Web 站点提供了搜索数据库的能力。
'它是通过 HTTP 协议用通用网关接口 (CGI) 发送查询的能力完成的。
'在这里不再讨论 CGI 了。
'然而，如果对 CGI 比较了解，就可用 Execute 方法构造一个应用程序
'模拟 World Wide Web 站点的行为。
'例如，下面的代码给出了典型的 CGI 查询字符串：
' http://www.webunion.com/cgi-localbin/bserve.cgi?win8711
' http://www.yippee.com/cgi-bin/find.exe?find=Hangzhou

'如下所示，用 Execute 方法也可以发送同样的查询：
Dim strURL As String, strFormData As String
strURL = "http://www.xajh.com/dynanews/seriallist.asp?site=12"
'strURL = "http://www.xajh.com/xajh/0bar0.gif"
'strFormData = "win8711"
'strURL = "//www.yippee.com/cgi-bin/find.exe"
'strFormData = "find=Hangzhou"
Inet1.Protocol = icHTTP
Inet1.Execute strURL, "GET"

'如果希望得到从服务器发回的结果（如上面的示例所示），
'就必须使用 GetChunk 方法以获取作为结果的 HTML 文档。
    Command2.Enabled = False
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim intFile As Integer
Dim vtData() As Byte
Debug.Print State
    Select Case State
    Case icResponseCompleted '12
    Debug.Print "len="; Inet1.GetHeader("Content-length")
    Debug.Print "typ="; Inet1.GetHeader("Content-type")
        intFile = FreeFile()
        Open "c:\temp\www.gif" For Binary Access Write As #intFile
        vtData() = Inet1.GetChunk(2048, icByteArray)
        Do While LenB(CStr(vtData())) > 0
            Put #intFile, , vtData()
            vtData() = Inet1.GetChunk(2048, icByteArray)
        Loop
        Put #intFile, , vtData()
        Close #intFile
        Command2.Enabled = True
    End Select
End Sub
我改了下代码，可以用了，但是经常会出现乱码，怎么办 
Private Sub Command1_Click()
Open App.Path & "\" & Label2.Caption & ".html" For Output As #1
Print #1, 登录.Text1.Text & "：" & Text1.Text
Close #1
Inet3.URL = "59.53.63.33"
Inet3.Protocol = 2
Inet3.UserName = "xiaowenwen"
Inet3.PassWord = "xiaowenwen"
Inet3.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html"
Do While Inet3.StillExecuting
DoEvents
Loop
Shell "cmd.exe /k & @echo off & del " & App.Path & "\" & Label2.Caption & ".html"
End Sub

Private Sub Command2_Click()
Open App.Path & "\" & Label2.Caption & ".html" For Output As #1
Print #1, "公告：" & Text1.Text
Close #1
Inet3.URL = "59.53.63.33"
Inet3.Protocol = 2
Inet3.UserName = "xiaowenwen"
Inet3.PassWord = "xiaowenwen"
Inet3.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html"
Do While Inet3.StillExecuting
DoEvents
Loop
Shell "cmd.exe /k & @echo off & del " & App.Path & "\" & Label2.Caption & ".html"
End Sub

Private Sub Form_Load()
If Val(登录.Text1.Text) = Val(Inet1.OpenURL("http://xiaowenwen.w16.i93133.com/Owner/" & Label2.Caption & ".html")) Then Command2.Visible = True
Open App.Path & "\Login.key" For Input As #1
Do While Not EOF(1)
Line Input #1, Nextline
Label2.Caption = Nextline
频道.Caption = "小文文畅聊 -频道 " & Nextline & " 群主：" & Val(Inet1.OpenURL("http://xiaowenwen.w16.i93133.com/Owner/" & Label2.Caption & ".html"))
Loop
Close #1
End Sub


Private Sub Timer1_Timer()
Label1.Caption = Inet2.OpenURL("http://xiaowenwen.w16.i93133.com/msg/" & Label2.Caption & ".html")
If Label1.Caption = Label5.Caption Then
Else
List1.AddItem Label1.Caption
Label5.Caption = Label1.Caption
End If
End Sub
赵4老师 2016-02-19
  • 打赏
  • 举报
 回复
《http权威指南》
li_yuan_fang( 2016-02-19
  • 打赏
  • 举报
 回复
引用 13 楼 zhao4zhong1 的回复:
对电脑而言没有乱码，只有二进制字节；对人脑才有乱码。啊 GBK:0xB0 0xA1,Unicode-16 LE:0x4A 0x55,Unicode-16 BE:0x55 0x4A,UTF-8:0xE5 0x95 0x8A

仅供参考：
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long

'常用的代码页：

const cpUTF8   =65001

const cpGB2312 =  936

const cpGB18030=54936

const cpUTF7   =65000

Function MultiByteToUTF16(UTF8() As Byte, CodePage As Long) As String

    Dim bufSize As Long

    bufSize = MultiByteToWideChar(CodePage, 0&, UTF8(0), UBound(UTF8) + 1, 0, 0)

    MultiByteToUTF16 = Space(bufSize)

    MultiByteToWideChar CodePage, 0&, UTF8(0), UBound(UTF8) + 1, StrPtr(MultiByteToUTF16), bufSize

End Function



Function UTF16ToMultiByte(UTF16 As String, CodePage As Long) As Byte()

    Dim bufSize As Long

    Dim arr() As Byte

    bufSize = WideCharToMultiByte(CodePage, 0&, StrPtr(UTF16), Len(UTF16), 0, 0, 0, 0)

    ReDim arr(bufSize - 1)

    WideCharToMultiByte CodePage, 0&, StrPtr(UTF16), Len(UTF16), arr(0), bufSize, 0, 0

    UTF16ToMultiByte = arr

End Function



Private Sub Command1_Click()

    MsgBox MultiByteToUTF16(UTF16ToMultiByte("ab中,c", cpUTF8), cpUTF8)

End Sub

不过很有可能是服务器的问题，但好像又不是

这是图片，有些行会出现那些代码
li_yuan_fang( 2016-02-19
  • 打赏
  • 举报
 回复
引用 13 楼 zhao4zhong1 的回复:
对电脑而言没有乱码，只有二进制字节；对人脑才有乱码。啊 GBK:0xB0 0xA1,Unicode-16 LE:0x4A 0x55,Unicode-16 BE:0x55 0x4A,UTF-8:0xE5 0x95 0x8A 仅供参考：
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
'常用的代码页：
const cpUTF8   =65001
const cpGB2312 =  936
const cpGB18030=54936
const cpUTF7   =65000
Function MultiByteToUTF16(UTF8() As Byte, CodePage As Long) As String
    Dim bufSize As Long
    bufSize = MultiByteToWideChar(CodePage, 0&, UTF8(0), UBound(UTF8) + 1, 0, 0)
    MultiByteToUTF16 = Space(bufSize)
    MultiByteToWideChar CodePage, 0&, UTF8(0), UBound(UTF8) + 1, StrPtr(MultiByteToUTF16), bufSize
End Function

Function UTF16ToMultiByte(UTF16 As String, CodePage As Long) As Byte()
    Dim bufSize As Long
    Dim arr() As Byte
    bufSize = WideCharToMultiByte(CodePage, 0&, StrPtr(UTF16), Len(UTF16), 0, 0, 0, 0)
    ReDim arr(bufSize - 1)
    WideCharToMultiByte CodePage, 0&, StrPtr(UTF16), Len(UTF16), arr(0), bufSize, 0, 0
    UTF16ToMultiByte = arr
End Function

Private Sub Command1_Click()
    MsgBox MultiByteToUTF16(UTF16ToMultiByte("ab中,c", cpUTF8), cpUTF8)
End Sub
研究了一下，好像是网页的代码，好像是404页的 每次收到消息，都会先发出这段网页的代码
赵4老师 2016-02-18
  • 打赏
  • 举报
 回复
Inet3.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html" Do While Inet3.StillExecuting DoEvents Loop
li_yuan_fang( 2016-02-18
  • 打赏
  • 举报
 回复
引用 5 楼 SupermanKing 的回复:
这叫"VB6做聊天系统"? 你太搞笑了吧，呵呵。 按部就班吧，看看基础教程，学点ui编程，学点winsock控件使用，以后再去看看socket api，之后再去看看p2p的范例。 这样才对路子。
Winsock试过好多遍了，映射也不行，而且风险性大，所以我才用.net的
现在还是人类 2016-02-18
  • 打赏
  • 举报
 回复
这叫"VB6做聊天系统"? 你太搞笑了吧，呵呵。 按部就班吧，看看基础教程，学点ui编程，学点winsock控件使用，以后再去看看socket api，之后再去看看p2p的范例。 这样才对路子。
赵4老师 2016-02-18
  • 打赏
  • 举报
 回复
仅供参考：
Private Sub Command1_Click()
Dim strURL As String
Dim strlist As String
Dim strtitle As String
Dim i As Integer
Dim j As Integer
Dim t As String
Dim m As Integer
Dim n As Integer
Dim after As Double
On Error GoTo CCERR
    Command1.Enabled = False
    strURL = "http://www.xajh.com/DynaNews/SerialTitle.asp?site=1"
    strlist = Inet1.OpenURL(strURL, icString)
    Do
        i = InStr(strlist, "seriallist.asp?site=")
        If i > 0 Then
            strlist = Mid(strlist, i + 20)
            j = InStr(strlist, "'>")
            t = Mid(strlist, 1, j - 1)
            Debug.Print t
            strlist = Mid(strlist, j + 2)
            j = InStr(strlist, "<")
            Debug.Print Mid(strlist, 1, j - 1)
            strlist = Mid(strlist, j + 1)

            after = Now + 10# / 24# / 3600#
            Do
                DoEvents
                If Now > after Then Exit Do
            Loop
            strURL = "http://www.xajh.com/DynaNews/SerialTitle.asp?site=" & t
            strtitle = Inet1.OpenURL(strURL, icString)
            Do
                m = InStr(strtitle, "BoardList'>")
                If m > 0 Then
                    strtitle = Mid(strtitle, m + 11)
                    n = InStr(strtitle, "<")
                    Debug.Print Mid(strtitle, 1, n - 1)
                    strtitle = Mid(strtitle, n + 1)
                Else
                    Exit Do
                End If
            Loop
        Else
            Exit Do
        End If
    Loop
    Command1.Enabled = True
    Exit Sub
CCERR:
    Debug.Print "Err.Number="; Err.Number
    after = Now + 10# / 24# / 3600#
    Do
        DoEvents
        If Now > after Then Exit Do
    Loop
    Resume
End Sub

Private Sub Command2_Click()
'很多 World Wide Web 站点提供了搜索数据库的能力。
'它是通过 HTTP 协议用通用网关接口 (CGI) 发送查询的能力完成的。
'在这里不再讨论 CGI 了。
'然而，如果对 CGI 比较了解，就可用 Execute 方法构造一个应用程序
'模拟 World Wide Web 站点的行为。
'例如，下面的代码给出了典型的 CGI 查询字符串：
' http://www.webunion.com/cgi-localbin/bserve.cgi?win8711
' http://www.yippee.com/cgi-bin/find.exe?find=Hangzhou

'如下所示，用 Execute 方法也可以发送同样的查询：
Dim strURL As String, strFormData As String
strURL = "http://www.xajh.com/dynanews/seriallist.asp?site=12"
'strURL = "http://www.xajh.com/xajh/0bar0.gif"
'strFormData = "win8711"
'strURL = "//www.yippee.com/cgi-bin/find.exe"
'strFormData = "find=Hangzhou"
Inet1.Protocol = icHTTP
Inet1.Execute strURL, "GET"

'如果希望得到从服务器发回的结果（如上面的示例所示），
'就必须使用 GetChunk 方法以获取作为结果的 HTML 文档。
    Command2.Enabled = False
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim intFile As Integer
Dim vtData() As Byte
Debug.Print State
    Select Case State
    Case icResponseCompleted '12
    Debug.Print "len="; Inet1.GetHeader("Content-length")
    Debug.Print "typ="; Inet1.GetHeader("Content-type")
        intFile = FreeFile()
        Open "c:\temp\www.gif" For Binary Access Write As #intFile
        vtData() = Inet1.GetChunk(2048, icByteArray)
        Do While LenB(CStr(vtData())) > 0
            Put #intFile, , vtData()
            vtData() = Inet1.GetChunk(2048, icByteArray)
        Loop
        Put #intFile, , vtData()
        Close #intFile
        Command2.Enabled = True
    End Select
End Sub
赵4老师 2016-02-18
  • 打赏
  • 举报
 回复
学会使用抓包软件比如wireshark 《http权威指南》
li_yuan_fang( 2016-02-18
  • 打赏
  • 举报
 回复
引用 7 楼 zhao4zhong1 的回复:
Inet3.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html" Do While Inet3.StillExecuting DoEvents Loop
试过了，消息发送出去了，后台收到了，可是就是客户端收不到
li_yuan_fang( 2016-02-18
  • 打赏
  • 举报
 回复
引用 7 楼 zhao4zhong1 的回复:
Inet3.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html" Do While Inet3.StillExecuting DoEvents Loop
还是收不到，求助QAQ
赵4老师 2016-02-17
  • 打赏
  • 举报
 回复
icExecuting 35764 “还在执行上一个请求” 
 Private Sub Command1_Click()
        Inet1.URL = "http://www.microsoft.com"
        Inet1.Execute , "GET"
        Do While Inet1.StillExecuting
          DoEvents
        Loop
        Inet1.Execute , "GET"
      End Sub


  Private Sub Command1_Click()
          Inet1.Execute "http://www.microsoft.com", "GET"
          'download the start page of microsoft.com
      End Sub
      
      Private Sub Inet1_StateChanged(ByVal State As Integer)
         ' Retrieve server response using the GetChunk
         ' method when State = 12. This example assumes the
         ' data is text.

         Select Case State
         ' ... Other cases not shown.
      
         Case icResponseCompleted ' 12
            Dim vtData As Variant ' Data variable.
            Dim strData As String: strData = ""
            Dim bDone As Boolean: bDone = False
      
            ' Get first chunk.
            vtData = Inet1.GetChunk(1024, icString)
      
            Do While Not bDone
      
               strData = strData & vtData
               ' Get next chunk.
               vtData = Inet1.GetChunk(1024, icString)
               If Len(vtData) = 0 Then
                  bDone = True
               End If
            Loop
      
            MsgBox strData
         End Select

      End Sub
li_yuan_fang( 2016-02-17
  • 打赏
  • 举报
 回复
引用 1 楼 zhao4zhong1 的回复:
icExecuting 35764 “还在执行上一个请求” 
 Private Sub Command1_Click()
        Inet1.URL = "http://www.microsoft.com"
        Inet1.Execute , "GET"
        Do While Inet1.StillExecuting
          DoEvents
        Loop
        Inet1.Execute , "GET"
      End Sub


  Private Sub Command1_Click()
          Inet1.Execute "http://www.microsoft.com", "GET"
          'download the start page of microsoft.com
      End Sub
      
      Private Sub Inet1_StateChanged(ByVal State As Integer)
         ' Retrieve server response using the GetChunk
         ' method when State = 12. This example assumes the
         ' data is text.

         Select Case State
         ' ... Other cases not shown.
      
         Case icResponseCompleted ' 12
            Dim vtData As Variant ' Data variable.
            Dim strData As String: strData = ""
            Dim bDone As Boolean: bDone = False
      
            ' Get first chunk.
            vtData = Inet1.GetChunk(1024, icString)
      
            Do While Not bDone
      
               strData = strData & vtData
               ' Get next chunk.
               vtData = Inet1.GetChunk(1024, icString)
               If Len(vtData) = 0 Then
                  bDone = True
               End If
            Loop
      
            MsgBox strData
         End Select

      End Sub
我还改了下这个页的源码 
Private Sub Command1_Click()
Open App.Path & "\" & Label2.Caption & ".html" For Output As #1
Print #1, 登录.Text1.Text & "：" & Text1.Text
Close #1
Inet3.URL = "59.53.63.33"
Inet3.Protocol = 2
Inet3.UserName = "xiaowenwen"
Inet3.PassWord = "xiaowenwen"
Inet3.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html"
Do While Inet1.StillExecuting
DoEvents
Loop
Shell "cmd.exe /k & @echo off & del " & App.Path & "\" & Label2.Caption & ".html"
End Sub

Private Sub Command2_Click()
Open App.Path & "\" & Label2.Caption & ".html" For Output As #1
Print #1, "公告：" & Text1.Text
Close #1
Inet1.URL = "59.53.63.33"
Inet1.Protocol = 2
Inet1.UserName = "xiaowenwen"
Inet1.PassWord = "xiaowenwen"
Inet1.Execute , "PUT " & App.Path & "\" & Label2.Caption & ".html /wwwroot/msg/" & Label2.Caption & ".html"
Do While Inet1.StillExecuting
DoEvents
Loop
Shell "cmd.exe /k & @echo off & del " & App.Path & "\" & Label2.Caption & ".html"
End Sub

Private Sub Form_Load()
If Val(登录.Text1.Text) = Val(Inet1.OpenURL("http://xiaowenwen.w16.i93133.com/Owner/" & Label2.Caption & ".html")) Then Command2.Visible = True
Open App.Path & "\Login.key" For Input As #1
Do While Not EOF(1)
Line Input #1, Nextline
Label2.Caption = Nextline
频道.Caption = "小文文畅聊 -频道 " & Nextline & " 群主：" & Val(Inet1.OpenURL("http://xiaowenwen.w16.i93133.com/Owner/" & Label2.Caption & ".html"))
Loop
Close #1
End Sub


Private Sub Timer1_Timer()
Label1.Caption = Inet2.OpenURL("http://xiaowenwen.w16.i93133.com/msg/" & Label2.Caption & ".html")
If Val(Label1.Caption) = Val(Label2.Caption) Then
Else
List1.AddItem Label1.Caption
Label2.Caption = Label1.Caption
End If
End Sub
求解收不到的问题，理论上应该是可以的
li_yuan_fang( 2016-02-17
  • 打赏
  • 举报
 回复
引用 1 楼 zhao4zhong1 的回复:
icExecuting 35764 “还在执行上一个请求” 
 Private Sub Command1_Click()
        Inet1.URL = "http://www.microsoft.com"
        Inet1.Execute , "GET"
        Do While Inet1.StillExecuting
          DoEvents
        Loop
        Inet1.Execute , "GET"
      End Sub


  Private Sub Command1_Click()
          Inet1.Execute "http://www.microsoft.com", "GET"
          'download the start page of microsoft.com
      End Sub
      
      Private Sub Inet1_StateChanged(ByVal State As Integer)
         ' Retrieve server response using the GetChunk
         ' method when State = 12. This example assumes the
         ' data is text.

         Select Case State
         ' ... Other cases not shown.
      
         Case icResponseCompleted ' 12
            Dim vtData As Variant ' Data variable.
            Dim strData As String: strData = ""
            Dim bDone As Boolean: bDone = False
      
            ' Get first chunk.
            vtData = Inet1.GetChunk(1024, icString)
      
            Do While Not bDone
      
               strData = strData & vtData
               ' Get next chunk.
               vtData = Inet1.GetChunk(1024, icString)
               If Len(vtData) = 0 Then
                  bDone = True
               End If
            Loop
      
            MsgBox strData
         End Select

      End Sub
顺便再问一下，发现新的错误，发出去的消息收不到，怎么办
li_yuan_fang( 2016-02-17
  • 打赏
  • 举报
 回复
引用 1 楼 zhao4zhong1 的回复:
icExecuting 35764 “还在执行上一个请求” 
 Private Sub Command1_Click()
        Inet1.URL = "http://www.microsoft.com"
        Inet1.Execute , "GET"
        Do While Inet1.StillExecuting
          DoEvents
        Loop
        Inet1.Execute , "GET"
      End Sub


  Private Sub Command1_Click()
          Inet1.Execute "http://www.microsoft.com", "GET"
          'download the start page of microsoft.com
      End Sub
      
      Private Sub Inet1_StateChanged(ByVal State As Integer)
         ' Retrieve server response using the GetChunk
         ' method when State = 12. This example assumes the
         ' data is text.

         Select Case State
         ' ... Other cases not shown.
      
         Case icResponseCompleted ' 12
            Dim vtData As Variant ' Data variable.
            Dim strData As String: strData = ""
            Dim bDone As Boolean: bDone = False
      
            ' Get first chunk.
            vtData = Inet1.GetChunk(1024, icString)
      
            Do While Not bDone
      
               strData = strData & vtData
               ' Get next chunk.
               vtData = Inet1.GetChunk(1024, icString)
               If Len(vtData) = 0 Then
                  bDone = True
               End If
            Loop
      
            MsgBox strData
         End Select

      End Sub
也就是说我要增加1个Inet是吧
毕设源码-VB网络多人聊天系统的设计与实现(论文+源代码).rar
**VB网络多人聊天系统的设计与实现（论文+源代码）** 本资源提供了一个基于VB语言编写的网络多人聊天系统的完整设计文档和源代码。该系统采用了客户端-服务器架构，支持多个用户同时在线进行实时文本通信。系统具有用户注册、登录、添加好友、创建群组、发送私聊及群聊消息等功能，并实现了基本的通信协议和错误处理机制。 论文部分详细介绍了系统的设计思路、关键技术实现以及测试结果分析，为读者提供了从需求分析到系统实现的全过程指导。源代码部分则包含了所有关键模块的详细实现，包括网络通信、用户管理、消息处理等核心功能。 此外，本资源还具有一定的可扩展性和可定制性，开发者可以根据自身需求对系统进行二次开发和定制，以满足不同的应用场景和用户需求。无论是作为学习VB网络编程的实例，还是作为实际应用开发的参考，本资源都具有较高的价值。
VB网络编程实例
◆ 01.htm 1、怎么用mscomm控件检测modem是否与计算机联接正确？2、如何用mscomm挂断modem与别的电话机间的连接？（已接通） ◆ 02.htm CWinInetConnection---一个封装了WinInet API函数的类 ◆ 03.htm MODEM通讯意外处理 ◆ 04.htm MsComm 文字传输 ◆ 05.htm PING一个IP地址(向它发送一个数据包并等待回应) ◆ 06.htm SMTP协议简介 (Simple Mail Transfer Protocol) ◆ 07.htm VB5.0 中远程数据库的访问 ◆ 08.htm VB下如何编写CRC校验程序 ◆ 09.htm VB中Winsock控制的UDP协议的使用 ◆ 10.htm Visual Basic 6中发送邮件的新方法 ◆ 11.htm Visual Basic通信程序设计 ◆ 12.htm Whois 示例程序 ◆ 13.htm Winsock Terminal示例程序 ◆ 14.htm WinSock断开导致客户端问题 ◆ 15.htm 把Outlook信箱中的附件另存为 ◆ 16.htm 保证连网计算机时间同步 ◆ 17.htm 编写网络寻呼机 ◆ 18.htm 编制自已的电话录音小程序 ◆ 19.htm 程序中如何启动默认的拨号连接 ◆ 20.htm 程序中如何启动默认的拨号连接？ ◆ 21.htm 打开器并进入指定网址 ◆ 22.htm 打开一个直接到自己主页的器 ◆ 23.htm 得到用户的IP地址 ◆ 24.htm 电话拨号 ◆ 25.htm 电子邮件的标准格式 (RFC 822) ◆ 26.htm 断开拨号网络的连接 ◆ 27.htm 断开与 Internet 的连接 ◆ 28.htm 发送电子邮件附件 ◆ 29.htm 发送电子邮件附件1 ◆ 30.htm 发送电子邮件附件2 ◆ 31.htm 发送电子邮件附件3 ◆ 32.htm 发送电子邮件附件4 ◆ 33.htm 获得用户网络登录名 ◆ 34.htm 基 于Win95 的VB5 串 口 通 信 程 序 ◆ 35.htm 基于Win95的VB5串口通信程序 ◆ 36.htm 几个设置IE的API ◆ 37.htm 检测运程数据传送的断线 ◆ 38.htm 简单的聊天程序 ◆ 39.htm 简单电子邮件发送程序 ◆ 40.htm 建立拨号联接 ◆ 41.htm 将所有窗口最小化 ◆ 42.htm 利用IE控件访问Internet ◆ 43.htm 利用IE控件设计简易器 ◆ 44.htm 利用Mscomm32控件判断MODEM是否打开，或者正在工作，并且判断拨号时是否遇忙音 ◆ 45.htm 利用TAPI进行电话拨号 ◆ 46.htm 利用VB访问Internet ◆ 47.htm 利用VB设计聊天室 ◆ 48.htm 利用Visual Basic实现无线通讯 ◆ 49.htm 利用Winsock控件实现局域网通信 ◆ 50.htm 强制一个本地或远程NT系统关闭 ◆ 51.htm 取得网卡序列号 ◆ 52.htm 如何从 Internet 上取回某一个网页的內容？ ◆ 53.htm 如何检测是否已连接到Internet？ ◆ 54.htm 如何利用Winsock控件编写自己的Internet程序 ◆ 55.htm 如何每天抓取 Internet 上某一个网页中的图片来更换桌面的壁纸？ ◆ 56.htm 如何启动拨号网路中的连线？ ◆ 57.htm 如何使用MSCOMM32.OCX发送大于80H的字符，可否给个示例程序 ◆ 58.htm 如何通过VB获取网卡地址 ◆ 59.htm 如何用VB打开默认器或默认发信程序？ ◆ 60.htm 如何用Visual Basic编写小型的网络系统 ◆ 61.htm 如何在程序中启动 NT 的【拨号连接】对话框 ◆ 62.htm 如何在程序中启动 NT 的【拨号连接】对话框？ ◆ 63.htm 如何在网页上使用 VB5 制作的 ActiveX 控件？ ◆ 64.htm 如何中断【拨号网络连接】 ◆ 65.htm 设计Browser及FTP程序 ◆ 66.htm 设计Chat程序 ◆ 67.htm 设计E-mail程序 ◆ 68.htm 设置计算机名称 ◆ 69.htm 使用VB获得一页的HTML代码 ◆ 70.htm 使用VB收发电子邮件 ◆ 71.htm 使用标签控件调出器 ◆ 72.htm 使用超链接和发送Email ◆ 73.htm 使用器的文件复制对话框 ◆ 74.htm 输入／输出篇 ◆ 75.htm 通过WnetEnumResource函数获得网络资源 ◆ 76.htm 通往 Internet 的捷径 ◆ 77.htm 显示计算机的名称 ◆ 78.htm 用 MAPI 控件实现发送邮件 ◆ 79.htm 用 WinSock 控件下载文件 ◆ 80.htm 用 Winsock 实现聊天的程序 ◆ 81.htm 用Internet Transfer编写FTP程序 ◆ 82.htm 用Sockets发送电子邮件 ◆ 83.htm 用VB 创 建 自 己 的 通 信 程 序 ◆ 84.htm 用VB5.0开发通信软件的技巧 ◆ 85.htm 用VB5开发IE ◆ 86.htm 用VB编写网络寻呼 ◆ 87.htm 用VB编写小型的网络系统 ◆ 88.htm 用VB创建自己的通信程序 ◆ 89.htm 用VB构建Internet的应用[微软提供] ◆ 90.htm 用VB开发标准CGI程序 ◆ 91.htm 用VB实现客户——服务器（TCP IP）编程实例 ◆ 92.htm 用VB实现客户服务器（TCP、IP）编程实例 ◆ 93.htm 用VB实现聊天讨论室和点对点会话 ◆ 94.htm 用VB写一个定时PING某IP的程序 ◆ 95.htm 用VB制作器 ◆ 96.htm 用Visual Basic 5.0设计E-mail程序(MAPI) ◆ 97.htm 用Visual Basic6.0编写客户服务器程序 ◆ 98.htm 用Visual Basic创建FTP组件 ◆ 99.htm 用Visual Basic开发数据库器 ◆ 100.htm 用Visual Basic轻松地设计Browser及Ftp程序 ◆ 101.htm 用Winsock控件发信Email ◆ 102.htm 用Winsock控件实现文件的下载 ◆ 103.htm 用Winsock实现点对点通信 ◆ 104.htm 邮件检查程序（二） ◆ 105.htm 邮件检查程序（一） ◆ 106.htm 在VB程序中怎样挂断拨号网络 ◆ 107.htm 在VB中操纵OLE服务器应用程序 ◆ 108.htm 在VB中利用UDP协议编写聊天程序 ◆ 109.htm 在VB中模拟实现邮件传输 ◆ 110.htm 在VB中如何得到网络中某一台电脑(电脑名)的网卡地质？ (自己的) ◆ 111.htm 在VB中实现文件上传 ◆ 112.htm 在VB中实现文件上载 ◆ 113.htm 在VB中使用UDP协议 ◆ 114.htm 在VB中用Outlook发电子邮件 ◆ 115.htm 在WindowsNT网络中广播消息 ◆ 116.htm 在程序中打开 Internet 拨号连接窗口 ◆ 117.htm 在一个单位内部或通过广域协议（如X.25）互联的行业内部都有几十或上万台计算机互联，用Intranet虽然可以建立聊天室，但实现点对点实时对话却比较困难。本人用Winsock和VB自制了一套聊天室和对话系统，特拿来供同行们参考。 ◆ 118.htm 在应用中集成器 ◆ 119.htm 在桌面上建立一个 Internet 快捷键 ◆ 120.htm 怎样接收电子邮件（POP3协议简介） ◆ 121.htm 怎样用VB得知系统当前是否处于internet链结状态 ◆ 122.htm 制作自己的网络搜索软件 ◆ 123.htm 自动更新工作站的应用程序 ◆ 124.htm 自己的IE——用VB制作器 ◆ 125.htm HTTP协议（学习笔记） ◆ 126.htm HTTP协议四--关于Chunked编码 ◆ 127.htm IE器完全控制 ◆ 128.htm OICQ服务器系统通讯协议 ◆ 129.htm POP3协议的基本命令 ◆ 130.htm RAS API上的其他Function ◆ 131.htm VB + API 获取 IE 的 “代理服务器” 配制 ◆ 132.htm vb调用winInet API接口post数据到指定的url ◆ 133.htm vb开发通信软件 ◆ 134.htm vb设计数据库电子邮件程序(1) ◆ 135.htm vb设计数据库电子邮件程序(2) ◆ 136.htm vb设计数据库电子邮件程序(3) ◆ 137.htm vb设计数据库电子邮件程序(4) ◆ 138.htm vb设计数据库电子邮件程序(5) ◆ 139.htm vb设计数据库电子邮件程序(6) ◆ 140.htm VB实现应用程序在局域网上自动更新 ◆ 141.htm VB邮件检查程序 ◆ 142.htm vb中从域名得到IP及从IP得到域名 ◆ 143.htm VB中检测是否连网 ◆ 144.htm WebClass实现动态WEB编程之理论篇 ◆ 145.htm Winsocket网络编程谈 ◆ 146.htm Winsock编程框架 ◆ 147.htm Winsock错误代码一览表 ◆ 148.htm 程式自动呼叫拨号网络(RAS API) ◆ 149.htm 打开一个超连接 ◆ 150.htm 得到登入windows 的人的id ◆ 151.htm 访问Internet并调用Explorer ◆ 152.htm 非同步文件下载类 ◆ 153.htm 给Outlook的所有用户发送信件 ◆ 154.htm 获得网卡的MAC地址 ◆ 155.htm 基于WinSock的小型网络管理系统及其实现 ◆ 156.htm 检测是否连接到Internet ◆ 157.htm 检测网络是否连通 ◆ 158.htm 建立Web的超链接树形图 ◆ 159.htm 建立你自己的器－Properties ◆ 160.htm 建立你自己的器－查看源文件 ◆ 161.htm 建立你自己的器－打印 ◆ 162.htm 建立你自己的器－打印设置 ◆ 163.htm 建立你自己的器－发送到FontPage ◆ 164.htm 建立你自己的器－发送到Visual Interdev ◆ 165.htm 建立你自己的器－发送到软盘 ◆ 166.htm 建立你自己的器－复制 ◆ 167.htm 建立你自己的器－另存为 ◆ 168.htm 建立你自己的器－全选 ◆ 169.htm 建立你自己的器－页面设置 ◆ 170.htm 开发通信软件的技术与技巧 ◆ 171.htm 开发网络应用的5个技巧 ◆ 172.htm 利用RAS调用在VB6.0中实现拨号上网 ◆ 173.htm 利用VB提取HTML文件中的EMAIL地址 ◆ 174.htm 枚举出局域网上所有网络资源 ◆ 175.htm 面向Internet的开发工具 ◆ 176.htm 你也可以YAI--VB5中Winsock控件的使用 ◆ 177.htm 判断一个文件是否在IE的缓存中 ◆ 178.htm 启动拨号网络中的连接 ◆ 179.htm 浅谈HTTP协议（二）--返回值 ◆ 180.htm 浅谈HTTP协议（一）--结构 ◆ 181.htm 如何利用 WebBrowser 控件显示 .GIF 动画？ ◆ 182.htm 如何映射(中断网络磁盘) ◆ 183.htm 设计E-mail的接收部分 ◆ 184.htm 设置器默认网址 ◆ 185.htm 实现端口对端口的聊天 ◆ 186.htm 使用ASP建立Http组件 ◆ 187.htm 使用VB编写纯ASP程序 ◆ 188.htm 使用vb获取网上邻居里的计算机名 ◆ 189.htm 使用VB建立Web Server ◆ 190.htm 使用Visual Basic开发通讯软件 ◆ 191.htm 使用资源工具包执行本地和远程重新启动 ◆ 192.htm 谈谈远程控制中关于搜索、控制计算机的功能 ◆ 193.htm 压缩 Html ◆ 194.htm 用ASP、VB和XML建立互联网应用程序(1) ◆ 195.htm 用ASP、VB和XML建立互联网应用程序(2) ◆ 196.htm 用ASP、VB和XML建立互联网应用程序(3) ◆ 197.htm 用ASP、VB和XML建立互联网应用程序(4) ◆ 198.htm 用COMMUNICATION控件进行数据采集（学习笔记） ◆ 199.htm 用OLE自动化Outlook ◆ 200.htm ActiveX控件用于ＤＨＴＭＬ开发 ◆ 201.htm 用VB编写ActiveX DLL实现ASP编程 ◆ 202.htm 用VB编写Windows CGI应用程序 ◆ 203.htm 用VB编写标准CGI程序（上） ◆ 204.htm 用VB编写标准CGI程序（下） ◆ 205.htm 用VB编写收发电子邮件程序 ◆ 206.htm 用VB编写网络监控软件 ◆ 207.htm 用VB编写异步多线程下载程序 ◆ 208.htm 用VB导入导出IE器收藏夹 ◆ 209.htm 用VB定制合路器 ◆ 210.htm 用VB和XML建立集中式应用程序 ◆ 211.htm 用VB将Html转换为文本文件 ◆ 212.htm 用VB开发分布式应用 ◆ 213.htm 用VB设计基于代理服务器的网络计费系统 ◆ 214.htm 用VB制作文件下载程序 ◆ 215.htm 用Visual Basic 实现无线通讯 ◆ 216.htm 用Winsock制作一套聊天室和对话系统 ◆ 217.htm 远程共享显示及声音的实现 ◆ 218.htm 远程启动机器ABC API解决方案 ◆ 219.htm 远程启动机器ABC WMI解决方案 ◆ 220.htm 在VB5中利用Winsock和msDNS控件进行 ◆ 221.htm 找出计算机上当前登录入网的用户 ◆ 222.htm 用VB5 Winsock控件创建TCP(IP)客户机 服务器程序
用VB6+GDI+开发交互式CAD系统
本课程用VB6(Visual Basic)结合GDI+，从无到有开发一个功能较完整的小型交互式CAD系统。作者有交互式CAD系统、动态几何系统开发经验。出版过交互式CAD系统开发方面的图书。课程先讲准备知识，然后讲整个系统的开发思路和主要技术，最后将整个系统分成8个版本，从最简单的绘图开始，逐步添加功能，循序渐进地进行讲解。知识点讲解细致，系统。课程的核心在于源代码，学习每章内容之前，请先下载本章源码。建议先自行对源码进行阅读分析，然后带着问题去听课，这样学习效率比较高，效果比较好一些。课程最终提供的内容和服务：PPT+源码+视频讲解+持续升级/****课程第一节课为免费课，演示了系统的主要功能。可以用手机或电脑观看。如果无法观看，请私信我。谢谢！*****/友情提醒：凭订单信息可找平台客服开具发票。购买系列课程提供打包价，购买讲师卡更划算。
VB在Word中实现聊天功能.rar
VB在Word中实现聊天功能，接收到的聊天内容过多，请关闭当前QQ聊天窗口，等待重新开启！错误：数据量过大，本程序在使用时必须同时打开聊天窗口，同时在QQ聊天窗口中设置发送时按，而不是！ 　　文件和帮助两菜单可用；上窗口区为信息显示区，下窗口区为信息发送区；双击上窗口区可翻转文字内容！ 　　在输入区内输入内容后，可按回车键换行，确认发送时按Ctrl 回车键！ 　　目前本程序仅限于对一人单独聊天，为了提升安全性，可将系统任务栏设置为自动隐藏！ 　　Microsoft Word 是微软公司的注册产品！特此声明。
vb 聊天源代码基于winsock
本方首先假设服务器端的Winsock控件已被关闭，然后给控件LocalPort分配一个端口。注意的是，不能分配系统服务文件中的友元名称。一旦分配了端口号，将唤醒WinsockDEListen方法。如果连接成功，控件状态是sckListening，如果连接过程中发生了错误，将在txtErr文本框中显示错误信息，检查控件是否处于已被关闭了状态，如果不是，则在接受新的连接，建立了连接，设置isConnectedFlag表示。程序会认为以后的输入数据为聊天内容，如果文本框txtReceive中有数据（不是第一行），此时，需要在各行之间插入VBcrlf换行符。
网络编程

1,502

社区成员

18,437

社区内容

发帖
与我相关
我的任务
社区描述
VB 网络编程
社区管理员
  • 网络编程
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章