Code-Optimierungsproblem

25/02/2008 - 19:11 von Martin Meyer | Report spam
Hallo zusammen,

ich hab' da ein kleines Problem mit der Performance einer
relativ simplen Routine. Ich hab' das Problem mal auf das Wesentlichste
reduziert:
Strings die ein paar wenige Unicode-Zeichen enthalten können, müssen (für
eine RTF-Ausgabe) aufbereitet werden. Und zwar müssen die Unicodezeichen
durch "\u####" ersetzt werden (####=Unicodewert). Die ANSI-Zeichen
bleiben unangetastet.

Das làuft in folgender kleiner Routine:

Private Function maskUni(strIn As String) As String
Dim i As Long
Dim lngLen As Long
Dim arr() As Byte
If LenB(strIn) Then
arr = strIn
lngLen = UBound(arr)
For i = 1 To lngLen Step 2
If (arr(i) > 0) Then
maskUni = maskUni & "\u" & CStr(arr(i - 1) + arr(i) * 256)
Else
maskUni = maskUni & ChrW$(arr(i - 1))
End If
Next
End If
End Function

Der zu bearbeitende Sting wird in ein Byte-Array kopiert und die Bytes
der ungraden Positionen auf 0 getestet. Ist so'n Hi-Byte <> 0 dann setzt
die Umschreibung mit "\u####" ein, anderenfalls wird das Zeichen
unbehandelt in die Rückgabe geschrieben.

Das làuft soweit wie gewünscht, allerdings werden MB-weise Strings durch
die Routine gejagt, was dann zu lange dauert.

Das Kopieren des Strings ins Array ist schnell, ebenfalls ist das reine
Durchlaufen des Arrays in der Schleife akzeptabel.

Als Zeitfresser hat sich der Aufbau des Rückgabestrings erwiesen, hier
besonders im Else-Zweig (der true-Zweig dauert natürlich eine Spur
lànger, kommt aber nur selten vor - Unicode-Zeichen sind die Ausnahme in
den Übergabe-Strings).

Meine Frage ist nun, ob man den Aufbau des Returnwertes mit dem
"maskUni = maskUni & .. irgendwas" nicht anders hinkriegt mit APIs oder
so(?).

Vielleicht bin ich mit meinem Lösungsansatz auch völlig auf dem Holzweg
und es gibt einen viel eleganteren (performanteren) Weg?

Hier wàre ich für Anregungen natürlich auch seeehr dankbar!
Any ideas?

TIA & Gruß,
Martin

Bei Antworten per eMail bitte an die Reply-To Adresse senden.
Oder der From-Adresse den String "nospam_" voranstellen.
eMails an die unmodifizierte From-Adresse werden ungelesen geloescht.
 

Lesen sie die antworten

#1 Gert Wietzorek
25/02/2008 - 21:06 | Warnen spam
Martin Meyer schrieb:
Hallo zusammen,


Als Zeitfresser hat sich der Aufbau des Rückgabestrings erwiesen, hier
besonders im Else-Zweig (der true-Zweig dauert natürlich eine Spur
lànger, kommt aber nur selten vor - Unicode-Zeichen sind die Ausnahme in
den Übergabe-Strings).

Meine Frage ist nun, ob man den Aufbau des Returnwertes mit dem
"maskUni = maskUni & .. irgendwas" nicht anders hinkriegt mit APIs oder
so(?).





Lege Dir eine neu Klasse mit folgendem Code an, die dürfte deutlich
schneller als Dein Ansatz funktionieren, verwende ich u.a. für einen
àhnlichen Zweck. Ich kann nicht mehr feststellen, woher ich die habe,
daher als Text und nicht als Link:


'****************************************************
'* CStringBuilder.cls *
'* allows VERY fast string concatenation *
'* Programmed: Konrad Rudolph (Mad Rat Pro.) *
'* Last Change: 10.09.2003 11:49 *
'* Version: 1.0.0 *
'****************************************************
Option Explicit

Private m_sBuffer As String
Private m_lLen As Long
Private m_lOffset As Long
'-

Private Sub Class_Initialize()
m_lLen = 1000
m_lOffset = 1

m_sBuffer = Space$(m_lLen \ 2)
End Sub
'-

Public Property Get Length() As Long
Length = (m_lOffset - 1) \ 2
End Property

Public Function ToString() As String
ToString = MidB$(m_sBuffer, 1, m_lOffset - 1)
End Function

Public Sub CreateBuffer(Size As Long)
m_lLen = Size * 2
m_lOffset = 1

m_sBuffer = Space$(Size)
End Sub

Public Sub Append(Value As String)
Dim NewOffset As Long

NewOffset = m_lOffset + LenB(Value)

If NewOffset > m_lLen Then
m_sBuffer = m_sBuffer & Space$(NewOffset)
m_lLen = LenB(m_sBuffer)
End If

MidB$(m_sBuffer, m_lOffset) = Value
m_lOffset = NewOffset
End Sub

Public Sub AppendLine(Optional Value As String = "")
Call Me.Append(Value)
Call Me.Append(vbNewLine)
End Sub


Anwendung:

dim cS as new cstringbuilder
cs.append "Irgendwas"
cs.append appendline
cs.appendline
cs.append "Und noch was"
result$=cs.tostring
set cs=nothing

Gruß
Gert



| Antworten nur in die Newsgroup, |
| die E-Mail Adressen existieren nicht! |
| |
| answers and questions only to the newsgroup,|
| the email adresses are not valid |
| |
| http://www.gwsoftware.de |

Ähnliche fragen