• Trang chủ click to expand contents 

  • 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ẽ

    [Hình: referrenc_mswinshock.jpg]

    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ả

    [Hình: giao_dien.jpg][/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é....034

  • 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é....034

    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
    [Hình: chat_v3_giao_dien_1.jpg]
    - Second user logout
    [Hình: chat_v3_giao_dien_2.jpg]

    - 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ẻ 034

    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