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
...全文
2644 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网络编程实例
本人用Winsock和VB自制了一套聊天室和对话系统，特拿来供同行们参考。 ◆ 118.htm 在应用中集成器 ◆ 119.htm 在桌面上建立一个 Internet 快捷键 ◆ 120.htm 怎样接收电子邮件（POP3协议简介） ...
VB在Word中实现聊天功能.rar
VB在Word中实现聊天功能，接收到的聊天内容过多，请关闭当前QQ聊天窗口，等待重新开启！错误：数据量过大，本程序在使用时必须同时打开聊天窗口，同时在QQ聊天窗口中设置发送时按，而不是！ 　文件和帮助两菜单可用...
vb 聊天源代码基于winsock
如果连接成功，控件状态是sckListening，如果连接过程中发生了错误，将在txtErr文本框中显示错误信息，检查控件是否处于已被关闭了状态，如果不是，则在接受新的连接，建立了连接，设置isConnectedFlag表示。...
基于WINSOCK的简易聊天客户端、服务端VB版.rar
如果连接成功，控件状态是sckListening，如果连接过程中发生了错误，将在txtErr文本框中显示错误信息，检查控件是否处于已被关闭了状态，如果不是，则在接受新的连接，建立了连接，设置isConnectedFlag表示。...
网络编程

1,502

社区成员

18,437

社区内容

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

加载中

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

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

+ 用AI写文章