Remplace dans une texte, l'expression d'une fonction par une autre

Commenter

Contenu du snippet 

'Sur une idée originale de (c) ARMEL SIME NGONGANG, conception et réalisation
'Cette fonction permet de remplacer le texte d'une fonction par une autre. La fonction est récursive.
'Je l'ai écrite ce matin, afin de traduire les requêtes Access pour qu'elles soient comptable SQL Server, exemple des fonction IIF, ISNULL, ... mais l'utilisation peut être encore plus générale.
'Le but de cette fonction n'est pas de valider la conformité de l'expression mais juste, mais il s'agit d'un traitement de texte simpliste et assez cool.
'J'ai fait une mise à jour de la version précédente, qui était orientée pour mes besoins ponctuels celui de traduire du texte SQL Access vers SQL Server. Il peut également être utilisé intelligemment pour traduire du code.



'psText est le texte de départ, ou l'expression texte
'psFunctionName est le nom de la fonction
'psPattern est le masque de la function de destination, les paramètres sont indiqués dans le pattern, [%1] designe le paramètre1, [%2] le paramètre2, ....





Public Function ConvertFunctionText(ByVal psText As String, _
    ByVal psFunctionName As String, _
    ByVal psPattern As String, _
    Optional ByVal plStart As Long = -1, _
    Optional ByVal psTextDelimiter As String = "'") As String
Dim lPos As Long, lParentheses As Long, bTextOn As Boolean, sCar As String, lLenText As Long
Dim lPos0 As Long, lPos1 As Long, lPos2 As Long, aParameters As Variant, i As Long, sPatternReplace As String, bFoundOK As Boolean
    
    'Identifie "psTextDelimiter" à l'intérieur d'un texte
    psText = Replace(psText, psTextDelimiter & psTextDelimiter, Chr(1))
    
    lLenText = Len(psText)
    
    'Lit la function en partant de la droite vers la gauche
    lPos = InStrRev(psText, psFunctionName, plStart, vbTextCompare)
    If lPos <> 0 Then
        'Recupère dans la variable lPos0, la position de la function dans le texte
        lPos0 = lPos
        lPos = lPos0 + Len(psFunctionName)
        
        'Verifie qu'il s'agisse bien du début de texte de la function
        If lPos0 <> 1 Then
            If InStr(1, "+-*/\^&<>=(){}, ", Mid(psText, lPos0 - 1, 1)) <> 0 Then bFoundOK = True
        Else
            bFoundOK = True
        End If
        
        'Si la function est trouvée, la suite devrait être "("
        If bFoundOK Then
            Do While Mid(psText, lPos, 1) = " "
                lPos = lPos + 1
            Loop
            bFoundOK = (Mid(psText, lPos, 1) = "(")
        End If
        
        If bFoundOK Then
            'La function a bien été identifiée
            lParentheses = 0
            lPos = lPos + 1
            'Sauver dans lpos1, la position de debut des paramètres de la function
            lPos1 = lPos
            Do
                'Lire le caractère
                sCar = Mid(psText, lPos, 1)
                If Not bTextOn Then
                    Select Case sCar
                        Case "(":
                            'Compter les parenthèses
                            lParentheses = lParentheses + 1
                        Case ",":
                            'Si pas de parenthèse ouverte, alors il s'agit du séparateur de paramètre
                            If lParentheses = 0 Then Mid(psText, lPos, 1) = Chr(2)
                        Case psTextDelimiter:
                            'Il s'agit d'un debut de texte
                            bTextOn = True
                        Case ")":
                            'Si pas de parenthese ouverte, alors il s'agit de la fin des paramètres de la function
                            If lParentheses = 0 Then
                                sPatternReplace = psPattern
                                'Sauver dans lpos1, la position de fin des paramètres de la function
                                lPos2 = lPos - 1
                                
                                'Lire les paramètres de la function
                                aParameters = Split(Mid(psText, lPos1, lPos2 - lPos1 + 1), Chr(2))
                                'Remplacer dans le Pattern, les paramètres de la function de départ
                                For i = LBound(aParameters) To UBound(aParameters)
                                    sPatternReplace = Replace(sPatternReplace, "[%" & i + 1 & "]", Trim(aParameters(i)))
                                Next i
                                Erase aParameters
                                
                                'Recomposer l'expression de départ
                                psText = Left(psText, lPos0 - 1) & sPatternReplace & Mid(psText, lPos2 + 2)
                                'Rechercher s'il existe la function dans le texte restant
                                If lPos0 > 1 Then psText = ConvertFunctionText(psText, psFunctionName, psPattern, lPos0 - 1)
                                
                                Exit Do
                            Else
                                'La parenthèse n'est pas ouverte alors décompter les parenthèses
                                lParentheses = lParentheses - 1
                            End If
                        Case Else:
                    End Select
                ElseIf sCar = psTextDelimiter Then
                    bTextOn = False
                End If
                lPos = lPos + 1
            Loop While (lPos <= lLenText)
        ElseIf lPos0 > 1 Then
            'La function a été identifiée mais avec une syntaxe incorrecte, il faut l'ignorer et poursuivre la recherche
            psText = ConvertFunctionText(psText, psFunctionName, psPattern, lPos0 - 1)
        End If
    End If
    
    psText = Replace(psText, Chr(1), psTextDelimiter & psTextDelimiter)
    ConvertFunctionText = psText
End Function

Compatibilité : VB6

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_asimengo)