Tekst informacyjny o polityce Cookies Close   
    
 
    

 AccessFAQ 

    
• 1. Strona główna
• 2. Kontakt: e-Mail
 
    

I.   MS Access 

    
• 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
 
    

IV.   Grafika 

    
• 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 ?

Aby ustrzec się przed nieprawidłowym działaniem funkcji operujących na ciągach znaków w formacie Unicode, powinniśmy napisać funkcję sprawdzającą format tekstu, przed przekazaniem go do funkcji operujących na tekście w formacie Unicode.
Windows API, w bibliotece "advapi32", zawiera funkcję IsTextUnicode(...) służącą do testowania tekstu roboczego ....

Przykład został trochę rozbudowany i przystosowany do 64-bitowego MS Access (VBA7).
Obecnie przykład znajduje się na stronie:

• Jak sprawdzić, czy tekst jest w formacie Unicode. • Funkcja tekstIsUnicode(...)

 ΔΔΔ 

 

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

 ΔΔΔ