6 48 1 VB Example

LANSA Open Guide

6.48.1 VB Example

Public Type FIELD_DETAIL

    fieldLen As Long

    flags As Long

End Type

 

Public Const TOTAL_FIELDS = 2

 

Sub SetSkillsList()

    ' reads all skill descriptions and populates the skill list

    On Error Resume Next

    

    Dim iRet As Integer

    Dim i As Integer

    Dim sBuff As String 

    Dim sTemp As String

    Dim iPos As Long

    Dim iLovalPos As Long

    Dim fldData(TOTAL_FIELDS) As FIELD_DETAIL

 

    ' remove any previous query results 

    iRet = LceDeleteSelect(iSession, "SKLTAB")

    

    ' Request select

    ' Set Select to IMMEDIATE MODE is recommended to increase speed

    iRet = LceSetSelectOptions(iSession, "*RECEIVEIMMED")

    iRet = LceRequestSelect(iSession, "SKILCODE,SKILDESC", "SKLTAB", _

           "", False)

 

    ' Clear previous selection

    sBuff = String(FIELD_DATA_SIZE, Chr(0))

    lstSkills.Clear

    ReDim SkillKey(0)

    i = 0 ' reset counter

 

    'Read all records selected

    While LceReceiveNextX(iSession, sBuff, FIELD_DATA_SIZE, fldData(0), TOTAL_FIELDS) = LceTrue

        ReDim Preserve SkillKey(i + 1) ' resize array key

 

        iPos = 1

        If (fldData(i).flags = 1) Then

            ' Display error as key field should not be Null

        Else

            sTemp = Trim(Mid(sBuff, iPos, fldData(0).fieldLen))

            iLovalPos = InStr(1, sTemp, Chr(0), vbTextCompare)

            If iLovalPos > 0 Then

                sTemp = Trim(Left(sTemp, iLovalPos - 1))

            End If

 

            SkillKey(i) = sTemp 

 

            iPos = iPos + fldData(0).fieldLen

 

            If (fldData(i).flags = 1) Then

                ' Value is SQLNULL 

                sTemp = "No description provided"

            Else

                sTemp = Trim(Mid(sBuff, iPos, fldData(1).fieldLen))

                iLovalPos = InStr(1, sTemp, Chr(0), vbTextCompare)

                If iLovalPos > 0 Then

                    sTemp = Trim(Left(sTemp, iLovalPos - 1))

                End If

            End If

 

            lstSkills.AddItem sTemp 

        End If

 

        i = i + 1 ' increment index

 

    Wend

    ' select first record

    If lstSkills.ListCount > 0 Then lstSkills.ListIndex = 0

End Sub