Belajar Winsock Bagian Akhir – Contoh Kasus Mengakses Data Stok Barang Dari Luar

Akhirnya rilis juga artikel terakhir dari 5 seri belajar winsock ini, sebelum kita melanjutkan pembahasan ada baiknya kita melakukan sedikit review :

Dasar-dasar penggunaan winsock sudah kita pelajari
Ini terbukti dengan suksesnya kita membuat aplikasi chat sederhana
Di tambah lagi ada teman kita yang mau nebeng sehingga terciptanya aplikasi chat multiple connection
Jalan tol antara laptop mas Paijo dan komputer server tokonya juga udah selesai dibangun dengan anggaran 0 Rp :D

Berarti sekarang waktu yang tepat untuk mencoba ketangguhan mas Win (maksudnya Winsock :D) kalo lari jarak dekat (jaringan LAN) masih bisa diandalkan, bagai mana dengan lari jarak jauh (via internet) apakah juga masih bisa diandalkan ?

Objek-objek yang akan dijadikan korban untuk uji coba kali ini :

Database barang dengan format ms access
Aplikasi server
Aplikasi klien

Data yang dikirim dari server dibatasi maksimal 1024 karakter dalam sekali kirim, otomatis jika data > 1024 akan dipecah menjadi beberapa paket, berikut cuplikan kodenya (server) :

Option Explicit

Private Const LOCAL_PORT As Long = 1007

Private Const REC_SPR As String * 1 = "|" 'separator baris
Private Const FLD_SPR As String * 1 = "#" 'separator kolom
Private Const MAX_LIMIT As Long = 1024 '1x kirim dibatasi 1 kb, kalo untuk jaringan lokal masih bisa set 4096

Private Function pembulatanKeAtas(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
    Dim temp As Double

    temp = Int(X * Factor)
    pembulatanKeAtas = (temp + IIf(X = temp, 0, 1)) / Factor
End Function

Private Function getDataBarang(ByVal param As String) As String()
    Dim rs          As ADODB.Recordset

    Dim div         As Long
    Dim lengthData  As Long
    Dim n           As Long
    Dim i           As Long

    Dim tmp         As String
    Dim arrTmp()    As String

    strSql = "SELECT UCASE(nama), harga, stok FROM barang " & param & ""
    Set rs = openRecordset(strSql)
    If Not rs.EOF Then
        For i = 1 To getRecordCount(rs)
            tmp = tmp & rs(0).Value & FLD_SPR & rs(1).Value & FLD_SPR & rs(2).Value & REC_SPR

            rs.MoveNext
        Next i
        If Len(tmp) > 0 Then tmp = Left(tmp, Len(tmp) - 1)

        'karakter ~ sebagai penanda awal dan akhir data
        'untuk memudahkan pengecekan di klien bahwa data yg diterima sudah lengkap/belum
        'ex : ~DATA BARANG + SEPARATOR KOLOM DAN BARIS~

        'contoh format data disini ada 2 :
        '1. jika data <= 1024 karakter : ~~DATA BARANG + SEPARATOR KOLOM DAN BARIS
        '2. jika data > 1024 karakter  : ~DATA BARANG + SEPARATOR KOLOM DAN BARIS~

        If Len(tmp) > 0 Then tmp = "~" & Left(tmp, Len(tmp) - 1) & "~"
        If Not Len(tmp) > MAX_LIMIT Then
            tmp = Left(tmp, Len(tmp) - 1)
            tmp = "~" & tmp
        End If

        lengthData = Len(tmp)
        If lengthData > 0 Then
            If lengthData > MAX_LIMIT Then 'data > 1024 karakter
                'data dibuat menjadi beberapa package
                'ex : jika jumlah karakter 2345
                '     package 1 -> 1024
                '     package 2 -> 1024
                '     package 3 -> 297
                '     berarti data yg dikirim ke klien sebanyak 3 x

                div = pembulatanKeAtas(lengthData / MAX_LIMIT)
                ReDim arrTmp(div)

                n = 1
                For i = 1 To div
                    arrTmp(i - 1) = Mid(tmp, n, MAX_LIMIT)
                    n = n + MAX_LIMIT
                Next i

            Else
                ReDim arrTmp(0)
                arrTmp(0) = tmp
            End If

        Else
            ReDim arrTmp(0)
            arrTmp(0) = tmp
        End If

    Else
        ReDim arrTmp(0)
        arrTmp(0) = "EOF" 'data barang tidak ditemukan
    End If
    Call closeRecordset(rs)

    getDataBarang = arrTmp
End Function

pengiriman data ke klien akan dihandle oleh event DataArrival :

Private Sub Socket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim i           As Long
    Dim strData     As String
    Dim ret         As Boolean

    Dim arrTmp()    As String

    'On Error GoTo errHandle

    ' Grab the data from the specified Winsock object, and pass it to the parent.
    Call Socket(Index).GetData(strData)
    DoEvents

    arrTmp = getDataBarang(strData)
    For i = LBound(arrTmp) To UBound(arrTmp)
        If Len(arrTmp(i)) > 0 Then ret = send(Index, arrTmp(i))
    Next i

    Exit Sub
errHandle:
   Call Socket(Index).Close
End Sub

sedangkan untuk aplikasi klien bagian yg bertugas menerima data masih di event yang sama yaitu DataArrival :

Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
    Dim dataMasuk   As String

    'On Error Resume Next

    Socket.GetData dataMasuk

    If Left(dataMasuk, 2) = "~~" Then 'package data <= 1024
        Call execOutput(dataMasuk)

    ElseIf dataMasuk = "EOF" Then 'data tidak ditemukan
        Call execOutput(dataMasuk)

    Else
        'package data > 1024
        'berikut kode untuk penggabungan package data
        tmp = tmp & dataMasuk
        If InStr(1, dataMasuk, "~") > 0 Then packageHdr = packageHdr & "~"

        If Len(packageHdr) = 2 Then Call execOutput(tmp) 'penggabungan package data selesai
    End If
End Sub

dan ini prosedure yang bertanggung jawab untuk memparsing data dan menampilkan ke ListView :

Private Sub execOutput(ByVal data As String)
    Dim rec()   As String
    Dim fld()   As String

    Dim x       As Long
    Dim noUrut  As Long

    On Error GoTo errHandle

    Screen.MousePointer = vbHourglass
    DoEvents

    If Left(data, 2) = "~~" Then 'complete
        data = Replace(data, "~~", "")

    ElseIf data = "EOF" Then
        'do nothing

    Else
        data = Left(data, Len(data) - 1) 'remove ~ left
        data = Right(data, Len(data) - 1) 'remove ~ right
    End If

    lsvBarang.ListItems.Clear

    If data = "EOF" Then
        Screen.MousePointer = vbDefault
        MsgBox "Data barang dengan keyword '" & txtNamaBarang.Text & "' tidak ditemukan", vbInformation, "Informasi"

    Else
        'contoh data :
        '~~SUSU KEDELAI ABC 200M#1000#24|SUSU KEDELAI MELILEA 500#1000#0|KOPI SUSU KPL API 3P#1000#0|SUSU KEDELAI ABC 200#1000#2
        '| -> pemisah baris
        '# -> pemisah kolom

        rec = Split(data, REC_SPR)

        With lsvBarang
            noUrut = 1
            For x = LBound(rec) To UBound(rec)
                fld = Split(rec(x), FLD_SPR)

                .ListItems.Add , , noUrut
                .ListItems(noUrut).SubItems(1) = fld(0) 'nama barang
                .ListItems(noUrut).SubItems(2) = FormatNumber(fld(1), 0) 'harga
                .ListItems(noUrut).SubItems(3) = fld(2) 'stok

                noUrut = noUrut + 1
            Next x
        End With
    End If

    Screen.MousePointer = vbDefault

    Exit Sub
errHandle:
    Screen.MousePointer = vbDefault
End Sub

dan ini hasilnya

mas Paijo mengetikan keyword mie kemudian mengirimkannya ke server dan akan diproses dengan hasil rincian sbb :

Jumlah record yang ditemukan sebanyak 181 record
Jumlah karakter nama barang + harga + stok + seperator = 5084 karakter dan dikirim menjadi beberapa paket
Hasil akhir klien juga menampilkan sebanyak 181 record, yang berarti bahwa uji coba kita berhasil :D

Dan yang terpenting dari pembahasan ini, sample programnya bisa didownload disini :)

Selamat mencoba :)