Varias funções para manipular strings

[xanburzum 169]

Varias funções , tais como , na descrição:

Replace_Bad_Words - Uma função para substituir removendo Bad strings.

Rep_Chars - remove caracteres indesejados de strings (html, especial, reservado) para o armazenamento de dados.

Fix_Chars - substitui caracteres de fixação feita por Rep_Chars. Correções de caracteres para exibir html.

Sentence_Continue - Formata uma string para um certo tamanho, se demasiado longo e, em seguida, adiciona um ... ao final do mesmo.

Count_Words - Conta o número de palavras em uma strings.

Make_Word_Wrap - Wraps o número de caracteres permitidos, acrescentando um espaço para romper excessivamente palavras longas .

 

Function Replace_Bad_Words(Data As String) As String


    If Data = "" Then Exit Function
    '-------------------------------------

    'Dirt Words----------------------
    Bad_Word = Array("ass", "bitch", "biatch", "blowjob", "bukkake", "bullshit", "cunt", "cum", "dicked", "dickhead" _
             & "dickweed", "dildo", "fuck", "gangbang", "goddamnit", "handjob", "jackoff", "motherfucker", "motherfucking" _
             & "pissed", "pisses", "---o", "pussy", "pussified", "shit", "titties", "twat")
    '--------------------------------
    
    'Replace Bad Words-----------------
    For Bad = 0 To UBound(Bad_Word)
    Data = Replace(Data, Bad_Word(Bad), String(Len(Bad_Word(Bad)), "*"), , , vbTextCompare)
    Next Bad
    '----------------------------------


    Replace_Bad_Words = Data
    '--------------------------

End Function

Function Rep_Chars(Data As String) As String

    'Replace caracters to allow in database, one to one ratio---
    Data = Replace(Data, Chr(60), Chr(251))
    Data = Replace(Data, Chr(62), Chr(252))
    Data = Replace(Data, Chr(34), Chr(253))
    Data = Replace(Data, Chr(39), Chr(254))
    Data = Replace(Data, Chr(13), Chr(255))
    '-----------------------------------------------------------


    Rep_Chars = Data
    '-----------------

End Function

Function Fix_Chars(Data As String) As String


    Data = Replace(Data, Chr(251), "<")
    Data = Replace(Data, Chr(252), ">")
    Data = Replace(Data, Chr(253), """)
    Data = Replace(Data, Chr(254), "'")
    Data = Replace(Data, Chr(255), "<br>")
    '----------------------------------------------------


    Fix_Chars = Data
    '-----------------

End Function

Function Sentence_Continue(Data As String, chrlength As Integer) As String

    If Len(Data) > chrlength Then
    Sentence_Continue = Mid(Data, 1, chrlength) & "..."
    Else
    Sentence_Continue = Data
    End If
    '-----------------------------------------------
    
End Function

Function Count_Words(Data As String) As Integer


    Words = Split(Data, " ")
    Count_Words = Int(UBound(Words) + 1)
    '---------------------------------

End Function

Function Make_Word_Wrap(Data_String As String, Word_Size_Allowed As Integer)


    Counter = 0
    Fixed_Word = ""
    '----------------------------------------


    If Data_String = "" Then Exit Function
    '--------------------------------------------
    

    If Len(Data_String) < Word_Size_Allowed Then
    Make_Word_Wrap = Data_String
    Exit Function
    End If
    '----------------------------------------------------------------

  
    DataOf = Split(Data_String, " ")
    '------------------------------------------------------
    

    For Breakdown = LBound(DataOf) To UBound(DataOf)
    

    If Len(DataOf(Breakdown)) > Word_Size_Allowed Then

    For breakword = 1 To Len(DataOf(Breakdown))
    
    Counter = Counter + 1
    
    'Replace characters that are too long with spaces-------------
    If Counter > Word_Size_Allowed Then
    Fixed_Word = Fixed_Word & " " & Mid(DataOf(Breakdown), breakword, 1)
    Counter = 1
    Else
    Fixed_Word = Fixed_Word & Mid(DataOf(Breakdown), breakword, 1)
    End If
    '-------------------------------------------------------------
    
    Next breakword
    '

    'Set new values and reset word-----------------
    DataOf(Breakdown) = Fixed_Word
    Fixed_Word = ""
    '----------------------------------------------

    End If
    '------------------------------------------------
    
    Next Breakdown
    
    
    For Rebuild = LBound(DataOf) To UBound(DataOf)
    New_String = New_String & DataOf(Rebuild) & " "
    Next Rebuild
    New_String = Mid(New_String, 1, Len(New_String) - 1)
    '-----------------------------------------
    
    Make_Word_Wrap = New_String

End Function
%>

[hargon 64]

Muito bom xan, ótima contribuição.

[xanburzum 169]

saun functions sempre utilizadas...