Option Strict On
Option Explicit On
Imports System.Net.Sockets
Imports System.Threading
Imports System.Runtime.InteropServices
Public Class frmServer
Public Delegate Sub StatusInvoker(ByVal t As String)
Private mobjThread As Thread
Private mobjListener As TcpListener
Private mcolClients As New Hashtable()
Public IPAddr As String
Public PCName As String
Public Msg As String
Public UserID As String
Public PassW As String
Public Stat As String
#Region "Chuyển Số Liệu Về FrmMain form"
'Check xem IP có đc add chưa, có rồi thì khỏi add nữa
Public Sub AddIP()
End Sub
#End Region
Private Function GetIPAddress() As String
Dim strHostName As String
strHostName = System.Net.Dns.GetHostName()
GetIPAddress = System.Net.Dns.GetHostByName(strHostName).AddressList(0).ToString()
End Function
Private Sub UpdateStatus(ByVal t As String)
Try
MsgBox(t)
If t.Length > 20 Then
CodeFilter(t)
MsgProcess(Msg)
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub DoListen()
Try
mobjListener = New TcpListener(7799)
mobjListener.Start()
Do
Dim x As New Client(mobjListener.AcceptTcpClient)
AddHandler x.Connected, AddressOf OnConnected
AddHandler x.Disconnected, AddressOf OnDisconnected
AddHandler x.LineReceived, AddressOf OnLineReceived
mcolClients.Add(x.ID, x)
Dim params() As Object = {"New connection"}
Me.Invoke(New StatusInvoker(AddressOf Me.UpdateStatus), params)
Loop Until False
Catch
End Try
End Sub
Private Sub frmServer_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ipServer.Value = GetIPAddress()
mobjThread = New Threading.Thread(AddressOf DoListen)
mobjThread.SetApartmentState(ApartmentState.STA)
mobjThread.Start()
'StartThread()
UpdateStatus("Listener started")
End Sub
Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
mobjListener.Stop()
End Sub
Private Sub OnConnected(ByVal sender As Client)
UpdateStatus("Connected")
End Sub
Private Sub OnDisconnected(ByVal sender As Client)
UpdateStatus("Disconnected")
mcolClients.Remove(sender.ID)
End Sub
Private Sub OnLineReceived(ByVal sender As Client, ByVal Data As String)
UpdateStatus(Data)
Dim objClient As Client
Dim d As DictionaryEntry
For Each d In mcolClients
objClient = CType(d.Value, Client)
objClient.Send(Data & vbCrLf)
Next
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
CodeFilter("ip:192.1.243.123 -name:May_01 -code:001# -acct:001|Xc9e")
'MsgProcess(Msg)
MsgBox(IPAddr & PCName & Msg & UserID & PassW)
'MsgBox(CheckUserAccount("", ""))
End Sub
#Region "Process Lan Connection"
'Xử lý các mã Msg
<STAThread()>
Public Sub MsgProcess(ByVal Msg As String)
Select Case Msg
Case Is = "000"
'Client disconnected
RemoveClient(PCName)
Stat = "Đã Kết Nối"
Exit Sub
Case Is = "001"
'Client connected
AddClient()
End Select
End Sub
'Add ListConnect item
<STAThread()> _
Public Sub AddClient()
Dim item As New ListViewItem
item.Text = CStr(lstStatus.Items.Count + 1) 'số thứ tự
item.SubItems.Add(PCName)
item.SubItems.Add(IPAddr)
For i As Integer = 0 To frmMain.listScore.Items.Count - 1
If UserID = frmMain.listScore.Items(i).Text Then
item.SubItems.Add(frmMain.listScore.Items(i).SubItems(1)) 'thêm tên thí sinh
Exit For
End If
Next
item.SubItems.Add(UserID)
item.SubItems.Add(Stat)
lstStatus.Items.Add(item)
End Sub
'Remove ListConnect item
Public Sub RemoveClient(ByVal Name As String)
With frmMain
If .listConnect.Items.Count <> 0 Then
For i As Integer = 0 To .listConnect.Items.Count - 1
If Name = .listConnect.Items(i).SubItems(0).Text Then
.listConnect.Items(i).Remove()
Exit Sub
End If
Next
End If
End With
End Sub
'Check xem IP đã đc add vô listConnect chưa
Public Function CheckNewIP(ByVal IP As String) As Boolean
With frmMain
If .listConnect.Items.Count = 0 Then
Return False
Else
For i As Integer = 0 To .listConnect.Items.Count - 1
If IP = .listConnect.Items(i).SubItems(0).Text Then
Return True
Exit Function
Else
Return False
End If
Next
End If
End With
End Function
'Lọc các thông tin ra khỏi Message
Public Sub CodeFilter(ByVal code As String)
Dim firstspace As Byte = CByte(InStr(1, code, " "))
IPAddr = Strings.Mid(code, 4, firstspace - 4)
Dim secondspace As Byte = CByte(InStr(firstspace + 1, code, " "))
PCName = Strings.Mid(code, firstspace + 7, secondspace - firstspace - 7)
Dim thirdspace As Byte = CByte(InStr(secondspace + 1, code, "#"))
Msg = Strings.Mid(code, secondspace + 7, thirdspace - secondspace - 7)
Dim lastpoint As Byte = CByte(InStr(thirdspace + 1, code, "|"))
UserID = Strings.Mid(code, thirdspace + 8, lastpoint - thirdspace - 8)
If lastpoint < code.Length Then
'Have password
PassW = Strings.Right(code, code.Length - lastpoint)
Else
PassW = ""
End If
End Sub
Public Function CheckUserAccount(ByVal UID As String, ByVal UPW As String) As Boolean
With frmMain.listScore
Dim RightID As Boolean = False
Dim RightPW As Boolean = False
If frmMain.chkSetPassword.Checked = True Then
For i As Integer = 0 To .Items.Count - 1
If UPW = .Items(i).SubItems(.Columns.Count - 1).Text Then
RightPW = True
Exit For
End If
Next
If RightPW = False Then Return False 'Sai pass thì ko cần duyệt USER NAME
End If
MsgBox("UHM")
For i As Integer = 0 To .Items.Count - 1
If UID = .Items(i).Text Then
RightID = True
Exit For
End If
Next
If RightID And RightPW = True Then
Return True
Else
Return False
End If
End With
End Function
Public Function CheckUserPassW(ByVal UPW As String) As Boolean
With frmMain.listScore
Dim SubItemIndex As Integer
If frmMain.chkSetPassword.Checked = False Then
Return True
Else
For i As Integer = 0 To .Items.Count - 1
If UPW = .Items(i).SubItems(.Columns.Count - 1).Text Then
Return True
Exit Function
End If
Next
Return False
End If
End With
End Function
#End Region
End Classn
)
Reply With Quote
