VB2HTML

Public Function vb2html(szCode As String) As String
' Principe : On parcourt le code ligne par ligne pour isoler les lignes de commentaire
' ensuite on parse chaque ligne à la recherche de keyword

Dim szLigne() As String
Dim tmpCode As String
Dim szTampon As String
Dim i As Long
Dim j As Long
Dim bChaine As Boolean
bChaine = False

If mcolKeyword Is Nothing Then loadKeyword
' on stocke le code dans un tableau
szLigne = Split(szCode, vbCrLf)

tmpCode = vbNullString
For i = LBound(szLigne) To UBound(szLigne)
    
    If Trim$(szLigne(i)) Like "'*" Then ' c'est une ligne complète en commentaire
        tmpCode = tmpCode & mComment & htmlEncode(szLigne(i)) & mFin & "<BR>" & vbCrLf
    Else
        szTampon = vbNullString
        For j = 1 To Len(szLigne(i)) + 1
            
            
            If bChaine Then
                ' on est dans une chaine de caractères on recopie sans rien changer
                tmpCode = tmpCode & htmlEncode(Mid$(szLigne(i), j, 1))
            ElseIf Mid$(szLigne(i), j, 1) <> """" Then ' nous ne sommes pas dans une chaine de caractères
                ' commentaire de fin de ligne
                If Mid$(szLigne(i), j, 1) = "'" And Not bChaine Then
                    tmpCode = tmpCode & mComment & Mid$(szLigne(i), j) & mFin & "<BR>" & vbCrLf
                    Exit For
                End If
                
            
                If j > Len(szLigne(i)) Then
                    If isKeyword(Trim$(szTampon)) Then
                        If Mid$(szLigne(i), j, 1) <> "(" Then
                            tmpCode = tmpCode & mKeyword & szTampon & mFin
                        Else
                            tmpCode = tmpCode & mFunction & szTampon & "</B>" & mFin
                        End If
                        tmpCode = tmpCode & "<BR>" & vbCrLf
                    Else
                        tmpCode = tmpCode & szTampon & "<BR>" & vbCrLf
                    End If
                End If
                
                If (Mid$(szLigne(i), j, 1) <> " " And Mid$(szLigne(i), j, 1) <> "(" And Mid$(szLigne(i), j, 1) <> ")" And Mid$(szLigne(i), j, 1) <> vbTab And _
                    Mid$(szLigne(i), j, 1) <> vbCrLf And Mid$(szLigne(i), j, 1) <> "_") Or szTampon = vbNullString Then
                    ' on rempli le Tampon...
                    szTampon = szTampon & htmlEncode(Mid$(szLigne(i), j, 1))
                Else
                    ' a ce moment le curseur pointe sur un espace ou bien une (
                    
                    ' on compare le mot avec la liste des mots connus
                    If isKeyword(Trim$(szTampon)) Then
                        If Mid$(szLigne(i), j, 1) <> "(" Then
                            tmpCode = tmpCode & mKeyword & szTampon & mFin
                        Else
                            tmpCode = tmpCode & mFunction & szTampon & "</B>" & mFin
                        End If
                        tmpCode = tmpCode & htmlEncode(Mid$(szLigne(i), j, 1))
                    Else
                        tmpCode = tmpCode & szTampon & htmlEncode(Mid$(szLigne(i), j, 1))
                    End If
                    szTampon = vbNullString
                End If
            End If
            
            ' si bChaine est vrai alors on est dans une chaine de caractères
            If Mid$(szLigne(i), j, 1) = """" Then
                If bChaine Then
                    If i < UBound(szLigne) Then
                        bChaine = (szLigne(i + 1) = """")
                        If Not bChaine Then tmpCode = tmpCode & "</B>" & mFin & mNormal
                    Else
                        bChaine = False
                        tmpCode = tmpCode & "</B>" & mFin & mNormal
                    End If
                Else
                    bChaine = True
                    tmpCode = tmpCode & mString & """"
                End If
            End If
        Next j
    End If
    szTampon = szTampon & "<BR>" & vbCrLf
Next i
vb2html = tmpCode
End Function

Télécharger le zip