RecognizeLanguage/Form1.twin at main · fafalone/RecognizeLanguage · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
[Description("ELS Language Recognizer")]
[FormDesignerId("F31A56E2-C65E-4A48-82D6-E6D50B2A23C9")]
[PredeclaredId]
Class Form1
    '*****************************************************************
    'RecognizeLang v1.1.3
    'ELS Language Recognizer
    ' (c) 2025
    'by Jon Johnson, ported from example by Microsoft.
    '
    'Use the Windows ELS API MappingRecognizeText to determine the
    'language of given text.
    '
    'Requirements:
    'Windows 7+
    'WinDevLib v8.12.530+
    '
    'Project repository: https://github.com/fafalone/RecognizeLanguage
    '
    '*****************************************************************

    Private Function RecognizeLanguage(ByVal sText As String, pMatches As String()) As Long
        Dim EnumOptions As MAPPING_ENUM_OPTIONS
        Dim prgServices As LongPtr 'PMAPPING_SERVICE_INFO
        Dim dwServicesCount As Long
        Dim hr As Long
        Dim gSvc As UUID

        gSvc = ELS_GUID_LANGUAGE_DETECTION
        EnumOptions.Size = LenB(EnumOptions)
        EnumOptions.pGuid = VarPtr(gSvc)

        hr = MappingGetServices(EnumOptions, prgServices, dwServicesCount)

        If SUCCEEDED(hr) Then
            Dim bag As MAPPING_PROPERTY_BAG
            Dim pService As MAPPING_SERVICE_INFO = CType(Of MAPPING_SERVICE_INFO)(prgServices)

            bag.Size = LenB(bag)
            hr = MappingRecognizeText(pService, sText, Len(sText), 0, ByVal vbNullPtr, bag)
            If SUCCEEDED(hr) Then
                Dim pRange As MAPPING_DATA_RANGE = CType(Of MAPPING_DATA_RANGE)(bag.prgResultRanges)
                Dim cch As LongPtr
                Dim offset As LongPtr
                Dim sRes As String, nRes As Long
                Do
                    cch = wcslen(pRange.pData + offset)
                    If cch = 0 Then Exit Do
                    sRes = LPWSTRtoStr(pRange.pData + offset, False)
                    ReDim Preserve pMatches(nRes)
                    pMatches(nRes) = sRes
                    nRes += 1
                    offset += cch * 2 + 2
                Loop
                MappingFreePropertyBag(bag)
            Else
                Debug.Print "MappingRecognizeText error 0x" & Hex$(hr) & ", " & GetSystemErrorString(hr)
            End If
            MappingFreeServices(prgServices)
        Else
            Debug.Print "MappingGetServices error 0x" & Hex$(hr) & ", " & GetSystemErrorString(hr)
        End If
        Return nRes
    End Function

    Private Sub Command1_Click() Handles Command1.Click
        Dim sLang() As String
        Dim sOut As String
        If RecognizeLanguage(Text1.Text, sLang) Then
            For i As Long = 0 To UBound(sLang)
                If i = 0 Then
                    sOut = "Best match: " & sLang(0)
                Else
                    sOut &= vbCrLf & "Other result " & i & ": " & sLang(i)
                End If
            Next
            Text2.Text = sOut
        End If
    End Sub
End Class