• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Thủ thuật winshock trong access vba đơn giản

• Trang chủ

  • Thủ Thuật Access
  • Access Nâng Cao
  • Thủ thuật VBA
  • [Thủ Thuật] Thủ thuật winshock trong access vba đơn giản
• Thủ thuật winshock trong access vba đơn giản

• Thủ thuật winshock trong access vba đơn giản

  thucgia > 12-04-15, 02:06 PM

  Hôm nay,ace cho phép mình ra một phát pháo về vấn đề winshock trong access in lan,
  Theo tài liệu của VB thì đại khái winshock có 2 loại TCP và UDP, các bạn tự đọc thêm tài liệu, trong phát pháo đầu tiên mời các bạn thảo luận, mình sử dụng kỹ thuật UDP
  1, Để xài cái winshock bạn phải tham chiếu cái ocx mswinsck.ocx như hình vẽ
  
  
  
  2, Bạn tham khảo 2 đoạn code của mình , một cho server và một cho client
  
  a, for server
  

  Mã:

  Option Compare Database
Dim ten As String
Public WithEvents ws_server As MSWinsockLib.Winsock ' Vì không cho lôi thả nên phải sử dụng cái này
Public WithEvents ws_anser As MSWinsockLib.Winsock
Dim remoteHostIP As String
Dim remotePort As String
Private Sub btn_login_Click()
    ten = InputBox("Vui long nhap ten", "What you name ?", "noname")
    If ten = "" Then
        ten = "noname"
    End If
    DoCmd.OpenForm "frm_client"
    Me.btn_login.Enabled = False
End Sub
Private Sub Form_Load()
    Set ws_server = New MSWinsockLib.Winsock
    ws_server.Protocol = sckUDPProtocol
    ws_server.Bind 1001 'server đang lắng nghe ở cổng số 1001, bạn có thể đặt khác tùy bạn
   
    Set ws_anser = New MSWinsockLib.Winsock
    ws_anser.Protocol = sckUDPProtocol
End Sub
Private Sub ws_server_DataArrival(ByVal bytesTotal As Long)
    Dim msg As String
    ws_server.GetData msg
    Select Case msg
        Case "in":
            remoteHostIP = ws_server.remoteHostIP
            remotePort = ws_server.remotePort
            Me.txt_output_server = "[" & ten & "]" & " login" & vbCrLf & _
                Me.txt_output_server
               
            ws_anser.RemoteHost = remoteHostIP  'Chỉnh súng bắn ngược lại client
            ws_anser.remotePort = remotePort
            ws_anser.SendData "[" & ten & "]: login >"
        Case "out":
            btn_login.Enabled = True
            Me.txt_output_server = "[" & ten & "]" & " logout" & vbCrLf & _
                Me.txt_output_server
        Case Else:
            Me.txt_output_server = "[" & ten & "] :" & msg & vbCrLf & _
                Me.txt_output_server
            ws_anser.RemoteHost = remoteHostIP
            ws_anser.remotePort = remotePort
            ws_anser.SendData "[" & ten & "]: " & msg
    End Select
End Sub

  
  b, for client
  

  Mã:

  Option Compare Database
Public WithEvents ws_client As MSWinsockLib.Winsock
Private Sub btn_send_Click()
    If Not IsNull(txt_msg) Then
        ws_client.RemoteHost = "localhost" 'ở đây để demo nên mình sử dụng localhost
        ws_client.remotePort = 1001 ' Xia khẩu súng vào cổng 1001 của server
        ws_client.SendData txt_msg ' Bóp cò thôi...
    End If
End Sub
Private Sub Form_Load()
    Set ws_client = New MSWinsockLib.Winsock
    ws_client.Protocol = sckUDPProtocol
    ws_client.RemoteHost = "localhost"
    ws_client.remotePort = 1001
    ws_client.SendData "in"
End Sub
Private Sub Form_Unload(Cancel As Integer)
    ws_client.RemoteHost = "localhost"
    ws_client.remotePort = 1001
    ws_client.SendData "out"
End Sub
Private Sub ws_client_DataArrival(ByVal bytesTotal As Long)
    Dim msg As String
    ws_client.GetData msg
    Me.txt_output = msg & vbCrLf & _
        Me.txt_output
End Sub

  
  3, và đây là kết quả
  
  [/php]
  
  4, Ý kiến : Trong access để cài đặt chat mình nghĩ chỉ có thể dùng UDP bởi vì trong access microsoft không support array control.
  5, Mời các bạn thảo luận...Các bạn xem thử có đoạn lệnh nào dư không nhé, mình không tìm thấy..., Vì thế cần tổ chức lại nhiều lắm trước khi phát triển...

• RE: Thủ thuật winshock trong access vba đơn giản

  maidinhdan > 12-04-15, 02:50 PM

  Code hay quá, hok biết có ngại post demo lên không nửa. Để mọi người thưởng thức.

• RE: Thủ thuật winshock trong access vba đơn giản

  thucgia > 12-04-15, 04:32 PM

  (12-04-15, 02:50 PM)maidinhdan Đã viết: Code hay quá, hok biết có ngại post demo lên không nửa. Để mọi người thưởng thức.

  hi, gửi hết trơn rồi đó bạn, Chỉ có 2 form thôi, dựng lên dễ mà, tại mình viết trên access 2010,
  Xem thử đi, rồi bàn tiếp, mình còn đang suy nghĩ làm sao đặt cái đại liên từ server bắn một loạt vào các client mới đúng chuẩn.
  Nghiên cứu tí đi rồi còn thảo luận nữa nhé.

• RE: Thủ thuật winshock trong access vba đơn giản

  maidinhdan > 12-04-15, 08:32 PM

  (12-04-15, 04:32 PM)thucgia Đã viết:

  (12-04-15, 02:50 PM)maidinhdan Đã viết: Code hay quá, hok biết có ngại post demo lên không nửa. Để mọi người thưởng thức.

  hi, gửi hết trơn rồi đó bạn, Chỉ có 2 form thôi, dựng lên dễ mà, tại mình viết trên access 2010,
  Xem thử đi, rồi bàn tiếp, mình còn đang suy nghĩ làm sao đặt cái đại liên từ server bắn một loạt vào các client mới đúng chuẩn.
  Nghiên cứu tí đi rồi còn thảo luận nữa nhé.

  
  anh nghiên cứu TCP chưa...mỗi người 1 cái coi cái nào hay hơn.
  Vả lại anh làm rồi, làm biến soạn form text box lắm....Và còn nhiều vấn đề trên diễn đàn cần giải quyết nửa...Ngày nào cũng xem code...cũng gõ riết cái cổ tay phải đau suốt cả tháng rồi...

• RE: Thủ thuật winshock trong access vba đơn giản

  thucgia > 12-04-15, 09:11 PM

  (12-04-15, 08:32 PM)maidinhdan Đã viết:

  (12-04-15, 04:32 PM)thucgia Đã viết:

  (12-04-15, 02:50 PM)maidinhdan Đã viết: Code hay quá, hok biết có ngại post demo lên không nửa. Để mọi người thưởng thức.

  hi, gửi hết trơn rồi đó bạn, Chỉ có 2 form thôi, dựng lên dễ mà, tại mình viết trên access 2010,
  Xem thử đi, rồi bàn tiếp, mình còn đang suy nghĩ làm sao đặt cái đại liên từ server bắn một loạt vào các client mới đúng chuẩn.
  Nghiên cứu tí đi rồi còn thảo luận nữa nhé.

  
  anh nghiên cứu TCP chưa...mỗi người 1 cái coi cái nào hay hơn.
  Vả lại anh làm rồi, làm biến soạn form text box lắm....Và còn nhiều vấn đề trên diễn đàn cần giải quyết nửa...Ngày nào cũng xem code...cũng gõ riết cái cổ tay phải đau suốt cả tháng rồi...

  
  hi, file đây nè, acc 2003
  file chat_udp_demo

• RE: Thủ thuật winshock trong access vba đơn giản

  maidinhdan > 12-04-15, 10:11 PM

  Chắc anh gửi Demo Acc 2010 lên đi, để em cài ngâm cứu cùng anh...Khi conver sang 2003 Open là nó Bug ngay chả làm gì được cả.
  
  Hay xin thêm ý kiến anh là:
  - anh làm trên 2010
  - em làm trên 2003.
  
  Ý hay thế nào?

• RE: Thủ thuật winshock trong access vba đơn giản

  thucgia > 13-04-15, 01:53 PM

  (12-04-15, 10:11 PM)maidinhdan Đã viết: Chắc anh gửi Demo Acc 2010 lên đi, để em cài ngâm cứu cùng anh...Khi conver sang 2003 Open là nó Bug ngay chả làm gì được cả.
  
  Hay xin thêm ý kiến anh là:
  - anh làm trên 2010
  - em làm trên 2003.
  
  Ý hay thế nào?

  
  Gửi các bạn phiên bản 2, sẳn làm làm luôn khỏi tốn công ace nhé!!!!
  1, Tiền đồ của phiên bản 3 hoàn thành (lưu trữ array of client, phiên bản 3 mình sẽ làm thêm 1 nút login nữa, cho 1 client vào nữa là xong, mình tưởng tượng thế này nhé: client sẽ nạp đạn vào khẩu đại liên của server, hix phải tưởng tượng thế mới hấp dẫn!!!!)
  2, Rút gọn code, tường minh variable va function
  Const host_server As String = "localhost" 'sau này điền vào server name là xong, khỏi sửa nhiều
  
  frm_server
  
  

  Mã:

  Option Compare Database
Public WithEvents ws_server As MSWinsockLib.Winsock
Public WithEvents ws_anser As MSWinsockLib.Winsock
Dim ten_client As String
Dim host_client As String
Dim port_client As String
Public Sub MySendData(txt As String)
    ws_anser.RemoteHost = host_client
    ws_anser.remotePort = port_client
    ws_anser.SendData txt
End Sub
Private Sub btn_login_Click()
    ten_client = InputBox("Vui long nhap ten", "What you name ?", "noname")
    If ten_client = "" Then
        ten_client = "noname"
    End If
    DoCmd.OpenForm "frm_client"
    Me.btn_login.Enabled = False
End Sub
Private Sub Form_Load()
    Set ws_server = New MSWinsockLib.Winsock
    ws_server.Protocol = sckUDPProtocol
    ws_server.Bind 1001
    Set ws_anser = New MSWinsockLib.Winsock
    ws_anser.Protocol = sckUDPProtocol
End Sub
Private Sub ws_server_DataArrival(ByVal bytesTotal As Long)
    Dim msg As String
    ws_server.GetData msg
    Select Case msg
        Case "in":
            host_client = ws_server.remoteHostIP
            port_client = ws_server.remotePort
            Me.txt_output_server = "[" & ten_client & "]" & " login" & vbCrLf & _
                Me.txt_output_server
            Call MySendData("[" & ten_client & "]: login >")
        Case "out":
            btn_login.Enabled = True
            Me.txt_output_server = "[" & ten_client & "]" & " logout" & vbCrLf & _
                Me.txt_output_server
        Case Else:
            Me.txt_output_server = "[" & ten_client & "] :" & msg & vbCrLf & _
                Me.txt_output_server
            Call MySendData("[" & ten_client & "]: " & msg)
    End Select
End Sub

  
  frm_client
  
  

  Mã:

  Option Compare Database
Public WithEvents ws_client As MSWinsockLib.Winsock
Const host_server As String = "localhost"  'sau này điền vào server name là xong, khỏi sửa nhiều
Const port_server As String = "1001"
Public Sub MySendData(txt As String)
    ws_client.RemoteHost = host_server
    ws_client.remotePort = port_server
    ws_client.SendData txt
End Sub
Private Sub btn_send_Click()
    If Not IsNull(txt_msg) Then
        Call MySendData(txt_msg)
    End If
End Sub
Private Sub Form_Load()
    Set ws_client = New MSWinsockLib.Winsock
    ws_client.Protocol = sckUDPProtocol
    Call MySendData("in")
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo sub_error
    Call MySendData("out")
sub_error:
    Resume Next
End Sub
Private Sub ws_client_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo sub_error
    Dim msg As String
    ws_client.GetData msg
    Me.txt_output = msg & vbCrLf & _
        Me.txt_output
sub_error:
    Resume Next
End Sub

• RE: Thủ thuật winshock trong access vba đơn giản

  maidinhdan > 13-04-15, 04:05 PM

  Để tối nay Check nó xem sao, Coi cần thêm gì nửa hok. chứ tối hôm qua đọc tài liệu nước ngoài nói về Winsock ( mãi đọc mà gần sáng hok hay) sáng đi làm trễ gần 9h mới vào cơ quan)
  
  Cảm ơn anh thucgia trước nhé....

• RE: Thủ thuật winshock trong access vba đơn giản

  thucgia > 13-04-15, 09:56 PM

  (13-04-15, 04:05 PM)maidinhdan Đã viết: Để tối nay Check nó xem sao, Coi cần thêm gì nửa hok. chứ tối hôm qua đọc tài liệu nước ngoài nói về Winsock ( mãi đọc mà gần sáng hok hay) sáng đi làm trễ gần 9h mới vào cơ quan)
  
  Cảm ơn anh thucgia trước nhé....

  
  hi, ace diễn đàn thuthuataccess
  Hôm nay ngày lành tháng tốt, mình xin kết hợp 1/100 tinh túy của sư phụ mình + 1 tí hương hoa của giang hồ hải hội + một tí công nghệ OOP, kính tặng anh em giang hồ phiên bản 3 của access chat, chủ yếu là về cái khẩu đại liên từ server bắn về client
  
  - Để anh em hình dung mình view trước cái giao diên kết quả
  
  - first and second user login
  
  - Second user logout
  
  
  - Về phần code bao gồm 4 file
  1, frm_sever
  
  

  Mã:

  Option Compare Database
Public WithEvents ws_server As MSWinsockLib.Winsock
Public WithEvents ws_anser As MSWinsockLib.Winsock
Dim l As clientDao
Dim ten_client As String
Dim host_client As String
Dim port_client As String
Public Sub MySendData(txt As String)
    Dim i As Integer
    For i = 1 To l.SoDong
        ws_anser.RemoteHost = l.GetClient(i).host_client
        ws_anser.remotePort = l.GetClient(i).port_client
        ws_anser.SendData txt
    Next i
End Sub
Private Sub btn_login_Click()
    ten_client = InputBox("Vui long nhap ten", "What you name ?", "noname")
    If ten_client = "" Then
        ten_client = "noname"
    End If
    DoCmd.OpenForm "frm_client"
End Sub
Private Sub btn_login2_Click()
    ten_client = InputBox("Vui long nhap ten", "What you name ?", "noname")
    If ten_client = "" Then
        ten_client = "noname"
    End If
    DoCmd.OpenForm "frm_client2"
End Sub
Private Sub Form_Load()
    Set ws_server = New MSWinsockLib.Winsock
    ws_server.Protocol = sckUDPProtocol
    ws_server.Bind 1001
    Set ws_anser = New MSWinsockLib.Winsock
    ws_anser.Protocol = sckUDPProtocol
    Set l = New clientDao
End Sub
Private Sub ws_server_DataArrival(ByVal bytesTotal As Long)
    Dim msg As String
    ws_server.GetData msg
    Select Case msg
        Case "in":
            host_client = ws_server.remoteHostIP
            port_client = ws_server.remotePort
            Me.txt_output_server = "[" & ten_client & "]" & " login" & vbCrLf & _
                Me.txt_output_server
            Call l.Them(ten_client, host_client, port_client)
            Call MySendData("[" & ten_client & "]: login >")
        Case "out":
            host_client = ws_server.remoteHostIP
            port_client = ws_server.remotePort
            ten_client = l.Get_ten_client(host_client, port_client)
            Me.txt_output_server = "[" & ten_client & "]" & " logout" & vbCrLf & _
                Me.txt_output_server
            Call l.Xoa(host_client, port_client)
        Case Else:
            host_client = ws_server.remoteHostIP
            port_client = ws_server.remotePort
            ten_client = l.Get_ten_client(host_client, port_client)
            Me.txt_output_server = "[" & ten_client & "] :" & msg & vbCrLf & _
                Me.txt_output_server
            Call MySendData("[" & ten_client & "]: " & msg)
    End Select
End Sub

  
  2, frm_client và frm_client2 (Giống y chang frm_client)
  
  

  Mã:

  Option Compare Database
Public WithEvents ws_client As MSWinsockLib.Winsock
Const host_server As String = "localhost"
Const port_server As String = "1001"
Public Sub MySendData(txt As String)
    ws_client.RemoteHost = host_server
    ws_client.remotePort = port_server
    ws_client.SendData txt
End Sub
Private Sub btn_send_Click()
    If Not IsNull(txt_msg) Then
        Call MySendData(txt_msg)
    End If
End Sub
Private Sub Form_Load()
    Set ws_client = New MSWinsockLib.Winsock
    ws_client.Protocol = sckUDPProtocol
    Call MySendData("in")
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo sub_error
    Call MySendData("out")
sub_error:
    Resume Next
End Sub
Private Sub ws_client_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo sub_error
    Dim msg As String
    ws_client.GetData msg
    Me.txt_output = msg & vbCrLf & _
        Me.txt_output
sub_error:
    Resume Next
End Sub

  
  
  3, clientDto (sư phụ mình gọi là Quả bóng - Data transfer object)
  
  

  Mã:

  Option Compare Database
Public ten_client As String
Public host_client As String
Public port_client As String
Public Sub Class_Initialize()
    ten_client = ""
    host_client = ""
    port_client = ""
End Sub

  
  
  4, clientDao ( Băng đạn của khẩu đại liên server)
  
  

  Mã:

  Option Compare Database
Dim list As Collection
Private Sub Class_Initialize()
    Set list = New Collection
End Sub
Private Sub Class_Terminate()
    Set list = Nothing
End Sub
Public Function SoDong() As Long
    SoDong = list.Count
End Function
Public Sub Them(t As String, h As String, p As String)
    Dim c As clientDto
    Set c = New clientDto
    c.ten_client = t
    c.host_client = h
    c.port_client = p
    list.Add c
End Sub
Public Sub Xoa(host_client As String, port_client As String)
    Dim j As Integer
    j = 1
    For i = 1 To list.Count
        If (StrComp(list.Item(j).host_client, host_client, vbTextCompare) = 0 And StrComp(list.Item(j).port_client, port_client, vbTextCompare) = 0) Then
           list.Remove (j)
        Else
           j = j + 1
        End If
    Next i
End Sub
Public Function Get_ten_client(host_client As String, port_client As String) As String
    Dim i As Integer
    Dim kq As String
    kq = ""
    For i = 1 To list.Count
        If (StrComp(list.Item(i).host_client, host_client, vbTextCompare) = 0 And StrComp(list.Item(i).port_client, port_client, vbTextCompare) = 0) Then
            kq = list.Item(i).ten_client
        End If
    Next i
    Get_ten_client = kq
End Function
Public Function GetClient(i As Integer) As clientDto
    Set GetClient = list.Item(i)
End Function

  
  - Va day la file acc 2010 chat_demo_v3
  
  * chúc các bạn zui zẻ
  
  hix, à quên
  - Đừng nhập 2 user trùng tên cùng lúc nhé - Mình chưa kiểm tra user trùng tên trong CT!!! ( Trong Chương trình các bạn tên user là primary phải không? )

• RE: Thủ thuật winshock trong access vba đơn giản

  kieu manh > 07-02-19, 04:39 PM

  Mạnh đang tìm tài liệu viết cái Server và Client trên Excel mà vô tình sao trên đây cũng có
  
  1/ Vấn đề đặt ra là nếu bạn nào cài VB6 thì sẻ xài theo hướng dẫn bài 1 là ok
  2/ nếu bạn nào không cài VB6 mả copy File mswinsck.ocx Từ máy khác qua đăng ký là ko sử dụng được
  3/ Sử dụng thành phần của bên thứ 3 cho VBA thì nó tính phí và ko biết nó viết cái gì trong đó ???!!!
  4/ Mạnh nghĩ nghiên cứu Hàm Winsock API của windows là viết ok .... nhưng khó quá chưa biết bắt đầu từ đâu ???!!!
  5/ Còn viết trên VB6 là ok đó ... nhưng thấy nó lỗi thời rồi và ko còn được hổ trợ nữa
• Bài trước Bài tiếp