Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Thủ Thuật] Thủ thuật winshock trong access vba đơn giản
#1
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...
Chữ ký của thucgia Hix, Access quả nhiên lợi hại !!!! http://vibigaba.esy.es/
ღღღღღTài sản của thucgia (View All Items) ღღღღღ
Reply
Những người đã cảm ơn maidinhdan
#2
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.
Chữ ký của maidinhdan * Để được hỗ trợ tốt nhất, nhấn vào link dưới đây để xem.
1. [Hướng dẫn] Kiểu file gửi lên để được giúp đỡ
2. [Hướng dẫn] Nội quy diễn đàn
3. [Hướng dẫn] Cách Đưa file và hình vào diễn đàn
4.[Hướng dẫn] Để xây dựng một ứng dụng hoàn hảo và lời cảm tạ
5. Cần tìm Demo hay ứng dụng sử dụng thanh tìm kiếm phía trên cùng, bên phải của diễn đàn.
* Nếu muốn cảm ơn, hãy nhấn nút thank, không cần viết thêm bài nào nửa.



ღღღღღTài sản của maidinhdan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#3
(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é.
Chữ ký của thucgia Hix, Access quả nhiên lợi hại !!!! http://vibigaba.esy.es/
ღღღღღTài sản của thucgia (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#4
(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...
Chữ ký của maidinhdan * Để được hỗ trợ tốt nhất, nhấn vào link dưới đây để xem.
1. [Hướng dẫn] Kiểu file gửi lên để được giúp đỡ
2. [Hướng dẫn] Nội quy diễn đàn
3. [Hướng dẫn] Cách Đưa file và hình vào diễn đàn
4.[Hướng dẫn] Để xây dựng một ứng dụng hoàn hảo và lời cảm tạ
5. Cần tìm Demo hay ứng dụng sử dụng thanh tìm kiếm phía trên cùng, bên phải của diễn đàn.
* Nếu muốn cảm ơn, hãy nhấn nút thank, không cần viết thêm bài nào nửa.



ღღღღღTài sản của maidinhdan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#5
(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
Chữ ký của thucgia Hix, Access quả nhiên lợi hại !!!! http://vibigaba.esy.es/
ღღღღღTài sản của thucgia (View All Items) ღღღღღ
Reply
Những người đã cảm ơn maidinhdan
#6
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?
Chữ ký của maidinhdan * Để được hỗ trợ tốt nhất, nhấn vào link dưới đây để xem.
1. [Hướng dẫn] Kiểu file gửi lên để được giúp đỡ
2. [Hướng dẫn] Nội quy diễn đàn
3. [Hướng dẫn] Cách Đưa file và hình vào diễn đàn
4.[Hướng dẫn] Để xây dựng một ứng dụng hoàn hảo và lời cảm tạ
5. Cần tìm Demo hay ứng dụng sử dụng thanh tìm kiếm phía trên cùng, bên phải của diễn đàn.
* Nếu muốn cảm ơn, hãy nhấn nút thank, không cần viết thêm bài nào nửa.



ღღღღღTài sản của maidinhdan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#7
(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
Chữ ký của thucgia Hix, Access quả nhiên lợi hại !!!! http://vibigaba.esy.es/
ღღღღღTài sản của thucgia (View All Items) ღღღღღ
Reply
Những người đã cảm ơn maidinhdan
#8
Để 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
Chữ ký của maidinhdan * Để được hỗ trợ tốt nhất, nhấn vào link dưới đây để xem.
1. [Hướng dẫn] Kiểu file gửi lên để được giúp đỡ
2. [Hướng dẫn] Nội quy diễn đàn
3. [Hướng dẫn] Cách Đưa file và hình vào diễn đàn
4.[Hướng dẫn] Để xây dựng một ứng dụng hoàn hảo và lời cảm tạ
5. Cần tìm Demo hay ứng dụng sử dụng thanh tìm kiếm phía trên cùng, bên phải của diễn đàn.
* Nếu muốn cảm ơn, hãy nhấn nút thank, không cần viết thêm bài nào nửa.



ღღღღღTài sản của maidinhdan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#9
(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? )
Chữ ký của thucgia Hix, Access quả nhiên lợi hại !!!! http://vibigaba.esy.es/
ღღღღღTài sản của thucgia (View All Items) ღღღღღ
Reply
Những người đã cảm ơn maidinhdan


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  [Hàm] Nhờ gở khó về hàm DLookup trong câu lệnh VBA phungminhluan 3 105 13-10-17, 07:24 PM
Bài mới nhất: phungminhluan
  [Thủ Thuật] Lọc điều kiện theo nhiều dòng trong 1 Listbox hoặc nhiều Listbox ongke0711 11 1,503 23-09-17, 04:54 PM
Bài mới nhất: ongke0711
  Làm sao chạy được code cả trong access 32 bit và access 64 bit haquocquan 1 142 12-09-17, 11:15 PM
Bài mới nhất: maidinhdan
  Hướng Dẫn Tư vấn import data(đuôi csv) vào file access nguồn subasatran 4 347 01-09-17, 03:20 PM
Bài mới nhất: subasatran
  [Hỏi] VBA Access: điều khiển lệnh Excel, Access khác vodainhan 10 1,038 19-07-17, 12:13 PM
Bài mới nhất: vodainhan

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ