Results 1 to 8 of 8

Thread: VB^ - SimpleServer

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,468

    VB^ - SimpleServer

    Note: Title should be VB6 - SimpleServer (can't edit)
    CSocket was originally developed by Oleg Gdalevich as a replacement for MSWinSck. Emiliano Scavuzzo improved upon it with CSocketMaster, and I converted it to support IPv6 with cSocket2. With NewSocket, I attempted to streamline the code. SimpleSock is a complete rewrite designed to further simplify and streamline socket code. SimpleServer is designed to allow a single listening socket to support multiple connections without having to resort to using a control array. Like all socket tools, it must be used properly to be effective.

    In theory, SimpleServer could be used for all socket access, but for only a few sockets, SimpleSock is simpler and easier to use. Understanding how SimpleServer works will allow you to make better use of it. There are 8 events or call-backs associated with a socket.
    1. CloseSck
    2. Connect
    3. ConnectionRequest
    4. DataArrival
    5. EncrDataArrival
    6. Error
    7. SendComplete
    8. SendProgress
    In SimpleServer, there is another one called WndProc, but it is not used and only provides access to the other events. With one exception (CloseSck), these routines are not called directly. They simply provide information to the calling program.

    The calling program Implements SimpleServer. That means that any procedure declared as Public in SimpleServer will be implemented in the calling program, and that includes the 8 routines noted above. When SimpleServer is first implemented, the individual routines have to be activated. This is accomplished by clicking on each one. As you do so, they will go from plain to bold text. Routines that we want to access from the calling program but we do not want to implement, are declared as Friend instead of Public.

    When we add an instance of a class with call-backs, we simply define the procedure "WithEvents" and add a new instance. With Implements, we can't do that. So we have to do the following instead:
    Code:
    Implements SimpleServer
    Private mServer() As New SimpleServer
    
        Dim lNum As Long
        ReDim mServer(MaxClients)
        For lNum = 0 To MaxClients
            Set mServer(lNum).Callback(lNum) = Me
            mServer(lNum).IPvFlg = 4
        Next
        ReDim RecLen(MaxClients)
        ReDim RecType(MaxClients)
    Adding the IPvFlg is not strictly necessary, because SimpleServer defaults to IPv4. But it is a good practice to get into. With SimpleServer, the listening socket is always the first instance.
    Code:
    mServer(0).Listen(PortListen)
    If SimpleServer was to be used to make a connection to another host, it would call "mServer(lIndex).TCPConnect Destination, PortConnect". Once the connection is established, SimpleServer would receive an "FD_CONNECT" and fire off a "Connect" message to the calling program. That would leave the calling program ready to start sending data.

    When a client attempts to connect, an "FD_ACCEPT" is received by SimpleServer, and it fires off a "ConnectionRequest" message to the calling program. If acceptable, the calling program sends "mServer(lIndex).Accept(requestID, RemotePort, RemoteHostIP)". If it is not acceptable, it sends "mServer(lIndex).Accept(requestID, 0, "")", and SimpleServer interprets the "0" port as invalid.

    Data is received by a socket in packets of approximately 1500 bytes. Of this, a maximum of 1460 bytes is actual data. Winsock assembles those packets into blocks of data that vary with the system. Windows Vista has a block size of 8,192 bytes, and Win 8.1 has a block size of 65,536 bytes. Winsock doesn't necessarily use all that space, it is just a maximum. Whatever criteria the OS uses, when it is ready it will send an "FD_READ" message to SimpleServer. For TCP, SimpleServer will add that data to it's own buffer (m_bRecvBuffer) and remove it from the Winsock buffer. It then fires off a "DataArrival"/"EncrDataArrival" message to the calling program along with the number of bytes just received. For UDP, SimpleServer will leave the data in the Winsock buffer, and notify the calling program of the bytes received.

    How the calling program handles this information depends on the program itself. SimpleServer will keep adding data to "m_bRecvBuffer" (TCP) until the calling program gives it instructions. In the sample program I have provided, I have used a header to provide more information about the data being sent. It includes a Record Type and Record Length. The Record Length tells the receiving program how much data to expect. Because the data length does not include the header itself, the header is removed from the buffer using the statements "Call mServer(Index).RecoverData(8)" & "RecHeader = mServer(Index).bInBuffer". The (8) is an optional number telling SimpleServer to only remove 8 bytes. If it was left out, SimpleServer would remove all bytes. If the Record Length includes the header, it can be recovered using the "PeekData" command and left in the buffer.

    All the data could be removed and analyzed in the "DataArrival"/"EncrDataArrival" routines, but that would mean separate buffers would be required for each connection, and I don't know how to create an array of byte arrays. Instead, we simply allow the data to accumulate in the "m_bRecvBuffer" in each instance of SimpleServer, and remove the desired amount when it is exceeded.

    Sending of data is similar. All the data is added to "m_bSendBuffer" regardless of size. When the calling program issues a TCPSend, it enters a loop. SimpleServer copies from "m_bSendBuffer" a maximum of the block size of the Winsock output buffer and forwards it to the Winsock API. If the API is successful in sending the data, it returns the number of bytes sent and they are removed from "m_bSendBuffer". It remains in the loop until all the bytes are sent. Should the API return an error "WSAEWOULDBLOCK", it means that the API is still busy sending the previous block. A message is sent to "SendProgress" with the total bytes sent and the bytes remaining, and the loop exited. When the Winsock output buffer is once again ready to send data, it sends an "FD_WRITE" message to SimpleServer, and SimpleServer calls TCPSend once again. When all the data has been sent, messages are sent to both "SendProgress" and "SendComplete".

    All SimpleServer errors (with the exception of "WSAEWOULDBLOCK") are forwarded to the calling program for action. Normally, in a server application errors are logged, so as to prevent holding up the program itself.

    That leaves the "CloseSck" event. There are 2 ways of closing the socket. Should the far end close the socket, Winsock will send an "FD_CLOSE" message to SimpleServer. SimpleServer will forward a message to "CloseSck" and change the socket state to "sckClosing". CloseSck will call "mServer(Index).CloseSocket" which will actually close the socket on the server side and change the socket state to "sckClosed". To close the socket from the server end, users should refrain from calling "CloseSocket" directly. This can cause the socket to remain in the "sckClosing" state and become unusable. Always call "CloseSck" in the calling program. As an added note, always include a routine in the "Form_Unload" event to close all sockets. Failure to do so can cause a port to become unusable.

    J.A. Coutts
    Attached Files Attached Files
    Last edited by couttsj; Mar 6th, 2019 at 02:46 PM.

  2. #2
    Lively Member
    Join Date
    Mar 2015
    Posts
    104

    Re: VB^ - SimpleServer

    Nice to see alternative winsock replacements used. I have been long thinking of making a small student test program, in which students complete some test questions in random order. Something to play around with. Many thanks couttsj (i always like your programs).

  3. #3

    Thread Starter
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,468

    Re: VB^ - SimpleServer

    Ran into a problem with SimpleSock. When using SimpleSock as a listening socket, the handle to the listening socket is restored when the connected socket is closed. Normally, that listening socket is retained, ready to receive the next connection request. On an application that I am currently working on, I needed to close the listening socket as well. When I attempted to do that, I received an unknown error (-1), and the program would stop functioning. Closing of a socket takes a little time as it waits for straggling packets, so I added a 1 second time delay between closing of the connected socket and closing of the listening socket.

    That solved one problem, but introduced another problem. Now I received an Error 10038 (WSAENOTSOCK) when attempting to close the listening socket after a connected socket was used. When SimpleSock accepts a connection request on a listening socket, it sets a flag (m_bAcceptClass). That flag was not reset when the listening socket itself was closed. Due to the way that a socket gets closed, there are actually 2 trips to the CloseSocket function. On the second pass, the API function attempted to close a non-existent socket. The problem was solved by resetting the "m_bAcceptClass" flag at the time the connected socket was closed (m_bAcceptClass = False) in the code below.
    Code:
    Public Function CloseSocket() As Boolean
        Const Routine As String = "SimpleSock.CloseSocket"
        Dim lErrorCode As Long
        Dim lRet As Long
        Dim bTmp() As Byte
        If Not m_hSocket = SOCKET_ERROR Then
            lRet = API_CloseSocket(m_hSocket)
            If lRet = -1 Then
                m_State = sckError
                lErrorCode = Err.LastDllError
                RaiseEvent Error(lErrorCode, "Could not Close Socket!", Routine)
            Else
                Call modSocket.UnregisterSocket(m_hSocket)
                m_hSocket = SOCKET_ERROR
                RaiseEvent CloseSck
                CloseSocket = True
                If m_bAcceptClass Then
                    m_hSocket = m_hListen
                    m_State = scklistening
                    Call PrintDebug(CStr(m_hSocket) & ": scklistening")
                    m_bAcceptClass = False
                Else
                    m_State = sckClosed
                    Call PrintDebug("STATE: sckClosed")
                End If
                m_sLocalIP = vbNullString
                m_sRemoteHostIP = ""
                m_bRecvBuffer = bTmp
                m_bSendBuffer = bTmp
                m_lSendBufferLen = 0
                m_lRecvBufferLen = 0
            End If
        End If
    End Function
    The SimpleSock download has not been adjusted, and SimpleServer does not experience the same issue because all sockets are numbered, including the listening socket (socket 0).

    J.A. Coutts

  4. #4
    Banned
    Join Date
    May 2020
    Location
    https://t.me/pump_upp
    Posts
    42

    Re: VB^ - SimpleServer

    Hi, couttsj
    I have read a lot of your articles and find them very interesting and useful
    can you show me a little bit ?!

    1 / When from the Server, I take a data area into the Array
    for example: vArray = Sheet1.Range ("A1: K100"). value (Using ADO get data into vArray)
    How can I send Client 1 Array like that?

    2 / After the Server sends vArray to the Client, how does the Client receive vArray and assign the results to Excel ????

    if you are looking forward to your guidance
    Thank you
    Last edited by PhuongNam; Sep 29th, 2020 at 11:22 PM.

  5. #5

    Thread Starter
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,468

    Re: VB^ - SimpleServer

    Quote Originally Posted by PhuongNam View Post
    Hi, couttsj
    I have read a lot of your articles and find them very interesting and useful
    can you show me a little bit ?!

    1 / When from the Server, I take a data area into the Array
    for example: vArray = Sheet1.Range ("A1: K100"). value (Using ADO get data into vArray)
    How can I send Client 1 Array like that?

    2 / After the Server sends vArray to the Client, how does the Client receive vArray and assign the results to Excel ????

    if you are looking forward to your guidance
    Thank you
    I don't know what "vArray" is, but it sounds like it might be a Variant Array. SimpleServer and SimpleSock only understand Byte Arrays. I have provided routines to convert ASCII text and Unicode text, but it does not understand Variant Arrays. If you are indeed using Variant Arrays, you would have to provide a routine to perform that conversion.

    J.A. Coutts

  6. #6
    Banned
    Join Date
    May 2020
    Location
    https://t.me/pump_upp
    Posts
    42

    Re: VB^ - SimpleServer

    Quote Originally Posted by couttsj View Post
    I don't know what "vArray" is, but it sounds like it might be a Variant Array. SimpleServer and SimpleSock only understand Byte Arrays. I have provided routines to convert ASCII text and Unicode text, but it does not understand Variant Arrays. If you are indeed using Variant Arrays, you would have to provide a routine to perform that conversion.

    J.A. Coutts
    Sorry the day before, I asked without a detailed description ... after a while I researched and couldn't do it, please help me
    I describe as follows:
    1 / At the Server App.path, create a File called ServerDatabase.accdb
    When Server and Client connect to each other, the Server side connects to File ServerDatabase.accdb by ADODB method to get data from tablename into vArray and then send to Client.
    2 / When the server sends vArray to the client, how does the client receive vArray and assign that vArray data to Excel?
    For example: on VBA, I use a function to convert the Array vArray, then Resize vArray to Sheet is finished

    Example on VBA:
    Code:
    Option Explicit
    Dim cnn As New Connection
    Dim Rst As New Recordset
    Dim cFileName As String
    Dim vArray() As Variant
    Dim NewArray() As Variant
    Dim SQL As String
    Rem ==========
    Private Function TransposeArray(InputArr As Variant) As Variant
        Dim RowNdx, ColNdx, LB1, LB2, UB1, UB2 As Long
        Dim vArray As Variant
        LB1 = LBound(InputArr, 1)
        LB2 = LBound(InputArr, 2)
        UB1 = UBound(InputArr, 1)
        UB2 = UBound(InputArr, 2)
        ReDim vArray(LB2 To LB2 + UB2 - LB2, LB1 To LB1 + UB1 - LB1)
        For RowNdx = LB2 To UB2
            For ColNdx = LB1 To UB1
                vArray(RowNdx, ColNdx) = InputArr(ColNdx, RowNdx)
            Next
         Next
        TransposeArray = vArray
    End Function
    Rem ==========
    Sub CopyArrayFormDatabase()
        Rem Folder "\\192.168.1.115\Access Databases" LAN is share full
        Rem cFileName = "\\127.0.0.1\D$\QLBHPN Telecom\ServerDatabase.accdb"            ''Run Ok
        Rem cFileName = "\\127.0.0.1\D:\QLBHPN Telecom\ServerDatabase.accdb"            ''Run Err
        cFileName = ThisWorkbook.Path & "\ServerDatabase.accdb"
        Rem Connect to Access database
        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & cFileName
        SQL = "select * from DataBaseNhap"
        Set Rst = cnn.Execute(SQL)
        vArray = Rst.GetRows()
        NewArray = TransposeArray(vArray)
        
        With Range("A1")
            .Resize(UBound(NewArray, 1), UBound(NewArray, 2)).ClearContents
            .Resize(UBound(NewArray, 1) + 1, UBound(NewArray, 2) + 1).Value = NewArray
        End With
        
        Rem ==========
        ''Range("A5:G1000").ClearContents 'Clear values on range
        Rem Paste all records in recordset to range
        ''Range("A1").CopyFromRecordset Rst
        Rem Close connection and free memory
        Rst.Close
        Set Rst = Nothing
        cnn.Close
        Set cnn = Nothing
    End Sub
    On VB6 Server I do the following, how can I send that vArray to the Client (Unicode text)

    Code:
    Rem ========== Uses Excel
    Rem Project/References/Microsoft Excel 16.0 Object
    Rem Project/References/Microsoft Office Excel 16.0 Object
    Public ExcelApp As New Excel.Application
    Dim wBook As Excel.Workbook                                 ''khai bao su dung Workbook
    Dim wSheet As Excel.Worksheet                               ''khai bao su dung Worksheet
    Dim sheet As Excel.Worksheet                                ''khai bao su dung Worksheet
    Dim Rng As Excel.Range                                      ''khai bao su dung Range
    Rem ==========  Path Database ...
    Dim ConString As String, DataPath As String
    Dim SQL As String, Pro As String
    Rem ========== Uses Array
    Dim vArray() As Variant
    Dim ReturnArray() As Variant
    Rem ========== Uses ADODB
    Rem Project/References/Microsoft ActiveX Data Object 2.8 Library
    Dim cn As New Connection
    Dim Rs As New Recordset
    Private Sub SimpleServer_DataArrival(ByVal Index As Long, ByVal bytesTotal As Long)
        Dim bData() As Byte
        Dim RecHeader() As Byte
        Dim bResponse() As Byte
    GetNextRecord:
        If RecLen(Index) = 0 Then 'Remove header
        Call mServer(Index).RecoverData(8)
        RecHeader = mServer(Index).bInBuffer
        Call DebugPrintByte("Header", RecHeader)
        CopyMemory ByVal VarPtr(RecLen(Index)), RecHeader(4), 4
        RecLen(Index) = ntohl(RecLen(Index))
        RecType(Index) = RecHeader(0)
        bytesTotal = bytesTotal - 8
    End If
    Debug.Print bytesTotal, RecLen(Index)
    If bytesTotal >= RecLen(Index) Then
        Call mServer(Index).RecoverData(RecLen(Index))
        bData = mServer(Index).bInBuffer
        Debug.Print CStr(GetbSize(bData)) & " bytes rec'd."
        bytesTotal = bytesTotal - RecLen(Index)
        Select Case RecType(Index)
            'The use of a header tells the server how much data to expect, and
            'allows the server to react differently to different types of requests.
        Case Else
            text1.Text = text1.Text & ByteToUni(bData) & vbCrLf
            text1.SelStart = Len(text1.Text)
            bResponse = CStr(RecLen(Index)) & " Rec'd."
            Rem ==========
            DataPath = App.Path & "\ServerDatabase.accdb"
            SQL = "select * from DataBaseNhap"
            Pro = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DataPath
            cn.Open (Pro)
            Set Rs = cn.Execute(SQL)
            vArray = Rs.GetRows()               ''Send vArray To Client ????
            Rem ==========
            Call AddRecHeader(0, bResponse)
            mServer(Index).bOutBuffer = bResponse
            mServer(Index).TCPSend
        End Select
        RecLen(Index) = 0
        RecType(Index) = 0
        ReDim RecHeader(0)
        If bytesTotal > 0 Then GoTo GetNextRecord
    Else
        'Wait for all the data
    End If
    End Sub
    3 / After the Server sends the Client vArray, how the Client receives vArray
    Looking forward to your help ... Thank you

    Sorry I can't upload files

  7. #7

    Thread Starter
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,468

    Re: VB^ - SimpleServer

    PhuongNam;

    A Variant Array is simply a pointer to a descriptor. When utilized within the same machine that descriptor is common to all routines, but when sent to another machine over the network, it is meaningless. Below is an example of converting string data to a variant array taken from my email client program "JACMail3".
    Code:
       'Add message to the database
       ArrayBuffer = SplitMessage(strBuffer)
       Result = UpdateDBIn(ArrayBuffer)
    
    Function SplitMessage(message As String) As Variant
        On Error Resume Next
        Dim Pt1           As Long
        Dim Pt2           As Long
        Dim Pt3           As Long
        Dim Pt4           As Long
        Dim strTemp       As String
        Dim strEncode     As String
        Dim FileName      As String
        Dim bTmp()        As Byte
        Dim NameArray(0 To 1)   As String
        Dim NumFile%
        Dim N%
        Dim arrx(0 To 5)  As String
        'separate the message body from the header
        Pt1 = InStr(1, message, vbCrLf & vbCrLf)
        If Pt1 > 0 Then
            'Include one CrLf
            arrx(4) = Left$(message, Pt1 + 2)
        Else
            arrx(4) = "Blank Header!" & vbCrLf
        End If
    '    Debug.Print "Header" & vbCrLf & arrx(4)
        arrx(5) = Right$(message, Len(message) - Pt1 - 3)
        'Find Server unique-ID & adjust ID buffer
        Pt1 = InStr(strID, "|") + 1
        Pt2 = InStr(strID, vbCrLf)
        If Pt2 > Pt1 Then
            arrx(0) = Mid$(strID, Pt1, Pt2 - Pt1)
        Else
            arrx(0) = "<ID-Error" & Mid$(CStr(Rnd), 3) & ">"
        End If
        strID = Mid$(strID, Pt2 + 2)
        'Find free standing Sender: line
        strTemp = FindStringRev(arrx(4), vbCrLf & "sender:")
        If Len(strTemp) Then
            arrx(1) = Trim(strTemp)
            Debug.Print "Sender found = " & arrx(1)
        Else
            'No free standing Sender, check for Orig sender
            strTemp = FindStringRev(arrx(4), "sender:")
            If Len(strTemp) Then
                arrx(1) = Trim(strTemp)
                Debug.Print "Orig Sender: found! ";
            Else
                'No Orig sender, check for From: line
                strTemp = FindStringRev(arrx(4), "from:")
                If Len(strTemp) Then
                    Debug.Print "From: found! ";
                    arrx(1) = Trim(strTemp)
                Else
                    Debug.Print "No Sender Found!"
                    'Sender cannot be blank!
                    arrx(1) = "_"
                End If
            End If
            Debug.Print arrx(1)
        End If
        'Check for max length exceeded
        If Len(arrx(1)) > 50 Then arrx(1) = Left$(arrx(1), 45) & String$(5, ".")
        'Find free standing Subject: line
        strTemp = FindStringRev(arrx(4), vbCrLf & "subject:")
        If Len(strTemp) Then
            arrx(2) = Trim(strTemp)
            Debug.Print "Subject found = " & arrx(2)
        Else
            Debug.Print "No Subject Found!"
            'Subject cannot be blank!
            arrx(2) = "_"
        End If
        'Check for max length exceeded
        If Len(arrx(2)) > 50 Then arrx(2) = Left$(arrx(2), 45) & String$(5, ".")
        'Check for Attachment         "Content-Converted: "
        Pt1 = 1
        strTemp = FindString(arrx(5), vbCrLf & "Content-Disposition:", Pt1)
        'Check for image files without disposition (Outlook Express Bug)
        If Len(strTemp) = 0 Then strTemp = FindString(arrx(5), vbCrLf & "Content-Type: image/", Pt1)
        Do Until Len(strTemp) = 0
            'Find beginning of Description and encoding type
            Pt3 = InStrRev(arrx(5), vbCrLf & "--", Pt1)
            strEncode = FindString(arrx(5), vbCrLf & "Content-Transfer-Encoding:", Pt3)
            'Find end of description (Beginning of attachment)
            Pt2 = InStr(Pt1, arrx(5), vbCrLf & vbCrLf) + 4
            strTemp = Mid$(arrx(5), Pt1, Pt2 - Pt1)
            'Sometimes tabs are placed on second line
            strTemp = Replace(strTemp, vbTab, "")
            Debug.Print strTemp
            If LCase(strEncode) <> "base64" Then GoTo Continue
            FileName = FindString(strTemp, "name", Pt4)
            FileName = Replace(FileName, "=", "")
            FileName = Trim(Replace(FileName, Chr$(34), ""))
            'This should not happen , but check for no filename supplied
            If Len(FileName) = 0 Then
                N% = InStr(strTemp, vbCrLf)
                If N% = 0 Then
                    FileName = "Unknown."
                Else
                    FileName = Mid$(CStr(Rnd), 3) & "." & Left$(strTemp, N% - 1)
                End If
            End If
            'Check for HTML tags as they will produce illegal file name
            N% = InStrRev(FileName, "<")
            If N% > 1 Then FileName = Left$(FileName, N% - 1)
            'Check if File already exists in UserPath & \JACMail\Attach\
            N% = InStrRev(FileName, ".")
            NameArray(0) = Left$(FileName, N% - 1)
            NameArray(1) = Mid$(FileName, N%)
            N% = 0
            Do Until Len(Dir(UserPath & "Attach\" & FileName)) = 0
                FileName = NameArray(0) & "(" & CStr(N%) & ")" & NameArray(1)
                N% = N% + 1
            Loop
            Pt3 = InStr(Pt2, arrx(5), vbCrLf & "--")
            If Pt3 > Pt2 Then 'Do not store zero length files
                NumFile% = OpenFile(UserPath & "Attach\" & FileName, 5, 0, 512)
                If NumFile% = 0 Then
                    MsgBox "File Error with " & FileName, 16, "ABORT PROCEDURE"
                    Exit Function
                End If
                Bas64.Base64Buf = (Mid$(arrx(5), Pt2, Pt3 - Pt2))
                Call Bas64.Base64Decode
                bTmp = Bas64.bBuffer
                Put #NumFile%, , bTmp
                Close NumFile%
                arrx(3) = True 'Attachment flag
                Pt4 = InStr(Pt4, strTemp, vbCrLf) 'Find end of line after filename
                strTemp = "Content-Converted: Filename:" & FileName & Mid$(strTemp, Pt4)
                Debug.Print strTemp
                arrx(5) = Left$(arrx(5), Pt1 - 21) & strTemp & Mid$(arrx(5), Pt3)
            End If
    Continue:
            Pt1 = Pt2
            strTemp = FindString(arrx(5), vbCrLf & "Content-Disposition:", Pt1)
            If Len(strTemp) = 0 Then strTemp = FindString(arrx(5), vbCrLf & "Content-Type: image/", Pt1)
            Pt4 = 1
        Loop
    'return the array
        SplitMessage = arrx
    End Function
    
    Function UpdateDBIn(BufArray As Variant) As Boolean
        Dim AddData As New ADODB.Recordset
        On Error GoTo UpdateDBInErr
        AddData.CursorType = adOpenKeyset
        AddData.LockType = adLockOptimistic
        AddData.Open "InBox", adoConn1, , , adCmdTable
        With AddData
            .AddNew
            !Msg_id = BufArray(0)
            !R_Date = CStr(Now)
            !Sender = BufArray(1)
            !subject = BufArray(2)
            !A = BufArray(3)
            !Header = BufArray(4)
            !Body = BufArray(5)
            .Update
        End With
        LastID = BufArray(0) 'adjust end pointer
        Call SaveSettings("LastID", LastID)
        Exit Function
    UpdateDBInErr:
        lblStatus.Caption = "Error " & CStr(Err) & " On Update InBox!"
        Resume Next
    End Function
    The data comes in as string data separated by CrLf. That is one way of transferring the information by using a data separator. It is somewhat more complex than what you might need, but you get the idea.

    In the same program, data is read from a DataGrid as a variant array using a general use subroutine called "GetLocalData". Then "vData" is transferred to individual variables that have meaning within the program.
    Code:
    Private Sub mnuRead_Click()
        Dim Result As Long
        Dim vKeys As Variant
        Dim vExceptions As Variant
        Dim vData As Variant
        Dim QPflg As Boolean
        DataGrid1.Col = 0
        db_ID = DataGrid1.Text
        vKeys = "SELECT Header, Body, R_Date From " & lblBox.Caption & " WHERE ID = " & db_ID & ";"
        Result = GetLocalData(vKeys, vData, vExceptions)
        If Result Then
            HeaderBuffer = vData(0, 0)
            If InStr(HeaderBuffer, "quoted-printable") > 0 Then QPflg = True
            MessageBuffer = vData(1, 0)
            If InStr(MessageBuffer, "quoted-printable") > 0 Then QPflg = True
            RDateBuffer = vData(2, 0)
            If chkDecode And QPflg Then
                MessageBuffer = DecodeQP(MessageBuffer)
            End If
            'Check if text is Base64 encoded
            strEncode = FindStringRev(HeaderBuffer, vbCrLf & "Content-Transfer-Encoding:")
            If UCase(strEncode) = "BASE64" Then
                Bas64.Base64Buf = MessageBuffer
                Call Bas64.Base64Decode
                MessageBuffer = ByteToStr(Bas64.bBuffer)
            End If
            'Update database as message read
            DataGrid1.Col = 3
            If DataGrid1.Text = False Then
                DataGrid1.Text = True
                'Trigger update
                Adodc1.Recordset.MovePrevious
                Adodc1.Recordset.MoveNext
            End If
        End If
        DataGrid1.SetFocus
        Call CreateNewReadMessageForm(db_ID)
        DataGrid1.Col = 0
    End Sub
    Hope this helps.

    J.A. Coutts

  8. #8
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,207

    Re: VB^ - SimpleServer

    Quote Originally Posted by PhuongNam View Post
    ...
    3 / After the Server sends the Client vArray, how the Client receives vArray
    ...
    What you need is called: "serialization" (to and from ByteArrays).
    And an ideal ContainerObject with support for this is:
    (who'd have thought) ... an ADO-Rs.

    Since this question (remote-access to serverside DBs) is asked quite often recently,
    I've now put an "as simple as possible" Demo-Project into the CodeBank:
    https://www.vbforums.com/showthread....ss-via-http(s)

    HTH

    Olaf

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width