Tekst informacyjny o polityce Cookies Close   
    
 
         
• Strona główna
• 1. Linki
• 3. Kontakt: e-Mail
 
         
• 1. Baza danych
• 2. Tabele i kwerendy
• 3. Formularze
• 4. Raporty
• 5. Moduły i makra
• 6. Obsługa błędów
 
    

II.   VBA 

    
• 1. Okna Accessa
• 2. Okna Formularzy
• 3.Okna Dialogowe
• 4. Tekst
• 5. Liczby
• 6. Pliki
• 7. Inne
 
    

III.   API 

    
• 1. Ogólnie o API
• 2. Funkcje API
• 3. System
• 4. Praca z oknami
• 5. Okna dialogowe
• 6. API - Inne
 
         
• 1. Bitmapy 24 Bit
• 2. GDI i HDC
• 3. Kody kreskowe
• 4. Formant Image
• 5. FreeImage.dll
 
    

V.   Inne 

    
• 1. Shell i MsDOS
• 2. Kontrolki
• 3. ६ԼҚ ਸ
• 4. Unikod

 
Odwiedzin:

Logo AccessFAQ• V.4. Inne - Unikod •

4.1 Jak sprawdzić, czy ciąg znaków jest w wersji Unicode ?
4.2 Jak pobrać długość ciągu znaków w wersji Unicode ?
4.3 Jak otworzyć do odczytu plik, którego ścieżka zawiera znaki Unikodowe (inne niż polskie ogonki), na przykładzie pobierania pliku (jego fragmentu) do tablicy bajtów ?
4.4 Jak przekształcić ciąg znaków Unicode na ciąg przystosowany do wyświetlenia na stronie WWW ?
4.5 Jak przekonwertować tekst pisany np. cyrylicą na tekst pisany polskimi znakami ?
4.6 Jak pobrać zawartość pliku, którego ścieżka zawiera znaki Unikodowe oraz jak porcjami przeglądać w formancie TextBox zawartość dużego pliku ?
 

4.1 Jak sprawdzić, czy ciąg znaków jest w wersji Unicode ?

Private Declare Function IsTextUnicode Lib "advapi32" _
(lpBuffer As Any, _
ByVal cb As Long, _
lpi As Long) As Long

    Funkcja IsTextUnicode sprawdza, czy bufor wejściowy zawiera tekst w postaci Unicode, zwraca zero, jeżeli tekst w buforze nie przechodzi testu metodą przekazaną przez wskaźnik lpi, jeżli tekst jest zgodny z metodą testu, funkcja zwraca wartość różną od zera, a wynik testu zwracany jest za pośrednictwem wskaźnika lpi,

lpBuffer - wskaźnik do testowanego bufora wejściowego,
cb - rozmiar w bajtach wejściowego buforu wskazywany przez lpBuffer,
lpi -
• na wejściu określa metody, które mają być użyte do przetestowania tekstu znajdującego się w buforze,
• na wyjściu określa wartość składowej flagi, dla której zawartość bufora przeszła test (zazwyczaj tylko flagi ustawione na wejściu, mogą być zwrócone na wyjściu), przy niepowodzeniu testu zwracane jest zero,


Private Const IS_TEXT_UNICODE_ASCII16 = &H1
    ' tekst jest typu Unicode i zawiera wyłącznie zastaw znaków "zero-extended" ASCII,
Private Const IS_TEXT_UNICODE_REVERSE_ASCII16 = &H10
    ' jak wyżej, ale tekst Unicode posiada odwróconą kolejnością bajtów,
Private Const IS_TEXT_UNICODE_STATISTICS = &H2
    ' ustalenie, czy tekst jest Unicode dokonywane jest przy zastosowaniu analizy statystycznej, metoda ta nie daje stuprocentowej pewności,
Private Const IS_TEXT_UNICODE_REVERSE_STATISTICS = &H20
    ' jak w wyżej, ale tekst Unicode posiada odwróconą kolejnością bajtów,
Private Const IS_TEXT_UNICODE_CONTROLS = &H4
    ' tekst Unicode zawiera niedrukowalne znaki np.: RETURN, LINEFEED, SPACE, CJK_SPACE, TAB,
Private Const IS_TEXT_UNICODE_REVERSE_CONTROLS = &H40
    ' jak wyżej, ale tekst Unicode posiada odwróconą kolejnością bajtów,
Private Const IS_TEXT_UNICODE_BUFFER_TOO_SMALL ="&H??"
    ' w buforze istnieje zbyt mało znaków by dokonać wiarygodnej analizy tekstu (mniej niż dwa bajty),
Private Const IS_TEXT_UNICODE_SIGNATURE = &H8
    ' na początku tekstu znajduje się Unicodowy znacznik kolejności bajtów (BOM) 0xFEFF,
Private Const IS_TEXT_UNICODE_REVERSE_SIGNATURE = &H80
    ' na początku tekstu znajduje się Unicodowy odwrócony znacznik kolejności bajtów (Reverse BOM) 0xFFFE,
Private Const IS_TEXT_UNICODE_ILLEGAL_CHARS = &H100
    ' tekst zawiera jeden z niedozwolonych znaków Unicode: odwrócony znacznik kolejności bajtów (Reverse BOM) 0xFFFE, UNICODE_NUL, CRLF (zapisane jako jedno słowo), lub wartości 0xFFFF,
Private Const IS_TEXT_UNICODE_ODD_LENGTH = &H200
    ' liczba znaków w ciągu jest nieparzysta, więc z definicji tekst nie jest tekstem Unicode,
Private Const IS_TEXT_UNICODE_NULL_BYTES = &H1000
    ' tekst zawiera znak vbNullChar (Chr(0)), co znaczy że tekst nie jest w wersji ASCII,
Private Const IS_TEXT_UNICODE_UNICODE_MASK = &HF
    ' flaga ta jest kombinacją: _
IS_TEXT_UNICODE_ASCII16 Or _
IS_TEXT_UNICODE_STATISTICS Or _
IS_TEXT_UNICODE_CONTROLS Or _
IS_TEXT_UNICODE_SIGNATURE,
Private Const IS_TEXT_UNICODE_REVERSE_MASK = &HF0
    ' flaga ta jest kombinacją: _
IS_TEXT_UNICODE_REVERSE_ASCII16 Or _
IS_TEXT_UNICODE_REVERSE_STATISTICS Or _
IS_TEXT_UNICODE_REVERSE_CONTROLS Or _
IS_TEXT_UNICODE_REVERSE_SIGNATURE
Private Const IS_TEXT_UNICODE_NOT_UNICODE_MASK = &HF00
    ' flaga ta jest kombinacją: _
IS_TEXT_UNICODE_ILLEGAL_CHARS Or _
IS_TEXT_UNICODE_ODD_LENGTH Or _
dwa aktualnie nieużywane bity,
Private Const IS_TEXT_UNICODE_NOT_ASCII_MASK = &HF000
    ' flaga ta jest kombinacją: _
IS_TEXT_UNICODE_NULL_BYTES Or _
trzy aktualnie nieużywane bity,
Private Const IS_TEXT_UNICODE_DBCS_LEADBYTE = &H400
    ' tekst jest kodowany jako DBSC z bajtem prowadzącym kodowania dwubajtowego,

 ΔΔΔ 

 

4.2 Jak pobrać długość ciągu znaków w wersji Unicode ?

Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" _
(ByVal lpString As String) As Long

• Alias "lstrlenA" - wersja ANSII - zwraca długość ciągu w bajtach,
• Alias "lstrlenW" - wersja Unicode - zwraca długość ciągu w znakach,

    • w obu przypadkach nie jest uwzględniany znaku końca ciągu,




    Może paść pytanie, dlaczego używać dodatkowej funkcji API, kiedy możemy analogicznie jak dla ciągu znaków w wersji ANSII szukać pierwszego wystąpienia dwóch znaków vbNullChar & vbNullChar zamiast jednego i następnie pobrać wszystkie znaki na lewo od pierwszego wystąpienia podwójnego znaku vbNullChar.

    No niby można, więc spróbujmy tak zrobić:

sStrW = StrConv("Ala", vbUnicode) & vbNullChar & vbNullChar
lInStr = InStr(1, sStrW, vbNullChar & vbNullChar, vbBinaryCompare)
sRet = Left$(sStrW, lInStr - 1)
Debug.Print "1. |" & StrConv(sRet, vbFromUnicode) & "|"
' coś jest nie tak, bo na wyjściu otrzymujemy |Al? zamiast |Ala|

' wprowadźmy poprawkę przy pobieraniu znaków z lewej strony od podwójnego vbNullChar

sRet = Left$(sStrW, lInStr - 0)
Debug.Print "2. |" & StrConv(sRet, vbFromUnicode) & "|"

' teraz niby jest dobrze, ale sprawdźmy dla ciągu "Alą"
sStrW = StrConv("Alą", vbUnicode) & vbNullChar & vbNullChar
lInStr = InStr(1, sStrW, vbNullChar & vbNullChar, vbBinaryCompare)
sRet = Left$(sStrW, lInStr - 0)
Debug.Print "3. |" & StrConv(sRet, vbFromUnicode) & "|"
' i znowu źle, na wyjściu otrzymujemy |Alą? zamiast |Ala|

' wprowadźmy poprawkę na nieparzystość zmiennej lInStr
sStrW = StrConv("Ala(ą)", vbUnicode) & vbNullChar & vbNullChar
lInStr = InStr(1, sStrW, vbNullChar & vbNullChar, vbBinaryCompare)
' poprawka na nieparzystość
If (lInStr Mod 2) = 0 Then lInStr = lInStr + 1
sRet = Left$(sStrW, lInStr - 1)
Debug.Print "4. |" & StrConv(sRet, vbFromUnicode) & "|"
' jest już dobrze, otrzymujemy na wyjściu |Ala| i |Alą|,

' a co będzie jak spotkają się obok siebie dwa znaki Chr$(0) pochodządze od sąsiednich znaków Unicode:
' hipotetyczny ciąg znaków:
' sStrW = "Ala切" & vbNullChar & vbNullChar

sStrW = Chr$(65) & Chr$(0) & Chr$(108) & Chr$(0) & _
Chr$(97) & Chr$(0) & Chr$(0) & Chr$(250) & _
Chr$(0) & Chr$(0)
lInStr = InStr(1, sStrW, vbNullChar & vbNullChar, vbBinaryCompare)
If (lInStr Mod 2) = 0 Then lInStr = lInStr + 1
sRet = Left$(sStrW, lInStr - 1)
Debug.Print "5. |" & StrConv(sRet, vbFromUnicode) & "|"
' niestety, na wyjściu otrzymujemy |Ala| zamiast |Ala?|,

' ostatecznie zróbmy tak: przekonwertujmy ciąg sStrW na ANSII, pobierzmy pierwsze wystąpienie znaku vbNullChar i odetnijmy dwa razy więcej znaków licząc od lewej w oryginalnym ciągu sStrW
lInStr = 2 * InStr(1, StrConv(sStrW, vbFromUnicode), vbNullChar, _
vbBinaryCompare)
sRet = Left$(sStrW, lInStr - 2)
Debug.Print "6. |" & StrConv(sRet, vbFromUnicode) & "|"


' i czy nie jest jednak prościej z użyciem funkcji API ;-)

sRet = Left$(sStrW, 2 * lstrlen(sStrW))
Debug.Print "7. |" & StrConv(sRet, vbFromUnicode) & "|"

 ΔΔΔ 

 

4.3 Jak otworzyć do odczytu plik, którego ścieżka zawiera znaki Unikodowe (inne niż polskie ogonki), na przykładzie pobierania pliku (jego fragmentu) do tablicy bajtów ?

Przykład Jak pobrać plik (fragment pliku) do tablicy bajtów ? korzysta z instrukcji Open :

Open sFilePathW For Binary Access Read As #ff
    Get #ff, lStart, aRetBytes
Close #ff

    Niestety, ale instrukcja Open nie potrafi prawodłowo odczytać Unikodowej scieżki sFilePathW, a konwersja sFilePathA = StrConv(sFilePathW, vbFromUnicode) nic nie da, ponieważ przekonwertowany ciąg nie jest prawidłową scieżką do pliku.

I znowu będziemy musieli skorzystać z funkcji API:




Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileW" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
Private Declare Function ReadFileEx Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpOverlapped As OVERLAPPED, _
ByVal lpCompletionRoutine As Long) As Long

Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal Handle As Long) As Long

Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const MY_FILE_ATTRIBUTE = _
FILE_ATTRIBUTE_ARCHIVE + _
FILE_ATTRIBUTE_HIDDEN + _
FILE_ATTRIBUTE_NORMAL + _
FILE_ATTRIBUTE_READONLY + _
FILE_ATTRIBUTE_SYSTEM
Private Declare Function GetFileInformationByHandle _
Lib "kernel32" _
(ByVal hFile As Long, _
lpFileInformation As _
BY_HANDLE_FILE_INFORMATION) As Long

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type BY_HANDLE_FILE_INFORMATION
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
dwVolumeSerialNumber As Long
nFileSizeHigh As Long
nFileSizeLow As Long
nNumberOfLinks As Long
nFileIndexHigh As Long
nFileIndexLow As Long
End Type
Private Const MAXDWORD As Long = &HFFFF



' Pobiera kolejne bajty z pliku, zwraca ilość pobranych bajtów, a w argumencie ByRef aRetBytes() As Byte zwraca tablicę odczytanych bajtów, przy błędzie zwraca 0 (False),
' • sFileNameW - pełna ścieżka do pliku, plik musi istnieć i nie może być otwarty na wyłączność, jeżeli plik jest pusty funkcja zwraca -1 i pustą tablicę aRetBytes()
' • lStart - numer bajtu od którego ma nastąpić odczyt, domyślnie = 1, jeżeli nr bajtu początkowego jest większy od ilości bajtów w pliku funkcja zwraca -1 i pustą tablicę aRetBytes(),
' • lBytesToRead - ilość bajtów do pobrania, dla domyślnej wartości -1 pobierane
są wszystkie bajty, począwszy od bajtu startowego (lStart), jeżeli ilość bajtów do pobrania przekracza ilość dostępnych bajtów, funkcja zwraca wszystkie bajty od lStart do końca pliku,

Public Function zbFileToArrayW( _
ByVal sFileNameW As String, _
aRetBytes() As Byte, _
Optional ByVal lStart As Long = 1, _
Optional ByVal lBytesToRead As Long = -1) As Long

Dim bhfi As BY_HANDLE_FILE_INFORMATION' struktura z informacjami zwracanymi przez
' funkcję GetFileInformationByHandle
Dim ol As OVERLAPPED' struktura z informacjami Input/Output
Dim sBuffer As String' zwracany odczytany ciąg znaków
Dim hFile As Long' uchwyt otwartego pliku
Dim lSizeBff As Long' wielkość buforu na odczytany ciąg znaków
Dim lFileSize As Long' maksymalna ilość bajtów do odczytania
Dim lRet As Long'

hFile = CreateFile(sFileNameW, GENERIC_READ, _
FILE_SHARE_READ, ByVal 0&, _
OPEN_EXISTING, _
MY_FILE_ATTRIBUTE, ByVal 0&)

' przy niepowodzeniu wyjdź z funkcji
If hFile = -1 Then
zbFileToArrayW = -1
Exit Function
End If

' pobierz niektóre dane pliku
lRet = GetFileInformationByHandle(hFile, bhfi)
If lRet = 0 Then
lRet = CloseHandle(hFile)
zbFileToArrayW = -1
Exit Function
Else
lFileSize = bhfi.nFileSizeHigh * (MAXDWORD) + _
bhfi.nFileSizeLow
End If

' sprawdź, czy bajt startowy mieści się w obrębie pliku
If (lStart < 1) Or (lStart > lFileSize) Then
zbFileToArrayW = -1
Exit Function
End If

If lBytesToRead = -1 Then
lBytesToRead = lFileSize - lStart + 1
Else
If (lStart + lBytesToRead) > lFileSize Then
    lBytesToRead = lFileSize - lStart + 1
End If
End If

' przygotuj bufor
sBuffer = String(lBytesToRead, vbNullChar)

ol.offset = lStart - 1

lRet = ReadFileEx(hFile, ByVal sBuffer, _
lBytesToRead, ol, ByVal 0&)

lRet = CloseHandle(hFile)

If ol.InternalHigh = 0 Then
' plik zerowej długości
ElseIf ol.InternalHigh < lBytesToRead Then
aRetBytes() = StrConv(Left$(sBuffer, _
ol.InternalHigh), vbFromUnicode)
Else
aRetBytes() = StrConv(sBuffer, vbFromUnicode)
End If

zbFileToArrayW = ol.InternalHigh

End Function

 ΔΔΔ 

 

4.4 Jak przekształcić ciąg znaków Unicode na ciąg przystosowany do wyświetlenia na stronie WWW ?

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)


' przekształca ciąg znaków Unicode na ciąg przystosowany do wyświetlenia na stronie WWW. Znaki z zakresu podstawowego ASCII (7-bit) są zapisywane jako normalny znak, pozostałe jako leksem - odpowiedni dziesiętny kod znaku &#Dec;
Public Function zbUnicodeToUTF8Html(sUnicode As String) As String
Dim aBytes() As Byte
Dim iLoWord As Integer
Dim lDWord As Long
Dim sUTF8 As String
Dim i As Long

aBytes = StrConv(sUnicode, vbFromUnicode)

For i = LBound(aBytes) To UBound(aBytes) Step 2
iLoWord = zbHiLoByteToWord(aBytes(i + 1), aBytes(i))
If iLoWord < 128 Then
' znaki 7-bitowe
sUTF8 = sUTF8 & Chr$(aBytes(i))
Else
lDWord = zbHiLoWordToDWord(0, iLoWord)
sUTF8 = sUTF8 & "&#" & lDWord & ";"
End If
Next

zbUnicodeToUTF8Html = sUTF8

End Function



przykładowe teksty:
Zażółć gęślą jaźń
Za&#380;&#243;&#322;&#263; g&#281;&#347;l&#261; ja&#378;&#324;
のコンテンツを本サイトに移行いたしました。ライブラリにアクセスし &#12398;&#12467;&#12531;&#12486;&#12531;&#12484;&#12434;&#26412; &#12469;&#12452;&#12488;&#12395;&#31227;&#34892;&#12356;&#12383; &#12375;&#12414;&#12375;&#12383;&#12290;&#12521;&#12452;&#12502; &#12521;&#12522;&#12395;&#12450;&#12463;&#12475;&#12473;&#12375;


' pomocnicze funkcje konwertujące
' konwersja starszego i młodszego bajtu do słowa
Public Function zbHiLoByteToWord( _
HiByte As Byte, _
LoByte As Byte) As Integer
Dim arrByte(0 To 1) As Byte
arrByte(0) = LoByte
arrByte(1) = HiByte
CopyMemory zbHiLoByteToWord, arrByte(0), 2
End Function

' konwersja starszego i młodszego słowa do podwójnego słowa
Public Function zbHiLoWordToDWord( _
HiWord As Integer, _
LoWord As Integer) As Long
Dim arrInt(0 To 1) As Integer
arrInt(0) = LoWord
arrInt(1) = HiWord
CopyMemory zbHiLoWordToDWord, arrInt(0), 4
End Function

 ΔΔΔ 

 

4.5 Jak przekonwertować tekst pisany np. cyrylicą na tekst pisany polskimi znakami ?



grupa: pl.comp.bazy-danych.msaccess
wątek: Cyrylica i funkcje tekstowe
przedstawił: Zbigniew Bratko



Pytanie:
<cyt>
... potrzebuję funkcji, która zamieni cyrylicę na zwykły tekst,
czyli np. rosyjskie L na angielskie L, coś na kształt transkrypcji...na mój prywatny użytek.
Parę tysięcy wierszy z tabeli ma być wczytane do gps jako zwykly tekst, a nie jako cyrylica.
</cyt>


Odpowiedź:

'    Musimy dysponować dostatecznie długim tekstem zawierającym wszystkie znaki pisane cyrylicą, lub takowy tekst sobie napisać.
' Następnie wywołujemy funkcję, która będzie pobierała kolejne znaki z ciągu wejściowego sTextRus i zapisywała w tabeli "tRusChars" znak i jego kod AscW.
' Potem musimy ręcznie dopisać w tabeli (korzystając z formularza "frmSlowar") polskie odpowiedniki poszczególnych znaków.

' Tabela tRusChars powinna zawierać następujace pola:
' • tChrCode [Long]; Indexed = Yes (No Duplicates)
' • tRusChr [Text]; FieldSize = 1
' • tPolChr [Text]; FieldSize = 4



Private Function zbSlowar(sTextRus As String)
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sChrW As String * 1
Dim i As Long

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tRusChars", _
dbOpenDynaset, dbAppendOnly)
For i = 1 To Len(sTextRus)
' pobieraj kolejne znaki z ciągu wejściowego
Mid$(sChrW, 1, 1) = Mid$(sTextRus, i, 1)
' pomiń błąd powtórzenia klucza
On Error Resume Next
If AscW(sChrW) > 255 Then
With rst
.AddNew
!tChrCode = AscW(sChrW)
!tRusChr = sChrW
.Update
End With
End If
On Error GoTo 0
Next

rst.Close
Set rst = Nothing
Set dbs = Nothing

    ' otwórz formularz, by dopisać polskie odpowiedniki znaków
DoCmd.OpenForm "frmSlowar"

End Function


' Funkcja konwertujaca
Private Function zbPieriewiesti(sTextIn As String) As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sChrW As String * 1
Dim lAscW As Long
Dim sOut As String
Dim sRusText As String
Dim i As Long

' wstępna obróbka teksu oryginalnego:
' zamień Ль na L, a ль na l

sRusText = Replace(sTextIn, _
ChrW$(1051) & ChrW$(1100), _
"L", , , vbBinaryCompare)
sRusText = Replace(sRusText, _
ChrW$(1083) & ChrW$(1100), _
"l", , , vbBinaryCompare)

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tRusChars", dbOpenTable)

With rst
.Index = "tChrCode"
For i = 1 To Len(sRusText)
' pobieraj kolejne znaki z ciągu wejściowego
Mid$(sChrW, 1, 1) = Mid$(sRusText, i, 1)
lAscW = AscW(sChrW)
If lAscW > 255 Then
' szukaj kodu znaku
.Seek "=", lAscW
If .NoMatch Then
Debug.Print "\ Uzupełnij dane \"
sOut = sOut & "\"
Else
sOut = sOut & Nz(!tPolChr, "_")
End If
Else
sOut = sOut & sChrW
End If
Next
End With

rst.Close
Set rst = Nothing
Set dbs = Nothing

' tutaj możemy podmienić charakterystyczne zestawy znaków na swoje
sOut = Replace(sOut, "łi", "li", , , vbBinaryCompare)
' sOut = Replace(sOut, ... )
' sOut = Replace(sOut, ... )
zbPieriewiesti = sOut

End Function


Baza jest w formacie Access 2000, ponieważ Access '97 nie obsługuje Unikodu.
   Przykład:  • uni43a_05A2k  •  34 KB  •  status: FREE  Pobrano    razy   


 ΔΔΔ 

 

4.6 Jak pobrać zawartość pliku, którego ścieżka zawiera znaki Unikodowe oraz jak porcjami przeglądać w formancie TextBox zawartość dużego pliku ?


    O problemach wczytania zawartości pliku z unikodowa nazwą, do tablicy bajtów pisałem w przykładzie: 4.3 Jak otworzyć do odczytu plik, którego ścieżka zawiera znaki Unikodowe ...
    Dodatkowym problemem przy przeglądaniu dużego pliku jest ograniczenie formantu TexBox, który prawidłowo obsługuje ciąg znaków o maksymalnej długości 64 000 znaków.
Aby ominąć to ograniczenie plik należy wyświetlać w porcjach nie większych niż 64 000 znaków.



   Przykład:  • uni43a_06  •  107 KB  •  status: FREE  Pobrano    razy   


Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileW" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
Private Declare Function ReadFileEx Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpOverlapped As OVERLAPPED, _
ByVal lpCompletionRoutine As Long) As Long

Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal Handle As Long) As Long

Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const MY_FILE_ATTRIBUTE = _
FILE_ATTRIBUTE_ARCHIVE + _
FILE_ATTRIBUTE_HIDDEN + _
FILE_ATTRIBUTE_NORMAL + _
FILE_ATTRIBUTE_READONLY + _
FILE_ATTRIBUTE_SYSTEM
Private Declare Function GetFileInformationByHandle _
Lib "kernel32" _
(ByVal hFile As Long, _
lpFileInformation As _
BY_HANDLE_FILE_INFORMATION) As Long

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type BY_HANDLE_FILE_INFORMATION
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
dwVolumeSerialNumber As Long
nFileSizeHigh As Long
nFileSizeLow As Long
nNumberOfLinks As Long
nFileIndexHigh As Long
nFileIndexLow As Long
End Type
Private Const MAXDWORD As Long = &HFFFF



' Przy powodzeniu zwraca określoną zawartośc pliku, przy błędzie zwraca ciąg zerowej długości,
' • sFileNameW - pełna ścieżka do pliku w wersji Unicode, plik musi istnieć i nie może być otwarty na wyłączność, jeżeli plik jest pusty funkcja zwraca ciąg zerowej długości,
' • lStart - numer znaku od którego ma nastąpić odczyt, domyślnie = 1, jeżeli nr znaku początkowego jest większy od ilości znaków w pliku funkcja zwraca ciąg zerowej długości,
' • lCharsToRead - ilość znaków do pobrania, dla domyślnej wartości -1 pobierane są wszystkie znaki, począwszy od znaku startowego (lStart), jeżeli ilość znaków do pobrania przekracza ilość dostępnych znaków, funkcja zwraca wszystkie znaki od lStart do końca pliku,
Public Function zbFileToStringW(ByVal sFileNameW As String, _
Optional ByVal lStart As Long = 1, _
Optional ByVal lCharsToRead As Long = -1, _
Optional lRetFileSize As Long) As String

Dim bhfi As BY_HANDLE_FILE_INFORMATION' struktura z informacjami zwracanymi przez
' funkcję GetFileInformationByHandle
Dim ol As OVERLAPPED' struktura z informacjami Input/Output
Dim hFile As Long' uchwyt otwartego pliku
Dim lSizeBff As Long' wielkość buforu na odczytany ciąg znaków
Dim lFileSize As Long' maksymalna ilość bajtów do odczytania
Dim lRet As Long'

hFile = CreateFile(sFileNameW, GENERIC_READ, _
FILE_SHARE_READ, ByVal 0&, _
OPEN_EXISTING, _
MY_FILE_ATTRIBUTE, ByVal 0&)

' przy niepowodzeniu wyjdź z funkcji
If hFile = -1 Then
   lRetFileSize = -1
   Exit Function
End If

' pobierz niektóre dane pliku
lRet = GetFileInformationByHandle(hFile, bhfi)
If lRet = 0 Then
   lRet = CloseHandle(hFile)
   lRetFileSize = -1
   Exit Function
Else
   lFileSize = bhfi.nFileSizeHigh * (MAXDWORD) + _
bhfi.nFileSizeLow
   lRetFileSize = lFileSize
End If

' sprawdź, czy bajt startowy mieści się w obrębie pliku
If (lStart < 1) Or (lStart > lFileSize) Then Exit Function

If lCharsToRead = -1 Then
   lCharsToRead = lFileSize - lStart + 1
Else
   If (lStart + lCharsToRead) > lFileSize Then
      lCharsToRead = lFileSize - lStart + 1
   End If
End If

' przygotuj bufor
zbFileToStringW = String(lCharsToRead, vbNullChar)

ol.offset = lStart - 1
lRet = ReadFileEx(hFile, ByVal zbFileToStringW, _
lCharsToRead, ol, ByVal 0&)
lRet = CloseHandle(hFile)

If ol.InternalHigh = 0 Then
&nbsp;  ' plik zerowej długości
   zbFileToStringW = ""
ElseIf ol.InternalHigh < lCharsToRead Then
   zbFileToStringW = Left$(zbFileToStringW, ol.InternalHigh)
Else
   ' zbFileToStringW
End If

End Function

 ΔΔΔ