User Tools

Site Tools


vba:functions:masked2unicode

[VBA] masked2unicode()

Diese Funktion wandelt alle mit \ maskierten Zeichen in einem String in unicode.

Version 1.1.0 (30.08.2018)

Beispiele

Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r()
d masked2uniode("abc\! \\ ")
<String> 'abc\u0021 \u005C '

Code

udf_masked2unicode.bas
Attribute VB_Name = "udf_masked2unicode"
'-------------------------------------------------------------------------------
'File         : udf_masked2unicode.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/masked2unicode
'Environment  : VBA 2007 +
'Version      : 1.1.0
'Name         : masked2unicode
'Author       : Stefan Erb (ERS)
'History      : 03.12.2014 - ERS - Creation
'               20.11.2015 - ERS - Kleiner Fehler behoben. Bei "a\\u0057" hat er "\" übersetzt. Das ist behoben
'               30.08.2018 - ERS - \\ wird nicht mehr geparst
'-------------------------------------------------------------------------------
Option Explicit
 
'/**
' * Wandelt jedes mit \ maskierte Feld in Unicode um, ausser es handelt sich bereits um einen Unicode oder ein maskeirtes \
' * @param  String
' * @return String
' */
Public Function masked2uniode(ByVal iString As String) As String
    Static rx As Object
    If rx Is Nothing Then Set rx = CreateObject("VBScript.RegExp"): rx.pattern = "(?:\\(\\)|\\u[0-9A-F]{4}|\\(?!\\)(.))": rx.Global = True
    masked2uniode = iString
    Dim mc As Object: Set mc = rx.execute(iString)
    Dim i As Long: For i = mc.count - 1 To 0 Step -1
        If mc(i).subMatches(1) <> Empty Then
            masked2uniode = repl(mc(i), masked2uniode, char2unicode(mc(i).subMatches(1)))
        ElseIf mc(i).subMatches(0) = "\" Then
            masked2uniode = repl(mc(i), masked2uniode, "\")
        End If
    Next i
End Function
Private Function repl(ByRef iMatch As Object, ByVal iString As String, ByVal iReplace As String) As String
            repl = Left(iString, iMatch.firstIndex) & iReplace & Mid(iString, iMatch.firstIndex + iMatch.length + 1)
End Function
 
'/**
' * cast_char2unicode.bas V1.0.0
' * Wandelt ein Charakter in ein Unicode
' * @example: char2unicode("€") -> '\u20AC'
' * @param  String(1)   Charakter, der gewandelt werden soll
' * @return String      Unicode
' */
Private Function char2unicode(ByVal iChar As String) As String
    char2unicode = Hex(AscW(iChar)) 'Hex-Wert ermitteln
    char2unicode = "\u" & String(4 - Len(char2unicode), "0") & char2unicode
End Function
 
vba/functions/masked2unicode.txt · Last modified: 08.10.2019 16:59:35 by yaslaw