Sample Scripts

MailHTML (VB script)

This script was invented as a sort of website publishing system. If used in the connection client for mail, you can convert a received message into HTML, and write this HTML in the publishing database of your website.

Example: you have a news section on your website, and find it too difficult to daily edit a number of HTML files, and FTP them on your webdirectory. Sending a message in plain text to a specific address may be much easier.

The code:

Function MailHtml(InputValue,Parameter1,Parameter2,Parameter3,Parameter4)
    'Remove the line breaks
    InputValue = InputValue & " "
    PreviousCRPositie = 0
    CRPositie = InStr(1, InputValue, Chr(&HD) & Chr(&HA))
    Do While CRPositie > 0
        Karakter = Mid(InputValue, CRPositie + 2, 1)
        If Karakter <> "" Then
            ASCValue = Asc(Mid(InputValue, CRPositie + 2, 1))
        Else
            ASCValue = 0
        End If
        If CRPositie > 1 Then
            VorigKarakter = Mid(InputValue, CRPositie - 1, 1)
        Else
            VorigKarakter = "#"
        End If
        'If next character is lower case
        Condition = (ASCValue >= 97 And ASCValue <= 122)
        'If next character is numeric
        Condition = (ASCValue >= 48 And ASCValue <= 57) Or Condition
        'If next character is (
        Condition = (ASCValue = 40) Or Condition
        'If next character is a dash -
        Condition = (ASCValue = 40) Or Condition
        'If next character is upper case and previous was not a period and
        'last line break was Parameter3 characters ago
        Condition = (ASCValue >= 65 And ASCValue <= 90 And VorigKarakter <> "." And (CRPositie - PreviousCRPositie) >= Parameter3) Or Condition
        'Skip the condition if the line contained double spaces and previous character
        'was numeric = table
        If CRPositie > 20 Then
            TabelLijn = InStr(CRPositie - 20, InputValue, " ")
        Else
            TabelLijn = 0
        End If
        Condition = (Not (TabelLijn > 0 And TabelLijn < CRPositie)) And Condition
        Condition = (Not (((Asc(VorigKarakter) >= 48 And Asc(VorigKarakter) <= 57) Or VorigKarakter = ")") And TabelLijn > 0 And TabelLijn < CRPositie)) And Condition

        If Condition Then
            InputValue = Left(InputValue, CRPositie - 1) & " " & Mid(InputValue, CRPositie + 2)
        Else
            PreviousCRPositie = CRPositie
        End If
        CRPositie = InStr(CRPositie + 1, InputValue, Chr(&HD) & Chr(&HA))
    Loop

    'All other carriage returns may be converted into breaks

    Set replace_1 = New RegExp
    replace_1.Pattern = Chr(13) & Chr(10)
    replace_1.IgnoreCase = True
    spare = ""
    Do While InputValue <> spare
        spare = InputValue
        InputValue = replace_1.Replace(InputValue, "<br>")
    Loop

    'Spaces should be converted to HTML spaces

    breakat = InStr(1, InputValue, "<br>")
    PreviousBreak = 0
    Do While breakat > 0
        NextBreakAt = InStr(breakat + 4, InputValue, "<br>")
        If NextBreakAt = 0 Then NextBreakAt = Len(InputValue)
        FirstCharOfLine = Mid(InputValue, breakat + 4, 1)
        If NextBreakAt - breakat > Parameter4 Or FirstCharOfLine = "-" Or FirstCharOfLine = "·" Or FirstCharOfLine = "*" Then
            'The line is too long to be table oriented
            breakat = InStr(breakat + 4, InputValue, "<br>")
        Else
            If InStr(breakat, InputValue, " ") < NextBreakAt Then
                SpaceAt = InStr(breakat, InputValue, " ")
                Do While SpaceAt > 0 And SpaceAt < NextBreakAt
                    InputValue = Left(InputValue, SpaceAt - 1) & "&nbsp;" & Mid(InputValue, SpaceAt + 1)
                    NextBreakAt = InStr(breakat + 4, InputValue, "<br>")
                    SpaceAt = InStr(SpaceAt, InputValue, " ")
                Loop
            End If
            PreviousBreak = breakat
            breakat = InStr(breakat + 4, InputValue, "<br>")
        End If
    Loop

    'Make a link of an email address

    AtPositie = 1
    Do While InStr(AtPositie, InputValue, "@") > 0
        AtAT = InStr(AtPositie, InputValue, "@")
        BeginAt = AtAT
        EndAt = AtAT
        Do While Mid(InputValue, BeginAt, 6) <> "&nbsp;" And Mid(InputValue, BeginAt, 1) <> " " And Mid(InputValue, BeginAt, 1) <> ">"
            BeginAt = BeginAt - 1
        Loop
        Select Case Mid(InputValue, BeginAt, 6)
            Case "&nbsp;"
                BeginAt = BeginAt + 5
        End Select
        Do While Mid(InputValue, EndAt, 6) <> "&nbsp;" And Mid(InputValue, EndAt, 1) <> " " And Mid(InputValue, EndAt, 1) <> "<" And Mid(InputValue, EndAt, 7) <> ".&nbsp;" And Mid(InputValue, EndAt, 2) <> ".<"
            EndAt = EndAt + 1
        Loop
        AtPositie = EndAt

        MailAddress = Mid(InputValue, BeginAt + 1, EndAt - BeginAt - 1)
        InputValue = Left(InputValue, BeginAt) & "<a href=" & Chr(34) & "mailto:" & MailAddress & Chr(34) & ">" & MailAddress & "</a>" & Right(InputValue, Len(InputValue) - EndAt + 1)
        AtPositie = EndAt + 22 + Len(MailAddress)
    Loop

    'Make a link of a link

    wwwPositie = 1
    Do While InStr(wwwPositie, InputValue, "www") > 0
        AtAT = InStr(wwwPositie, InputValue, "www")
        BeginAt = AtAT
        EndAt = AtAT
        Do While Mid(InputValue, BeginAt, 6) <> "&nbsp;" And Mid(InputValue, BeginAt, 1) <> " " And Mid(InputValue, BeginAt, 1) <> ">"
            BeginAt = BeginAt - 1
        Loop
        Select Case Mid(InputValue, BeginAt, 6)
            Case "&nbsp;"
                BeginAt = BeginAt + 5
        End Select
        Do While Mid(InputValue, EndAt, 6) <> "&nbsp;" And Mid(InputValue, EndAt, 1) <> " " And Mid(InputValue, EndAt, 1) <> "<" And Mid(InputValue, EndAt, 7) <> ".&nbsp;" And Mid(InputValue, EndAt, 2) <> ".<"
            EndAt = EndAt + 1
        Loop
        wwwPositie = EndAt

        MailAddress = Mid(InputValue, BeginAt + 1, EndAt - BeginAt - 1)
        If Left(MailAddress, 4) <> "http" Then
            MailAddress = "http://" & MailAddress
        End If
        InputValue = Left(InputValue, BeginAt) & "<a href=" & Chr(34) & MailAddress & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">" & MailAddress & "</a>" & Right(InputValue, Len(InputValue) - EndAt + 1)
        wwwPositie = EndAt + 31 + Len(MailAddress)
    Loop

    wwwPositie = 1
    Do While InStr(wwwPositie, InputValue, "http://") > 0
        AtAT = InStr(wwwPositie, InputValue, "http://")
        If Mid(InputValue,AtAt+7,3) <> "www" Then
            BeginAt = AtAT
            EndAt = AtAT
            Do While Mid(InputValue, BeginAt, 6) <> "&nbsp;" And Mid(InputValue, BeginAt, 1) <> " " And Mid(InputValue, BeginAt, 1) <> ">"
                BeginAt = BeginAt - 1
            Loop
            Select Case Mid(InputValue, BeginAt, 6)
                Case "&nbsp;"
                    BeginAt = BeginAt + 5
            End Select
            Do While Mid(InputValue, EndAt, 6) <> "&nbsp;" And Mid(InputValue, EndAt, 1) <> " " And Mid(InputValue, EndAt, 1) <> "<" And Mid(InputValue, EndAt, 7) <> ".&nbsp;" And Mid(InputValue, EndAt, 2) <> ".<"
                EndAt = EndAt + 1
            Loop
            wwwPositie = EndAt

            MailAddress = Mid(InputValue, BeginAt + 1, EndAt - BeginAt - 1)
            If Left(MailAddress, 4) <> "http" Then
                MailAddress = "http://" & MailAddress
            End If
            InputValue = Left(InputValue, BeginAt) & "<a href=" & Chr(34) & MailAddress & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">" & MailAddress & "</a>" & Right(InputValue, Len(InputValue) - EndAt + 1)
            wwwPositie = EndAt + 31 + Len(MailAddress)
        Else
            wwwPositie = AtAt + 6
        End if
    Loop

    MailHtml = "<font face=""Courier New"" size=""2"">" & InputValue & "</font>"

End Function