[VB6, Win8+] Using the system spellchecker: Add spellcheck with only a few lines

[fafalone]

ISpellChecker Demo

About
Windows 8 introduced the Spell Checking API, a set of interfaces and a default implementation for the system spellchecker. The ISpellChecker interface is fairly straightforward to use, and returns the positions of words you should autocorrect to a given word, delete entirely, or it offers a list a suggestions if neither of those apply. You can add custom words, custom autocorrects, and words to ignore, and these are automatically saved as you're adding them to the system list (there's a remove option as well) by default, but there's a dictionary registrar that may help (not quite sure how that works yet).

The demo shows basic usage-- it doesn't automatically apply the corrections list yet, maybe in the future.

Requirements
-Windows 8 or newer
-oleexp 4.43 or higher (new release for this project on 5/18)

Code
The basic code for running a spellcheck looks like this:

Private pSPFact As SpellCheckerFactory
Private pChecker As ISpellChecker

Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long


Private Sub CheckSpelling(sText As String)
Dim pErrors As IEnumSpellingError
Dim pError As ISpellingError

Dim lStart As Long, lLen As Long
Dim lpsz As Long, sz As String

Dim s1 As String, s2 As String

Dim sSug() As String
Dim nSug As Long

Dim lf As Long
If (pSPFact Is Nothing) Then
    Set pSPFact = New SpellCheckerFactory
    Set pChecker = pSPFact.CreateSpellChecker(StrPtr(Text3.Text))
End If

Set pErrors = pChecker.Check(StrPtr(sText))

Do While pErrors.Next(pError) = S_OK
    Select Case pError.CorrectiveAction
        
        Case CORRECTIVE_ACTION_DELETE
            lStart = pError.StartIndex() + 1
            lLen = pError.Length()
            s1 = Mid$(sText, lStart, lLen)
            Text2.Text = Text2.Text & "Delete: " & s1 & vbCrLf
        
        Case CORRECTIVE_ACTION_REPLACE
            lStart = pError.StartIndex() + 1
            lLen = pError.Length()
            s1 = Mid$(sText, lStart, lLen)
            lpsz = pError.Replacement()
            sz = LPWSTRtoStr(lpsz)
            Text2.Text = Text2.Text & "Replace " & s1 & " with " & sz & vbCrLf
        
        Case CORRECTIVE_ACTION_GET_SUGGESTIONS
            Dim pIES As IEnumString
            lStart = pError.StartIndex() + 1
            lLen = pError.Length()
            s1 = Mid$(sText, lStart, lLen)
            Set pIES = pChecker.Suggest(StrPtr(s1))
            ReDim sSug(0)
            
            Do While pIES.Next(1&, lpsz, lf) = S_OK
                ReDim Preserve sSug(nSug)
                sSug(nSug) = LPWSTRtoStr(lpsz)
                nSug = nSug + 1
            Loop
            
            Text2.Text = Text2.Text & "Error: " & s1 & "; suggestions: " & Join(sSug, ",") & vbCrLf
    
    End Select
    
    lStart = 0
    lLen = 0
    lpsz = 0
    nSug = 0
Loop

End Sub


Public Function LPWSTRtoStr(lPtr As Long, Optional ByVal fFree As Boolean = True) As String
SysReAllocString VarPtr(LPWSTRtoStr), lPtr
If fFree Then
    Call CoTaskMemFree(lPtr)
End If
End Function

(this refers to the textboxes on the form from the demo, it's not a standalone function you can copy and paste without the demo or similar textbox setup)