高手来看下我的代码(全)

dbbush 2005-05-30 11:20:13
为什么到accept的时候server会“死掉”

////////////////////////////////////
'tcpserver.frm

Dim nResult As Long
Dim msg_sock As Long, accept_sock As Long
Dim tcph As TcpHeader, iph As IPHeader

Private Sub cmdstart_Click()

Dim addr As sockaddr, client_addr As sockaddr, addrlen As Long, pSockAddr As Long
Dim recvbuff(1024) As Integer, k As Long
k = LBound(recvbuff)

cmdstart.Enabled = False
cmdstop.Enabled = True

accept_sock = socket(AF_INET, SOCK_STREAM, 0)

If accept_sock = INVALID_SOCKET Then
MsgBox "Error in socket"
Exit Sub
End If

addr.sin_family = AF_INET
addr.sin_port = htons(CLng(txtdestport.Text))
addr.sin_addr = inet_addr(sckserver.LocalIP)

nResult = bind(accept_sock, addr, Len(addr))

If nResult = SOCKET_ERROR Then
MsgBox "Error in bind"
closesocket (accept_sock)
cmdstart.Enabled = True
cmdstop.Enabled = False
Exit Sub
End If

nResult = listen(accept_sock, 1)
If nResult = SOCKET_ERROR Then
MsgBox "Error in listen"
closesocket (accept_sock)
cmdstart.Enabled = True
cmdstop.Enabled = False
Exit Sub
End If

'Dim InParamBuffer As Long
'Dim BytesRet As Long
'BytesRet = 0
'InParamBuffer = 1
'nResult = WSAIoctl(accept_sock, &H98000001, InParamBuffer, Len(InParamBuffer), 0, 0, BytesRet, 0, 0)

'If nResult <> 0 Then
'MsgBox "ioctlsocket"
'Exit Sub
'End If

msg_sock = accept(accept_sock, client_addr, Len(client_addr))
??????????????????????????就这里
If msg_sock = INVALID_SOCKET Then
MsgBox "Error in accept"
closesocket (accept_sock)
cmdstart.Enabled = True
cmdstop.Enabled = False
Exit Sub
End If

Do Until False 'Len(recvbuff(k)) < 1024
DoEvents
Call Sleep(300)

nResult = recv(msg_sock, ByVal recvbuff(k), 1024, 0)
If nResult = SOCKET_ERROR Then
MsgBox "error in recieve data from remote socket"
closesocket (accept_sock)
closesocket (msg_sock)
cmdstart.Enabled = True
cmdstop.Enabled = False
Exit Sub
End If

CopyMemory tcph, recvbuff(k), Len(tcph)
CopyMemory iph, recvbuff(k), Len(iph)

txtdestaddr.Text = sckserver.LocalIP
txtsourceaddr.Text = iph.sourceIP
txtsourceport.Text = tcph.sport
txtwin.Text = tcph.win
txttcpcksum.Text = tcph.cksum
txtseq.Text = tcph.seq
txtack.Text = tcph.ack

nResult = send(msg_sock, ByVal recvbuff(k), 1024, 0)
If nResult = SOCKET_ERROR Then
MsgBox "error send data to remote socket"
closesocket (accept_sock)
closesocket (msg_sock)
cmdstart.Enabled = True
cmdstop.Enabled = False
Exit Sub
End If

Loop

End Sub

Private Sub cmdstop_Click()
closesocket (accept_sock)
closesocket (msg_sock)
WSACancelBlockingCall
WSACleanup

cmdstart.Enabled = True
cmdstop.Enabled = False

End Sub

Private Sub Form_Load()
Dim mwsaData As WSADataType

cmdstop.Enabled = False

nResult = WSAStartup(&H202, mwsaData)

If nResult <> WSANOERROR Then
MsgBox "Error en WSAStartup"
WSACleanup
Exit Sub
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
closesocket (accept_sock)
closesocket (msg_sock)
WSACancelBlockingCall
WSACleanup
End Sub
//////////////////////////
tcpclient.frm

Dim soc As Long, dwRc As Long
Dim RemoteAddr As sockaddr
Dim tcph As TcpHeader
Dim psdh As psdHeader
Dim iph As IPHeader

Private Sub cmdconnect_Click()
soc = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)

If soc = INVALID_SOCKET Then
MsgBox "Error in Create Socket"
Else
RemoteAddr.sin_family = AF_INET
RemoteAddr.sin_port = htons(CLng(txtdestport.Text))
RemoteAddr.sin_addr = GetHostByNameAlias(txtdestaddr.Text)
dwRc = connect(soc, RemoteAddr, sockaddr_size)
If dwRc = SOCKET_ERROR Then
MsgBox "Error in connect to remote Socket"
Else
cmdconnect.Enabled = False
cmddisconnect.Enabled = True
cmdsend.Enabled = True
End If
End If
End Sub

Private Sub cmddisconnect_Click()
txtdata.Text = ""
If soc <> INVALID_SOCKET Then closesocket (soc)
WSACleanup
cmdconnect.Enabled = True
cmdsend.Enabled = False
cmddisconnect.Enabled = False
soc = INVALID_SOCKET
End Sub

Private Sub cmdsend_Click()
'txtdata为设定的数据长度
Dim h As Integer, buff(0 To 65535) As Integer, g As Integer
h = CInt(txtdata.Text)
If h > 65535 Then
MsgBox "too big"
Exit Sub
End If

For g = 0 To 65535
buff(g) = 1
Next g

If soc = INVALID_SOCKET Then
MsgBox "Create Socket First"
Exit Sub
End If

Dim RetMsg(1024) As Integer, j As Long
j = LBound(RetMsg)

Dim sendbuff(128) As Integer
Dim i As Long, k As Long
i = LBound(sendbuff)
'填充包头,计算校验和
With iph
.cksum = 0
.flags = 0
.lenver = (4 \ &HF) Xor Len(iph) / 4
.len = htons(Len(iph) + Len(tcph))
.ident = 0
.ttl = 128
.destIP = txtdestaddr.Text
.sourceIP = sckclient.LocalIP
.proto = sckTCPProtocol
End With
With tcph
.sport = htons(sckclient.LocalPort)
.dport = CInt(txtdestport.Text)
.seq = 0
.ack = 1
.win = htons(16384)
.urp = 0
.cksum = 0
End With
With psdh
.saddr = iph.sourceIP
.daddr = iph.destIP
.mbz = 0
.proto = sckTCPProtocol
.tcplen = htons(Len(tcph))
End With

CopyMemory sendbuff(i), psdh, Len(psdh)
CopyMemory sendbuff(i + Len(psdh)), tcph, Len(tcph)

tcph.cksum = checksum(sendbuff(), Len(psdh) + Len(tcph))

txtsourceport.Text = tcph.sport
txtsourceaddr.Text = iph.sourceIP
txttcpcksum.Text = tcph.cksum

k = Len(iph) + Len(tcph) + h

CopyMemory sendbuff(i), tcph, Len(tcph)
CopyMemory sendbuff(i + Len(tcph)), iph, Len(iph)

Select Case k

Case k < 1024

CopyMemory RetMsg(j), tcph, Len(tcph)
CopyMemory RetMsg(j + Len(tcph)), iph, Len(iph)
CopyMemory RetMsg(j + Len(tcph) + Len(iph)), buff(0), h

dwRc = send(soc, ByVal RetMsg(j), Len(RetMsg(j)), 0)
If dwRc = SOCKET_ERROR Then
MsgBox "Couldn't send data to remote Socket"
Else
dwRc = recv(soc, ByVal RetMsg(j), 1024, 0)
If dwRc = SOCKET_ERROR Then
MsgBox "couldn't recieve data from remote socket"
Else
tcph.ack = tcph.ack + 1
txtack.Text = tcph.ack
End If
End If
tcph.win = tcph.win - 1
tcph.seq = tcph.seq + 1

txtwin.Text = tcph.win
txtseq.Text = tcph.seq

Case k >= 1024

CopyMemory RetMsg(j), sendbuff(i), Len(sendbuff(i))
CopyMemory RetMsg(j + Len(sendbuff(i))), buff(0), 1024 - Len(sendbuff(i))
g = 1024 - Len(sendbuff(i))

Do Until k <= 0

dwRc = send(soc, ByVal RetMsg(j), 1024, 0)
If dwRc = SOCKET_ERROR Then
MsgBox "Couldn't send data to remote Socket"
Else
dwRc = recv(soc, ByVal RetMsg(j), 1024, 0)
If dwRc = SOCKET_ERROR Then
MsgBox "couldn't recieve data from remote socket"
Else
tcph.ack = tcph.ack + 1
txtack.Text = tcph.ack
End If
End If

k = k - 1024
tcph.win = tcph.win - 1
tcph.seq = tcph.seq + 1

txtwin.Text = tcph.win
txtseq.Text = tcph.seq

CopyMemory RetMsg(j), buff(g), 1024
g = g + 1024

Loop

End Select

End Sub

Private Sub Form_Load()
Dim nResult As Long, mwsaData As WSADataType

cmddisconnect.Enabled = False
cmdsend.Enabled = False

nResult = WSAStartup(&H202, mwsaData)

If nResult <> WSANOERROR Then
MsgBox "Error en WSAStartup"
WSACleanup
Exit Sub
End If
End Sub



...全文
115 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
dbbush 2005-05-31
  • 打赏
  • 举报
回复
那就帮我看下这一段把,很正常的,不知道为什么会出错
accept不是一直接收等待远端连接吗?程序会死掉,我看书上也是这么用的阿

Private Sub cmdstart_Click()

Dim addr As sockaddr, client_addr As sockaddr
Dim recvbuff(1024) As Integer, k As Long
k = LBound(recvbuff)

cmdstart.Enabled = False
cmdstop.Enabled = True

accept_sock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)

If accept_sock = INVALID_SOCKET Then
MsgBox "Error in socket"
Exit Sub
End If

addr.sin_family = AF_INET
addr.sin_port = htons(CInt(txtdestport.Text))
addr.sin_addr = inet_addr(sckserver.LocalIP)

nResult = bind(accept_sock, addr, Len(addr))

If nResult = SOCKET_ERROR Then
MsgBox "Error in bind"
closesocket (accept_sock)
cmdstart.Enabled = True
cmdstop.Enabled = False
Exit Sub
End If

nResult = listen(accept_sock, 1)
If nResult = SOCKET_ERROR Then
MsgBox "Error in listen"
closesocket (accept_sock)
cmdstart.Enabled = True
cmdstop.Enabled = False
Exit Sub
End If



msg_sock = accept(accept_sock, client_addr, Len(client_addr))

If msg_sock = INVALID_SOCKET Then
MsgBox "Error in accept"
closesocket (accept_sock)
cmdstart.Enabled = True
cmdstop.Enabled = False
Exit Sub
'Else
'MsgBox "111"

End If
  • 打赏
  • 举报
回复
你应该简化以下代码,太多了看不完
dbbush 2005-05-31
  • 打赏
  • 举报
回复
为什么调用accept函数程序会死掉
大虾帮我调试一下吧
kkmnv 2005-05-31
  • 打赏
  • 举报
回复
这么多啊
顶一下
qyii 2005-05-31
  • 打赏
  • 举报
回复
有什么问题??
dbbush 2005-05-30
  • 打赏
  • 举报
回复
//////////////////////
startup.bas

Option Explicit

Sub Main()
Dim dwRet As Long
dwRet = MsgBox("单击""是""启动服务器进程,单击""否""启动客户端程序。", vbYesNo)
If dwRet = vbYes Then
Load tcpserver
tcpserver.Show
Else
Load tcpclient
tcpclient.Show
End If
End Sub
////////////////////////////
winsock.bas

Option Explicit

Global Const SOCK_STREAM = 1
Global Const IPPROTO_TCP = 6
Global Const socketaddr_size = 16
Global Const hostent_size = 16
Global Const INADDR_NONE = &HFFFF
Global Const INVALID_SOCKET = -1
Global Const SOCKET_ERROR = -1
Global Const INADDR_ANY = &H0
Global Const AF_INET = 2
Global Const WSA_DESCRIPTIONLEN = 256
Global Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
Global Const WSA_SYS_STATUS_LEN = 128
Global Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
Global Const IPPROTO_IP = 0

Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Declare Function accept Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr, namelen As Long) As Long
Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Declare Function send Lib "ws2_32.dll" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Declare Function listen Lib "ws2_32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Long) As Integer
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Declare Function htonl Lib "ws2_32.dll" (ByVal hostlong As Long) As Long
Declare Function ntohl Lib "ws2_32.dll" (ByVal netlong As Long) As Long
Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Declare Function gethostbyname Lib "ws2_32.dll" (ByVal host_name As String) As Long
Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Declare Function WSACancelBlockingCall Lib "ws2_32.dll" () As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Long, ByVal cbInBuffer As Long, lpvOutBuffer As Long, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long


Type WSADataType
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSA_DescriptionSize
szSystemStatus As String * WSA_SysStatusSize
iMaxSocket As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type

Type TcpHeader
sport As Integer
dport As Integer
seq As Long
ack As Long
flags As Integer
win As Integer
cksum As Integer
urp As Integer
End Type

Type psdHeader
saddr As Long
daddr As Long
mbz As Byte
proto As Byte
tcplen As Integer
End Type

Type IPHeader
lenver As Byte
tos As Byte
len As Integer
ident As Integer
flags As Integer
ttl As Byte
proto As Byte
cksum As Integer
sourceIP As Long
destIP As Long
End Type

Type HostEnt
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type

Function GetHostByNameAlias(ByVal hostname As String) As Long
On Error Resume Next

Dim phe As Long
Dim heDestHost As HostEnt
Dim addrlist As Long
Dim retIP As Long
retIP = inet_addr(hostname)
If retIP = INADDR_NONE Then
phe = gethostbyname(hostname)
If phe <> 0 Then
CopyMemory heDestHost, ByVal phe, hostent_size
CopyMemory addrlist, ByVal heDestHost.h_addr_list, 4
CopyMemory retIP, ByVal addrlist, heDestHost.h_length
Else
retIP = INADDR_NONE
End If
End If
GetHostByNameAlias = retIP
If Err Then GetHostByNameAlias = INADDR_NONE
End Function

Function checksum(buffer() As Integer, ByVal size As Integer) As Integer
Dim cksum As Integer
Dim i As Long
i = LBound(buffer)
Do While size > 1
cksum = cksum + (buffer(i) And &HFFFF&)
i = i + 1
size = size - 2
Loop
If size Then
cksum = cksum + (buffer(i) And &HFF&)
End If
cksum = ((cksum \ &H10000) And &HFFFF&) + (cksum And &HFFFF&)
cksum = (cksum And &HFFFF&) + (cksum \ &H10000)
checksum = Not cksum
End Function
dbbush 2005-05-30
  • 打赏
  • 举报
回复
大哥帮帮忙啊,我是新手

1,502

社区成员

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

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