• II.4. VBA - Konwersja ciągów [3] •

"Rzekł pajączek do pajączki:" & vbNewLine & _
"Popatrz, ja mam złote rączki!" & vbNewLine & _
"Już uprzędłem dla was nową" & vbNewLine & _
"Pajęczynę własnościową." & vbNewLine & _
"Będziesz pewnie bardzo rada," & vbNewLine & _
"Bo to cud, mucha nie siada!" & vbNewLine & _
"Na to ona z gniewem wrzaśnie:" & vbNewLine & _
"A ma, durniu, siadać właśnie!" & vbNewLine & _
"           (Bogdan Brzeziński)"

grupa: pl.comp.bazy-danych.msaccess
wątek: Konkatenacja - jak przyspieszyć ok. 100x

Zamiast bawić się w zapisywanie danych na dysku
zastosuj lepiej coś działajacego jak StringBuilder
Dzięki temu że aplikacja nie będzie miała kontaktu z dyskiem
uzyskasz jeszcze większą prędkość działania.
Przykład takiej klasy znajdziesz na: StringBuilder Class for VB
(kod ten przeznaczony jest dla VB6, może więc nie działać z VBA)

    Jaki jest powód takiego zachowania. Łączenie stringów w Visual Basicu
polega na tym iż runtime rezerwuje nowy, pusty obszar pamięci
o wielkości równej sumarycznej wielkości dwóch łączonych stringów
i do tego nowego obszaru kopiowana jest ich zawartość.
    Dla każdej kolejnej operacji konkatenacji niezależnie czy zapisana jest z wykorzystaniem operatora + czy & wykonywana jest ponownie powyższa operacja.

' przygotuj bufor o sumarycznej wielkości obu ciągów wejściowych
StrCat = String$(lstrlen(sString1) + lstrlen(sString2), vbNullChar)
' kopiuj pierwszy ciąg znaków
lstrcat StrCat, sString1
' kopiuj (dołącz) drugi ciąg znaków
lstrcat StrCat, sString2

    ... StringBuilder jest dodatkową klasą, zakładającą własny bufor wewnątrz którego łączone są stringi.
Za każdym razem kiedy wielkość wynikowego łańcuch znaków ma przekroczyc stworzony wcześniej bufor jego wielkość jest podwajana (jego wielkość wzrasta więc w postępie geometrycznym)
    Dzięki wypracowanemu sporemu zapasowi miejsca w buforze StringBuilder może rzadziej alokować nową pamięć, nie musi też tak często kopiować dużych porcji danych, która to operacja występuje przy każdej normalnej konkatenacji.

grupa: pl.comp.bazy-danych.msaccess
wątek: [newbie] pokręcone godziny
przedstawił: Krzysztof Naworyta

Najlepsza konwersja to oczywiście do datetime (który zresztą jest podtypem Double). Służy do tego funkcja TimeSerial (+ewentualnie DateSerial).
Oczywiście trzeba sobie napisać funkcję, która wyłuska odpowiednie "składowe".
Mogłaby wyglądać następująco:

Option Compare Database
Option Explicit

Private Type args
    d As Long
    h As Long
    m As Long
    s As Long
End Type


Function GetTime(czas As String)
Dim r As args
Dim i As Integer
Dim retVal As String
Dim litera As String

retVal = "0"
For i = 1 To Len(czas)
litera = Mid(czas, i, 1)
If IsNumeric(litera) Then
retVal = retVal & litera
Else
Select Case litera
Case "d"
r.d = r.d + Val(retVal)
Case "h"
r.h = r.h + Val(retVal)
Case "m"
r.m = r.m + Val(retVal)
Case "s"
r.s = r.s + Val(retVal)
Case Else

End Select
retVal = "0"
End If
Next

GetTime = r.d + TimeSerial(r.h, r.m, r.s)

End Function


Obłuży różne dziwolągi:

1h23m4s	01:23:04
12h13s	12:00:13
15m25s	00:15:25
22h5s	22:00:05
15h	15:00:00
34m23s	00:34:23
3d23h345s	02-01-1900 23:05:45
12hh34s12s34mm123ggabcdefg	12:34:46
75m23s	01:15:23

literały spoza "dhms" zignoruje, kilkakrotne wystąpienie tego samego literału zsumuje.
Czy to potrzebne, pewnie nie. Ale warto się zabezpieczać na wszelki wypadek.

    Jeśli interwał przekroczy 1 (1 doba), to wyświetli jako datę, np. 02-01-1900 23:05:45, ale nie trzeba się tym przejmować, bo jest to tak naprawdę liczba 3,96232638888889, która bardzo ładnie zostanie zsumowana z innymi, w przypadku agregacji.

grupa: pl.comp.bazy-danych.msaccess
wątek: Konkatenacja -> edycja -> rozbicie
przedstawili: Pawel81, Zbigniew Bratko

tmpStr = valStr
While Len(tmpStr) > 0
    strComposeBis = strComposeBis & _     tmpStr = Mid$(tmpStr, splitCount + 1)
Wend

lLenDelim = Len(sDelim)
lLenStr = Len(sStrIn)

If (lLenStr Mod lLenField) > 0 Then
    lCountDelim = lLenStr \ lLenField
Else
    lCountDelim = lLenStr \ lLenField - 1
End If

lLenStr = lLenStr + lLenDelim * (lCountDelim + 1)
' zapełnij bufor wyjściowy
zbDelimitedString = Space(lLenStr)
lStep = lLenField + lLenDelim

For i = 0 To lCountDelim
    lOffset = i * lStep + 1
    ' wstawiaj z odpowiednim przesunięciem elementy ciągu wejściowego
    Mid$(zbDelimitedString, lOffset, lLenField) = _
        Mid$(sStrIn, i * lLenField + 1, lLenField)
Next

lLenStr = lLenStr - lLenDelim
For i = lLenField + 1 To lLenStr Step lStep
    Mid$(zbDelimitedString, i, lLenDelim) = sDelim
Next

' dopisz separator na końcu
Mid$(zbDelimitedString, lLenStr + 1, lLenDelim) = sDelim

• Mamy do dyspozycji kilka podstawowych funkcji operujących na ciągach znaków:

Mid(string, start[, length])

zwraca wartość typu Variant (String) zawierającą podaną liczbę znaków z ciągu znaków.

Len(ciąg | nazwa_zmiennej)

zwraca wartość typu Long zawierającą liczbę znaków w ciągu znaków lub liczbę bajtów niezbędnych do przechowania zmiennej.

Split(expression[, delimiter[, limit[, compare]]])

zwraca jednowymiarową tablicą o dolnym indeksie równym zero, zawierającą wyszczególnioną liczbę podciągów.

Replace(expression, find, replace[, start[, count[, compare]]])

zwraca ciag znaków w którym określone podciągi zostały zastąpione, wyszczególnioną ilość razy, innym podciągiem .

Zadeklarujmy potrzebne zmienne:
Dim sHexLong As String
Dim sHexByte1 As String
Dim sHexByte2 As String
Dim sReplaced As String
Dim sHexByte() As String
Dim i As Long

Metoda 1 - Mid & Mid

Metoda 2 - Mid, Mid

Metoda 3 - Replace

Metoda 4 - Split

• Postać zbioru zależy od funkcji jakiej użyjemy do konwersji wartości numerycznych
    na znakowe:

Chr(charcode)

zwraca wartość typu String zawierającą znak odpowiadający podanemu kodowi.
• charcode

Obowiązkowy argument identyfikujący znak powinien być w/g opisu typu Long, ale przykładowo dla litery "ł" funkcji ChrW można przekazać argument następująco:
• liczbowy, dziesiętnie ChrW(322),
• liczbowy, szesnastkowo ChrW(&H0142)
• liczbowy, przekonwertowany ciąg znaków ChrW(CLng("&H0142"))
• ciag znaków, dziesiętnie ChrW("322"),
• ciag znaków, szesnastkowo ChrW("&H0142")
    Funkcja ChrW zawsze zwraca wartość typu String zawierającą znak w formacie Unicode z wyjątkiem platform gdzie format Unicode nie jest obsługiwany

StrConv(string, conversion)

zwraca wartość typu Variant (String) poddaną żądanej konwersji.
• string

w/g opisu argument jest zmienną znakową, ale można również w tym argumencie przekazać odpowiednio przygotowana tablicę typu Byte
np. dla litery "ł" tablica aBytes(0 To 3) będzie zawierała cztery elementy aBytes(0) = &H42: aBytes(1) = &H0: aBytes(2) = &H1: aBytes(3) = &H0
Możemy to sprawdzić w poniższy sposób:

Dim aBytes() As Byte
aBytes = StrConv("ł", vbUnicode)
For i = 0 To UBound(aBytes)
    Debug.Print "&H" & Hex$(aBytes(i)); " ";
Next

• conversion

vbUnicode - zamienia ciąg na postać Unicode, stosując domyślną stronę kodową systemu.
vbFromUnicode - zamienia ciąg z postaci Unicode na znaki z domyślnej strony kodowej systemu.

    Ze względu na szybkość działania odrzucamy najwolniejszy sposób oparty na funkcji Split, a tym samym zostają nam do przetestowania trzy metody:

Metoda 1. (Mid & Mid) + ChrW

Metoda 2. (Mid, Mid)+ CopyMemory

Metody 3. (Replace) + ChrW

1. zamiast funkcji Mid i ChrW użyjemy funkcji tekstowych Mid$ i ChrW$
2. zamiast konkatenacji ciągów znaków zastosujemy instrukcję Mid$ zgodnie z poniższym przykładem:
   
   Dim sStrOut As String
   Dim sHexLong As String * 6
   Dim i As Long
   
   ' zainicjuj zwracany ciąg znaków (przykładowo 100 znaków)
   sStrOut = Space(100)
   ' wpisz jednorazowo dwa pierwsze znaki,
   ' aby nie robić tego za każdym razem w pętli
   Mid$(sHexLong, 1, 2) = "&H"
   For i = 1 To 100
   
   ' na trzecim i następnych miejscach wpisz cztery znaki
   ' liczby w zapisie szesnastkowym,
   Mid$(sHexLong, 3, 4) = "0142"
   ' dopisuj kolejno przekonwertowane znaki w zwracanym ciągu
   Mid$(sStrOut, i, 1) = ChrW$(CLng(sHexLong))
   
   Next
   

Ostatecznie nasze funkcje będą miały postać:

' Metoda 1. Mid$ & Mid$ + inst. Mid$
Public Function zbUCS2Win_Mid(sUcsIn As String) As String
Dim sHexLong As String * 6
Dim lLenStr As Long
Dim i As Long, j As Long, k As Long


End Function


' Metoda 2. Mid$, Mid$ + CopyMempry + inst. Mid$
Private Declare Sub CopyMemory Lib "kernel32" _

Public Function zbUCS2Win_Mem(sUcsIn As String) As String
Dim sHexByte As String * 4
Dim aBytes() As Byte
Dim lLenStr As Long
Dim i As Long, j As Long, k As Long


End Function


' Metoda 3. Replace + inst. Mid$
Public Function rkUCS2Win_Replace(sUcsIn As String) As String
Dim sHexLong As String * 6
Dim sReplaced As String
Dim lLenStr As Long
Dim i As Long, j As Long

End Function

Oczywiście można sobie odpuścić taką optymalizację, jeżeli jesteśmy na 100% pewni, że nie spotka nas niespodzianka. Wynikowy tekst, po przetworzeniu testowego ciągu MY_UCS, zawiera 44 znaki i brzmi: "Wesołych Świąt dla Ciebie i Twoich bliskich."

    Sprawdźmy, jak będzie się zmieniała szybkość przetwarzania coraz dłuższych ciągów znaków. Porównamy szybkość funkcji zbUCS2Win_Mid z poniższą funkcją dla jednorazowego wywołania dla ciągu sUcsIn dającego wynikowy tekst o coraz większej długości:

Public Function zbMidAndMid(sUcsIn As String) As String
Dim i As Long
End Function

    A co będzie jeżeli zajdzie potrzeba odkodowywania kilkudziesięciu długich tekstów dziennie. Jeżeli nie będzie takiej potrzeby, to nic się nie stanie. Nikt nie zwróci uwagi na te 50 ms przyspieszenia ;-)

grupa: pl.comp.lang.vbasic
wątek: Algorytm na hasło w VB.NET
przedstawił: Zbigniew Bratko

For i = 33 To 126
Select Case i
Case 33 To 47, 58 To 64, 91 To 96, 123 To 126
m_sSpecChars = m_sSpecChars & Chr$(i)
Case 65 To 90
m_sBigLetters = m_sBigLetters & Chr$(i)
Case Else
End Select
Next
' dodaj ogonki
m_sBigLetters = m_sBigLetters & "ĄĆĘŁŃÓŚŻŹ"
m_sSmallLetters = LCase(m_sBigLetters)

m_lLenSpec = Len(m_sSpecChars)
m_lLenLett = Len(m_sBigLetters)

k = lLenPsw \ 4
If k - lLenPsw / 4 = 0 Then k = k - 1

For i = 0 To k Next

' wymieszaj poszczególne znaki i obetnij do żądanej długości
zbMakePassword = Left$(zbMixString(sPsw), lLenPsw)

For i = Len(sStrIn) To 1 Step -1
    j = Int(i * Rnd) + 1
    zbMixString = zbMixString & Mid$(sStrIn, j, 1)
    sStrIn = Left$(sStrIn, j - 1) & Mid$(sStrIn, j + 1)
Next

lLenIn = Len(sStrngUTF8)
' pobierz wielkość potrzebnego buforu na wyjściowy ciąg znaków WIN-1250
lLenOut = MultiByteToWideChar( _ ' przygotuj bufor
UTF8toWin = String$(lLenOut, vbNullChar)
' konwertuj ciąg wejściowy
lRet = MultiByteToWideChar( _
UTF8toWin = Left$(UTF8toWin, lRet)

lLenIn = Len(sStringIn)
' pobierz wielkość potrzebnego buforu na wyjściowy ciąg znaków UTF8
lLenOut = WideCharToMultiByte( _ ' przygotuj bufor
WinToUTF8 = String(lLenOut, vbNullChar)
' konwertuj ciąg wejściowy
lRet = WideCharToMultiByte( _
WinToUTF8 = Left$(WinToUTF8, lRet)

grupa: pl.comp.lang.vbasic
wątek: MD5 i Excel
przedstawił: Piotr Lipski

grupa: pl.comp.lang.vbasic
wątek: Import pliku .txt bez znaku końca linii
przedstawił: Zbigniew Bratko

grupa: pl.comp.bazy-danych.msaccess
wątek: Wyodrębnianie liczb z ciągu alfanumerycznego
przedstawił: Zbigniew Bratko