Tipp-Upload: VB 5/6 0136: CharArray, CharPointer
von OlimilO
Über den Tipp
Dieser Tippvorschlag ist noch unbewertet.
Der Vorschlag ist in den folgenden Kategorien zu finden:
- System
- Sonstiges
Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Chararray, Charpointer, Character, Integer, Safearray, Zeiger, universal Zeiger
Damit er übernommen werden kann, müssen noch Änderungen daran vorgenommen werden. Sofern Sie der Autor sind, können Sie sich anmelden, um die Liste einzusehen.
Der Vorschlag wurde erstellt am: 31.10.2007 08:28.
Die letzte Aktualisierung erfolgte am 20.11.2007 14:20.
Beschreibung
Beim Parsen eines Strings kommt es des Öfteren vor, daß ein String zeichenweise durchwandert werden soll. Mid und MidB ist hier die meist verwendete Möglichkeit, Teile eines Strings zu extrahieren und in einen anderen String zu kopieren. Soll dann eine Entscheidung anhand des rausgelesen Zeichens getroffen werden, bspw in einem Select Case, so bietet der Select Case von VB die bequeme Möglichkeit selbst Strings als Argument übergeben zu dürfen. Diese bequeme Vorgehensweise erkauft man sich allerdings mit einer guten Portion Performance. Wer beim Parsen größerer Dateien auf Performance achten möchte, der greift ein wenig in die Trickkiste. Für den VB-Anwender stellt ein String einen besonderen Datentyp dar, der mit den in VB enthaltenen Stringfunktionen bearbeitet werden kann.
Eine andere Sichtweise ist es, einen String als einen zusammenhängenden Speicherbereich bzw als ein Array von Zeichen (Character) zu betrachten. In anderen Programmiersprachen (Delphi, C++) ist diese Sichtweise seit jeher Bestandteil der Sprache, weswegen Parser dort meist viel zügiger als in VB zu Werke gehen.
Es gibt jedoch in VBC keinen eigenen Datentyp für ein Zeichen, weshalb der Datentyp String meist für ein einzelnes Zeichen verwendet wird. Ein einzelnes Zeichen kann aber auch als ein 2-Byte langer Integer btrachtet werden. Ein Select Case mit einem numerischen Wert als Argument bringt ebenfalls einen Performancegewinn.
Ein Array als universal verwendbaren Zeiger ist der Trick der Wahl. Dabei wird eine Arrayvariable mit einem Zeiger auf einen selbstdefinierten SafeArraydescriptor geimpft.
In diesem kleinen BspProjekt wird eine Performancemessung der gezeigten Methode im Vergleich zu Mid / MidB durchgeführt. Dabei ergibt sich gegenüber MidB in der kompilierten Exedatei ein etwa 20-facher, in der VB-IDE immerhin noch 3-4facher Performancegewinn.
Wohlgemerkt wird hier lediglich der Vorgang des Extrahierens eines einzelnen Zeichens gemessen, wohingegen sich im gesamten Parse-Vorgang einer Datei, bzw überführen eines Strings in eine Objektdatenstruktur sich der Performancegewinn allein durch die hier gezeigte Methode, selbstverständlich nicht so gravierend bemerkbar machen wird.
Das Projekt besteht aus einem Formular zwei Modulen und einer Klasse StopWatch. Hauptbestanteil des Tipps sind die beiden Module ModUDTPtr und ModCharPointer, im Formular auch die Subs *BtnMidBWalk_Click und *BtnCharPtrWalk_Click. Es soll hier nicht der Focus auf die Klasse gerichtet sein, siehe dazu den Tipp <!TU0137 QueryPerformance, StopWatch mit Currency>.
Schwierigkeitsgrad |
Verwendete API-Aufrufe: QueryPerformanceCounter, QueryPerformanceFrequency, RtlMoveMemory, RtlZeroMemory, VarPtr (ArrPtr) |
Download: |
' Dieser Source stammt von http://www.activevb.de ' und kann frei verwendet werden. Für eventuelle Schäden ' wird nicht gehaftet. ' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. ' Ansonsten viel Spaß und Erfolg mit diesem Source! ' ------------- Anfang Projektdatei Projekt1.vbp ------------- ' --------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Beschriftungsfeld "Label1" ' Steuerelement: Optionsfeld-Steuerelement "Option2" auf FrmBuildString ' Steuerelement: Schaltfläche "BtnMidBWalk" ' Steuerelement: Schaltfläche "BtnCharPtrWalk" ' Steuerelement: Optionsfeld-Steuerelement "Option1" auf FrmBuildString ' Steuerelement: Rahmensteuerelement "FrmBuildString" ' Steuerelement: Optionsfeld-Steuerelement "Option3" auf FrmBuildString ' Steuerelement: Schaltfläche "BtnWalkBArrAnsi" ' Steuerelement: Schaltfläche "BtnWalkBArrUnic" Option Explicit ' Beim Parsen eines Strings kommt es des Öfteren vor, daß ein String ' zeichenweise durchwandert werden soll. Mid und MidB ist hier die meist ' verwendete Möglichkeit, Teile eines Strings zu extrahieren und in einen ' anderen String zu kopieren. ' Soll dann eine Entscheidung anhand des rausgelesen Zeichens getroffen ' werden, bspw in einem Select case, so bietet der Select Case von VB die ' bequeme Möglichkeit selbst Strings als Argument übergeben zu dürfen. ' Diese bequeme Vorgehensweise erkauft man sich allerdings mit einer guten ' Portion Performance. ' Wer beim Parsen größerer Dateien auf Performance achten möchte, der greift ' ein wenig in die Trickkiste. Für den gewöhnlichen VB-Anwender stellt ein ' String einen besonderen Datentyp dar, der mit den in VB enthaltenen String- ' funktionen bearbeitet werden kann. ' Eine andere Sichtweise ist es, einen String als einen zusammenhängenden ' Speicherbereich bzw als ein Array von Zeichen (Character) zu betrachten. ' Es gibt jedoch in VBC keinen eigenen Datentyp für ein Zeichen, weshalb der ' Datentyp String meist für ein einzelnes Zeichen verwendet wird. ' Ein einzelnes Zeichen kann aber auch als ein 2-Byte langer Integer btrachtet ' werden. Ein Select Case mit einem numerischen Wert als Argument bringt ' ebenfalls einen Performancegewinn. ' Ein Array als universal verwendbaren Zeiger ist der Trick der Wahl. ' Dabei wird einer Arrayvariable der Zeiger auf einen selbstdefinierten ' SafeArraydescriptor injiziert. ' In anderen Programmiersprachen (Delphi, C++) ist diese Vorgehensweise seit ' jeher Bestandteil der Sprache, weswegen Parser in anderen Programmiersprachen ' meist viel zügiger als in VB zu Werke gehen. ' In diesem kleinen BspProjekt wird eine Performancemessung der gezeigten ' Methode im Vergleich zu Mid / MidB durchgeführt. ' Dabei ergibt sich gegenüber MidB in der kompilierten Exedatei ein etwa ' 20-facher, in der VB-IDE immerhin noch 3-4facher Performancegewinn. ' Wohlgemerkt wird hier lediglich der Vorgang des Extrahierens eines einzelnen ' Zeichens betrachtet, wohingegen sich im gesamten Parse-Vorgang einer Datei, ' bzw überführen eines Strings in eine Objektdatenstruktur sich der Performance- ' gewinn allein durch die hier gezeigte Methode, selbstverständlich nicht so ' gravierend bemerkbar machen wird. ' Der String der durchwandert werden soll Private mStrVal As String Private mSW As StopWatch Private Sub Form_Load() Set mSW = New StopWatch End Sub Private Sub Option1_Click() Call HourGlassBuildString End Sub Private Sub Option2_Click() Call HourGlassBuildString End Sub Private Sub Option3_Click() Call HourGlassBuildString End Sub ' Dieser Programmteil dient lediglich zum Aufbau verschieden langer Strings ' die dann durchwandert werden. Private Sub HourGlassBuildString() Dim mp As MousePointerConstants mp = Screen.MousePointer Screen.MousePointer = MousePointerConstants.vbArrowHourglass Call BuildString Screen.MousePointer = mp Call MessStringLength End Sub Private Sub BuildString() mStrVal = vbNullString Dim s As String s = "quick brown fox jumps over the lazy dog " ' 40 = 80Byte Call AppendStringN(mStrVal, s, 1000) s = mStrVal Call AppendStringN(mStrVal, s, 10 - 1) If Option1.Value Then Exit Sub s = mStrVal Call AppendStringN(mStrVal, s, 10 - 1) If Option2.Value Then Exit Sub s = mStrVal Call AppendStringN(mStrVal, s, 10 - 1) If Option3.Value Then Exit Sub End Sub Private Sub AppendStringN(AppendTo As String, StrVal As String, ByVal n As Long) Dim i As Long, lA As Long, lS As Long lA = LenB(AppendTo) lS = LenB(StrVal) AppendTo = AppendTo & Space$(n * lS \ 2) For i = lA + 1 To lA + (n * lS) Step lS MidB$(AppendTo, i, lS) = StrVal Next End Sub Private Sub MessStringLength() Dim b As Double, c As String b = LenB(mStrVal) c = IIf(b > 1000# * 1000#, "MB", "KB") b = IIf(b > 1000# * 1000#, b / 1000# / 1000#, b / 1000#) MsgBox CStr((b)) & " " & c End Sub Private Sub Start(amp As MousePointerConstants) amp = Screen.MousePointer Screen.MousePointer = MousePointerConstants.vbArrowHourglass mSW.Reset mSW.Start End Sub Private Sub MessStop(mp As MousePointerConstants) mSW.SStop MsgBox CStr(mSW.ElapsedMilliseconds) & " ms" Screen.MousePointer = mp End Sub ' hier gehts los mit den Vergleichsmessungen Private Sub BtnMidBWalk_Click() If LenB(mStrVal) = 0 Then Call BuildString Dim mp As MousePointerConstants Call Start(mp) Dim i As Long Dim c As String For i = 1 To LenB(mStrVal) Step 2 c = MidB$(mStrVal, i, 2) Next Call MessStop(mp) End Sub Private Sub BtnCharPtrWalk_Click() If LenB(mStrVal) = 0 Then Call BuildString Dim mp As MousePointerConstants Call Start(mp) Dim i As Long Dim c As Integer Dim cp As TCharPointer: Call New_CharPointer(cp, mStrVal) For i = 1 To Len(mStrVal) c = cp.Chars(i) Next Call DeleteCharPointer(cp) Call MessStop(mp) End Sub Private Sub BtnWalkBArrAnsi_Click() If LenB(mStrVal) = 0 Then Call BuildString Dim mp As MousePointerConstants Call Start(mp) Dim i As Long Dim c As Byte Dim bArray() As Byte bArray = StrConv(mStrVal, vbFromUnicode) For i = 0 To Len(mStrVal) - 1 c = bArray(i) Next Call MessStop(mp) End Sub Private Sub BtnWalkBArrUnic_Click() If LenB(mStrVal) = 0 Then Call BuildString Dim mp As MousePointerConstants Call Start(mp) Dim i As Long Dim c As Byte Dim bArray() As Byte bArray = StrConv(mStrVal, vbUnicode) For i = 0 To UBound(bArray) Step 2 c = bArray(i) Next Call MessStop(mp) End Sub ' ---------- Ende Formular "Form1" alias Form1.frm ---------- ' ------- Anfang Modul "ModUDTPtr" alias ModUDTPtr.bas ------- Option Explicit ' Ein SafeArray-Descriptor dient in VB als ein universaler Zeiger Public Type TUDTPtr pSA As Long Reserved As Long ' z.B. für vbVarType oder IRecordInfo cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long cElements As Long lLBound As Long End Type Public Enum SAFeature FADF_AUTO = &H1 FADF_STATIC = &H2 FADF_EMBEDDED = &H4 FADF_FIXEDSIZE = &H10 FADF_RECORD = &H20 FADF_HAVEIID = &H40 FADF_HAVEVARTYPE = &H80 FADF_BSTR = &H100 FADF_UNKNOWN = &H200 FADF_DISPATCH = &H400 FADF_VARIANT = &H800 FADF_RESERVED = &HF008 End Enum Public Declare Sub RtlMoveMemory Lib "kernel32" ( _ ByRef pDst As Any, _ ByRef pSrc As Any, _ ByVal bLength As Long) Public Declare Sub RtlZeroMemory Lib "kernel32" ( _ ByRef pDst As Any, _ ByVal bLength As Long) Public Declare Function ArrPtr Lib "msvbvm60" _ Alias "VarPtr" ( _ ByRef pArr() As Any) As Long Public Sub New_UDTPtr(ByRef this As TUDTPtr, _ ByVal Feature As SAFeature, _ ByVal bytesPerElement As Long, _ Optional ByVal CountElements As Long = 1, _ Optional ByVal lLBound As Long = 0) With this .pSA = VarPtr(.cDims) .cDims = 1 .cbElements = bytesPerElement .fFeatures = CInt(Feature) .cElements = CountElements .lLBound = lLBound End With Debug.Print UDTPtrToString(this) End Sub ' Um zu überprüfen ob der UDTPtr auch das enthält was er soll ' kann man folgende Funktion verwenden Public Function UDTPtrToString(this As TUDTPtr) As String Dim s As String With this s = s & "pSA : " & CStr(.pSA) & vbCrLf s = s & "Reserved : " & CStr(.Reserved) & vbCrLf s = s & "cDims : " & CStr(.cDims) & vbCrLf s = s & "fFeatures : " & FeaturesToString(CLng(.fFeatures)) & vbCrLf s = s & "cbElements : " & CStr(.cbElements) & vbCrLf s = s & "cLocks : " & CStr(.cLocks) & vbCrLf s = s & "pvData : " & CStr(.pvData) & vbCrLf s = s & "cElements : " & CStr(.cElements) & vbCrLf s = s & "lLBound : " & CStr(.lLBound) & vbCrLf End With UDTPtrToString = s End Function Private Function FeaturesToString(ByVal Feature As SAFeature) As String Dim s As String Dim sOr As String: sOr = " Or " If Feature And FADF_AUTO Then s = s & IIf(Len(s), sOr, vbNullString): s = s & "FADF_AUTO" If Feature And FADF_STATIC Then s = s & IIf(Len(s), sOr, vbNullString): s = s & "FADF_STATIC" If Feature And FADF_EMBEDDED Then s = s & IIf(Len(s), sOr, vbNullString): s = s & _ "FADF_EMBEDDED" If Feature And FADF_FIXEDSIZE Then s = s & IIf(Len(s), sOr, vbNullString): s = s & _ "FADF_FIXEDSIZE" If Feature And FADF_RECORD Then s = s & IIf(Len(s), sOr, vbNullString): s = s & "FADF_RECORD" If Feature And FADF_HAVEIID Then s = s & IIf(Len(s), sOr, vbNullString): s = s & "FADF_HAVEIID" If Feature And FADF_HAVEVARTYPE Then s = s & IIf(Len(s), sOr, vbNullString): s = s & _ "FADF_HAVEVARTYPE" If Feature And FADF_BSTR Then s = s & IIf(Len(s), sOr, vbNullString): s = s & "FADF_BSTR" If Feature And FADF_UNKNOWN Then s = s & IIf(Len(s), sOr, vbNullString): s = s & "FADF_UNKNOWN" If Feature And FADF_DISPATCH Then s = s & IIf(Len(s), sOr, vbNullString): s = s & _ "FADF_DISPATCH" If Feature And FADF_VARIANT Then s = s & IIf(Len(s), sOr, vbNullString): s = s & "FADF_VARIANT" If Feature And FADF_RESERVED Then s = s & IIf(Len(s), sOr, vbNullString): s = s & _ "FADF_RESERVED" FeaturesToString = s End Function ' -------- Ende Modul "ModUDTPtr" alias ModUDTPtr.bas -------- ' --- Anfang Modul "ModCharPointer" alias ModCharPointer.bas --- Option Explicit Public Type TCharPointer pudt As TUDTPtr Chars() As Integer End Type Public Sub New_CharPointer(ByRef this As TCharPointer, ByRef StrVal As String) With this Call New_UDTPtr(.pudt, FADF_AUTO Or FADF_FIXEDSIZE, 2, Len(StrVal), 1) With .pudt .pvData = StrPtr(StrVal) End With Call RtlMoveMemory(ByVal ArrPtr(.Chars), ByVal VarPtr(.pudt), 4) End With End Sub Public Sub DeleteCharPointer(ByRef this As TCharPointer) With this Call RtlZeroMemory(ByVal ArrPtr(.Chars), 4) End With End Sub ' --- Ende Modul "ModCharPointer" alias ModCharPointer.bas --- ' ------ Anfang Klasse "StopWatch" alias StopWatch.cls ------ Option Explicit ' Class StopWatch ' Namespace System.Diagnostics ' Der Datentyp Currency in VB ist ein 64Bit-Datentyp mit einem ' Festpunktanteil. D.h. beim Bitwert &H2710 (bzw decimal 10000) ' ist der Wert 1 definiert, bzw. der kleinste positive Wert des ' Datentyps Currency ist 0.0001 ' Da die Einheit Ticks ebenfalls den Parameter 10000 beinhaltet, ' ist der VB-Datentyp Currency genau der richtige Datentyp für ' Zeitmessungen mit der QueryPerformance-API Private mFrequency As Currency Private mIsHighResolution As Boolean Private mIsRunning As Boolean Private mStartTimeStamp As Currency Private mElapsed As Currency Private mTickFrequency As Double ' In der gleihnamigen VB.Net-Klasse wird hier der Datentyp Long, ' bzw Int64 verwendet. ' Der Korrekturfaktor für den Datentyp Currency Private Const CurCorrect As Long = 10000 Private Const TicksPerMillisecond As Long = 10000 / CurCorrect ' &H2710 Private Const TicksPerSecond As Long = 10000000 / CurCorrect ' &H989680 Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _ ByRef lpPerformanceCount As Currency) As Long Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _ ByRef lpFrequency As Currency) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" ( _ ByRef pDst As Any, _ ByRef pSrc As Any, _ ByVal bytLength As Long) Private Sub Class_Initialize() If Not (QueryPerformanceFrequency(mFrequency) = 1) Then mIsHighResolution = False mFrequency = TicksPerSecond mTickFrequency = 1 Else mIsHighResolution = True mTickFrequency = (TicksPerSecond / CDbl(mFrequency)) End If End Sub ' Public Function GetTimestamp() As Currency 'Long 'LongInt Public Function GetTimestamp() As Currency GetTimestamp = pGetTimestamp * CurCorrect End Function Private Function pGetTimestamp() As Currency If mIsHighResolution Then Call QueryPerformanceCounter(pGetTimestamp) Else pGetTimestamp = DateTime.Now End If End Function Public Sub Start() If Not mIsRunning Then mStartTimeStamp = pGetTimestamp mIsRunning = True End If End Sub Public Function StartNew() As StopWatch Set StartNew = New StopWatch Call StartNew.Start End Function Public Sub SStop() If IsRunning Then Dim c As Currency: c = (pGetTimestamp - mStartTimeStamp) mElapsed = (mElapsed + c) mIsRunning = False End If End Sub Public Sub Reset() mElapsed = 0 mIsRunning = False mStartTimeStamp = 0 End Sub ' Shared-Member Properties Public Property Get Frequency() As Currency ' Diese Multiplikation mit CurCorrect ist nur dazu da, die Klasse ' nach außen hin konsistent zu halten mit der gleichnamigen Klasse ' aus dem .netFX Frequency = mFrequency * CurCorrect End Property Public Property Get IsHighResolution() As Boolean IsHighResolution = mIsHighResolution End Property ' #################### ' Public Properties ' #################### ' Public Property Get ElapsedToString() As String ' TimeSpan ElapsedToString = TimeSpanToString(GetElapsedDateTimeTicks) End Property Private Function TimeSpanToString(ByVal ticks As Currency) As String Dim b As String Dim h As Long, m As Long, s As Long, n As Long Dim days As Long: days = CInt((ticks / 86400000)) Dim time As Currency: time = (ticks Mod 86400000) If (ticks < 0) Then b = b & "-" days = -days time = -time End If If (days <> 0) Then b = b & CStr(days) & "." End If ' Stunden h = CInt(((time \ 3600000) Mod 24)) b = b & IntToString(h, 2) & ":" ' Minuten m = CInt(((time \ 60000) Mod 60)) b = b & IntToString(m, 2) & ":" ' Sekunden s = CInt(((time \ 1000) Mod 60)) b = b & IntToString(s, 2) n = (ticks - (CCur(h) * CCur(3600000)) - (CCur(m) * CCur(60000)) - (CCur(s) * CCur( _ 1000))) * 10000 If (n <> 0) Then b = b & "." b = b & IntToString(n, 7) End If TimeSpanToString = b End Function Private Function IntToString(ByVal n As Long, ByVal digits As Long) As String Dim l As Long IntToString = CStr(n) l = Len(IntToString) If l < digits Then IntToString = String$(digits - l, "0") & IntToString End Function Public Property Get ElapsedMilliseconds() As Currency ' Long 'LongInt ElapsedMilliseconds = GetElapsedDateTimeTicks / TicksPerMillisecond End Property Public Property Get ElapsedTicks() As Currency ' As Long 'LongInt ElapsedTicks = GetRawElapsedTicks * CurCorrect End Property Public Property Get IsRunning() As Boolean IsRunning = mIsRunning End Property ' #################### ' Private Functions ' #################### ' Private Function GetElapsedDateTimeTicks() As Currency Dim rawElapsedTicks As Currency: rawElapsedTicks = GetRawElapsedTicks If mIsHighResolution Then Dim d As Double: d = CDbl(rawElapsedTicks) d = (d * mTickFrequency) GetElapsedDateTimeTicks = CCur(d) Else GetElapsedDateTimeTicks = rawElapsedTicks End If End Function Private Function GetRawElapsedTicks() As Currency Dim Elapsed As Currency: Elapsed = mElapsed If mIsRunning Then Dim c As Currency: c = (GetTimestamp - mStartTimeStamp) Elapsed = (Elapsed + c) End If GetRawElapsedTicks = Elapsed End Function ' ------- Ende Klasse "StopWatch" alias StopWatch.cls ------- ' -------------- Ende Projektdatei Projekt1.vbp --------------
Diskussion
Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.