WINSOCK在WINXP及WIN98下正常,但在WIN2K中就出错 求高手指点

agui1978 2008-03-12 01:55:33
做了一个子网通信的软件,一个服务器端一个客户端,在WINXP及98下运行都正常,但在WIN2K下,运行时就出错,第一次取得服务器传来的SOCK没问题,轮循时,就出错了,SOCK取回的就是空串了,下边是客户端的代码,请大家看看。
Option Explicit
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MOUSEMOVE = &H200

Private Declare Function Shell_NotifyIcon Lib "shell32" _
Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _
pnid As NOTIFYICONDATA) As Boolean

Dim TrayI As NOTIFYICONDATA
'----------------以上为任务栏图标参数定义----------------------

Private Sub Change_Click()
Load IP
IP.Show
End Sub

Private Sub Command1_Click()
On Error Resume Next
Dim sConnectMain As String
Dim dfwConnMain As ADODB.Connection
Dim rspass As ADODB.Recordset

sConnectMain = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\qd.mdb;Jet OLEDB:Database Password='y8ab6j30'"

Set dfwConnMain = New ADODB.Connection
dfwConnMain.Open sConnectMain

Set rspass = New ADODB.Recordset
rspass.CursorLocation = adUseClient
rspass.Open ("select * from hostip where id=1;"), dfwConnMain, adOpenStatic, adLockOptimistic

Me.LblIP.Caption = Trim(Str(rspass(1).Value)) & "." & Trim(Str(rspass(2).Value)) _
& "." & Trim(Str(rspass(3).Value)) _
& "." & Trim(Str(rspass(4).Value))

Winsock1.RemoteHost = Me.LblIP.Caption
Winsock1.RemotePort = 1600

Winsock1.Connect

Command1.Enabled = False
Do
DoEvents
Loop Until Winsock1.State = sckConnected Or Winsock1.State = sckError
If Winsock1.State = sckError Then
Command1.Enabled = True
Winsock1.Close
Text3.Text = "已与服务器连接失败"
Me.TxtJM.Text = Me.Winsock1.LocalIP & " " & Me.Winsock1.LocalHostName & " 0"
Else

Text3.Text = "已与服务器连接成功"
Command2.Enabled = True
Command3.Enabled = True
Me.TxtJM.Text = Me.Winsock1.LocalIP & " " & Me.Winsock1.LocalHostName & " 1"

End If
Form_Load

'Main
End Sub

Private Sub Command2_Click()

Winsock1.SendData Text1.Text
Text2.Text = Me.Winsock1.LocalIP + " : " + Text1.Text + Chr$(13) + Chr$(10) + Text2.Text
Text1.Text = ""

End Sub
Private Sub Timer1_Timer()
Command3_Click '断开
'Me.Timer1.Enabled = False

End Sub



Private Sub Command3_Click()
Winsock1.Close
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False
Me.Text2.Text = ""
Text3.Text = "已与服务器断开"
Form_Load

'End
End Sub

Private Sub Exit_Click()
On Error GoTo Err:
If MsgBox("您确定要离开吗?(Y/N)", vbQuestion + vbYesNo, "请确认...") = vbYes Then
Kill "C:\Program Files\dlSr\dlSr.txt"
RmDir "C:\Program Files\dlsr\"
End
Else
Exit Sub
End If
Err:
End
End Sub

Private Sub Form_Load()

Dim sConnectMain As String
Dim dfwConnMain As ADODB.Connection
Dim rspass As ADODB.Recordset

If Dir("C:\Program Files\dlsr", vbDirectory) <> "" Then

If Dir("C:\Program Files\dlSr\dlSr.txt") <> "" Then
Open "C:\Program Files\dlSr\dlSr.txt" For Output As #1
Print #1, ""
Close #1
Else
FileCopy App.Path & "\dlSr\dlSr.txt", "C:\Program Files\dlSr\dlSr.txt"
End If
Else
MkDir "C:\Program Files\dlsr\"
FileCopy App.Path & "\dlSr\dlSr.txt", "C:\Program Files\dlSr\dlSr.txt"
End If


'-----------------以下为显示任务栏图标------------------------
TrayI.cbSize = Len(TrayI)

TrayI.hwnd = Form1.hwnd

TrayI.uId = 1&

TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE

TrayI.ucallbackMessage = WM_MOUSEMOVE

TrayI.hIcon = imgIcon.Picture

TrayI.szTip = "LNQD客户端" & Chr$(0)

Shell_NotifyIcon NIM_ADD, TrayI

Me.Hide
'------------------------------------------------------------

sConnectMain = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\qd.mdb;Jet OLEDB:Database Password='y8ab6j30'"

Set dfwConnMain = New ADODB.Connection
dfwConnMain.Open sConnectMain

Set rspass = New ADODB.Recordset
rspass.CursorLocation = adUseClient
rspass.Open ("select * from hostip where id=1;"), dfwConnMain, adOpenStatic, adLockOptimistic

Me.LblIP.Caption = Trim(Str(rspass(1).Value)) & "." & Trim(Str(rspass(2).Value)) _
& "." & Trim(Str(rspass(3).Value)) _
& "." & Trim(Str(rspass(4).Value))

If Me.LblIP.Caption = "0.0.0.0" Then
Load IP
IP.Show
Else

Winsock1.RemoteHost = Me.LblIP.Caption
Winsock1.RemotePort = 1600
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False
Command1_Click
End If

End Sub

Private Sub Form_Resize()
If Me.WindowState = 1 Then
Me.Visible = False
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error GoTo Err:
If MsgBox("您确定要离开吗?(Y/N)", vbQuestion + vbYesNo, "请确认...") = vbYes Then
Cancel = 0
Dim i As Integer
'在窗体集合中循环并卸载每个窗体。
For i = Forms.Count - 1 To 0 Step -1
Unload Forms(i)
Kill "C:\Program Files\dlSr\dlSr.txt"
RmDir "C:\Program Files\dlsr\"
Next i
Kill "C:\Program Files\dlSr\dlSr.txt"
RmDir "C:\Program Files\dlsr\"
TrayI.cbSize = Len(TrayI)
TrayI.hwnd = Form1.hwnd
TrayI.uId = 1&
Shell_NotifyIcon NIM_DELETE, TrayI
Else
Cancel = 1
End If

Exit Sub
Err:
End
End
End Sub


Private Sub Help_Click()
'Load FrmHelp
'FrmHelp.Show 1
End Sub

Private Sub Hide_Click()
Me.Visible = False
End Sub

Private Sub Our_Click()
MsgBox "客户端组件由aguiSoft CO.为dl设计", vbOKOnly + vbInformation, "客户端提示"
Exit Sub
End Sub

Private Sub Text2_Change()
Dim SNStr As String
SNStr = Me.Text2.Text
Open "C:\Program Files\dlSr\dl.txt" For Output As #1
Print #1, SNStr
Close #1
End Sub

Private Sub Text3_Change()
If Text3.Text = "已与服务器断开" Then
'End
End If
End Sub



Private Sub View_Click()
Dim i As Integer
For i = 0 To 1
Me.Visible = True
Me.WindowState = 0
Next i
End Sub

Private Sub Winsock1_Close()
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False
Winsock1.Close
Me.Text2.Text = ""
Text3.Text = "已与服务器断开"

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim c As String
Winsock1.GetData c, vbString
Text2.Text = c

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Msg
Msg = X / Screen.TwipsPerPixelX
If Msg = WM_LBUTTONDBLCLK Then
'Left button double click
Me.Visible = True
Me.WindowState = 0
ElseIf Msg = WM_RBUTTONUP Then
'Right button click
Me.PopupMenu system
End If
End Sub
...全文
74 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

1,502

社区成员

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

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