WINSOCK在WINXP及WIN98下正常,但在WIN2K中就出错 求高手指点
做了一个子网通信的软件,一个服务器端一个客户端,在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