• 24-bitowa nieskompresowana bitmapa
Wszystkie przykłady dotyczące przetwarzania bitmap, ograniczam do 24-bitowych bitmap Bitmapa taka posiada 14 bajtowy nagłówek BITMAPFILEHEADER, zawierający sygnaturę 'BM', 40 bajtowy nagłówek BITMAPINFOHEADER, liczba bitów koloru na jeden piksel wynosi 24, jest zapisana bez użycia algorytmów kompresujących, a kierunek odczytu bajtów z tablicy bajtów obrazu jest w kierunku „z dołu do góry”. Bardziej szczegółowe informacje o strukturze bitmapy można znaleźć na stronie Struktura bitmapy
Co opisuje właściwość PictureData?
Właściwość PictureData faktycznie jest tablicą bajtów. Jeszcze do niedawna dla 24-bitowej bitmapy pierwsze 40 bajty tablicy był to nagłówek BitmapInfoHeader, a następne bajty określały kolor składowych RGB kolejnych pikseli bitmapy. Taką tablicę bajtów określa się mianem upakowana DIB, lub skrótowo DIB.
Niestety, w MS Access 2007+ pojawiła się nowa właściwość bazy danych „Format przechowywania
właściwości obrazów” i pojęcie „upakowana DIB” straciło swoją jednoznaczność.
„upakowana DIB” zaczyna się 40 bajtowym nagłówkiem
BitmaInfoHeader, czyli od 15-go bajtu pliku bitmapy i zawiera wszystkie pozostałe bajty bitmapy.
- W MS Access 2007+ i wyższych wersjach, dla ustawionej opcji „Konwertuj wszystkie dane obrazu na mapy bitowe” oraz w wersji MS Access 2003- i niższych właściwość PictureData zawierać będzie „upakowaną DIB”, czyli 40 bajtowy nagłówek BitmaInfoHeader i wszystkie pozostałe bajty określające kolor składowych RGB pikseli bitmapy.
- dla opcji „Zachowaj format obrazu bitowego”, właściwość PictureData zawierać będzie wszystkie bajty pliku bitmapy, czyli 14 bajtowy nagłówek BitmaFileHeader, 40 bajtowy nagłówek BitmaInfoHeader i wszystkie pozostałe bajty określające kolor składowych RGB pikseli bitmapy.
Na stronie Format właściwości obrazów znajduje się więcej informacji o właściwości „Format przechowywania właściwości obrazów”.
Sposób zapisu bajtów bitmapy we właściwości PictureData
Z przedstawionych powyżej rozważań wynika, że wystarczy pobrać właściwość „Format przechowywania właściwości obrazów” i dla wartości:
- 0 - „Zachowaj format obrazu źródłowego”
- powinniśmy zapisać całą tablicę PictureData na dysk, gdyż zawiera ona wszystkie bajty bitmapy (czyli 14 bajtowy nagłówek BitmaFileHeader, 40 bajtowy nagłówek BitmaInfoHeader i bajty obrazu).
- 1 - „Konwertuj wszystkie dane obrazu na mapy bitowe (zgodne z programem Access 2003- ...)”
-
tablica PictureData zaczyna się 40 bajtowym nagłówkiem BitmaInfoHeader
za którym znajdują się bajty obrazu. Wystarczy utworzyć nagłówek BitmaFileHeader,
wypełnić trzy elementy struktury:
- .bfType=&H4D42, czyli dwa znaki 'BM'
- .bfSize=CLng(UBound(bBmpArray()) + 40 + 1)
- .bfOffBits = 14 + 40
i zapisać na dysk. Prawda, jakie to proste (͡° ͜ʖ ͡°).
Proste jest jedynie w przypadku nowej bazy, w której została wybrana jedna z dwóch opcji
„Formatu przechowywania właściwości obrazów” i opcja ta nigdy nie zostanie zmieniona.
A dlaczego? Wystarczy wykonać prosty test.
W MS Access 2007+ tworzymy nową bazę w formacie *.accdb. Właściwość „Format przechowywania właściwości obrazów” ustawiona
jest domyślnie na „Zachowaj format obrazu źródłowego”. W formularzu wstawiamy formant Rysunek (Image),
a do niego osadzoną 24-bitową bitmapę. Zdarzeniu „Click” formantu Rysunek (Image) przypisujemy procedurę:
Private Sub img_Click()
Dim aPictData() As Byte
aPictData = Me.img.PictureData
Debug.Print "Storage Format = "; CurrentDb.Properties("Picture Property Storage Format")
Debug.Print "&H" & Format$(Hex(aPictData(0)), "00") & Format$(Hex(aPictData(1)), "00")
Debug.Print Chr$(aPictData(0)) & Chr$(aPictData(1))
End Sub
i uruchamiamy procedurę Private Sub img_Click(). Następnie w Menu: „Opcje programu Access”/„Bieżąca baza danych”/ „Format przechowywania właściwości obrazów” zmieniamy na opcję „Konwertuj wszystkie dane obrazu na mapy bitowe” (zgodne z programem Access 2003 i wcześniejszymi wersjami) i ponownie uruchamiamy procedurę img_Click(). W oknie „Immediate” otrzymujemy wynik:
Jak widać, w obu przypadkach w formancie Rysunek (Image) bitmapa zapisana jest w taki sam sposób. Na początku znajduje się 14 bajtowy nagłówek BitmaFileHeader w którym dwa pierwsze bajty to sygnatura pliku 'BM' (&H4D42). Zapis danych jest zgodny z opcją „Zachowaj format obrazu źródłowego”.
Teraz usuwamy bitmapę z formantu Rysunek (Image) i ponownie osadzamy tą samą 24-bitową bitmapę. Uruchamiamy procedurę img_Click(), przywracamy „Format przechowywania właściwości obrazów” na „Zachowaj format obrazu źródłowego” i po raz ostatni uruchamiamy procedurę img_Click(). W oknie „Immediate” otrzymujemy wynik:
I w tym przypadku dla obu opcji, w formancie Rysunek (Image) bitmapa zapisana jest w taki sam sposób, ale sposób zapisu uległ zmianie. Na początku, znajduje się 40 bajtowy nagłówek BitmaInfoHeader, w którym pierwszy bajt ma wartość &H28, co w zapisie dziesiętnym wynosi 40 i odpowiada wielkości nagłówka BitmaInfoHeader. Przechowywanie obrazu jest zgodne z opcją „Konwertuj wszystkie dane obrazu na mapy bitowe”
Wniosek jest prosty, MS Access nie konwertuje już osadzonych plików na format zgodny z aktualnie ustawioną (zmienioną) właściwością „Format przechowywania właściwości obrazów”. Zmiana opcji obowiązuje przy osadzaniu nowych obrazów do formantów. Wystarczy wtedy ponownie osadzić ten sam plik w formancie Rysunek (Image), by MS Access dokonał odpowiednich zmian.
Opis funkcji bmpDibToDisc(...) As Boolean
Chcąc zapisać na dysk 24-bitową bitmapę osadzoną w formancie Image, możemy od razu przystąpić do zapisu. Możemy też na wszelki wypadek sprawdzić za pomocą funkcji bmpIsArrayDIB(...), czy rzeczywiście mamy do czynienia z 24-bitową nieskompresowaną bitmapą. Ponieważ pobranie właściwości „Format przechowywania właściwości obrazów” nie umożliwia jednoznacznego określenia sposobu przechowywania bitmapy, sprawdzimy, czy dwa pierwsze bajty tablicy to sygnatura 'BM'. Jeżeli tak, to tablica jest kompletną bitmapą, jeżeli dwa pierwsze bajty tablicy nie są sygnaturą 'BM' to przed zapisem musimy sami wypełnić elementy struktury BitmaFileHeader.
⊗ Public Function bmpDibToDisc(sDestFullPath As String, bBmpArray() As Byte) As Long
- Korzystając funkcji plikFileExist(...), sprawdza czy plik istniej na dysku. Jeżeli plik istnieje, to użytkownik jest proszony o zgodę na jego nadpisanie. Następnie za pomocą funkcji bmpIsArrayDIB(...) sprawdza, czy tablica bBmpArray() zawiera dane odpowiadające nieskompresowanej bitmapie o 24-bitowej głębi kolorów i kierunku czytania bajtów obrazu „z dołu do góry”. Po pozytywnej weryfikacji sprawdza, czy dwa pierwsze bajty tablicy bBmpArray() są równe &H4D42 (odpowiadają sygnaturze 'BM'). Obecność sygnatury 'BM' odpowiada opcji „Zachowaj format obrazu bitowego”, co oznacza że tablica bBmpArray zawiera wszystkie bajty bitmapy (nagłówek BitmapFileHeader nagłówek BitmapInfoHeader oraz bajty obrazu). Brak sygnatury 'BM' odpowiada opcji „Konwertuj wszystkie dane obrazu na mapy bitowe” co oznacza, że tablica nie zawiera 14 bajtowego nagłówka BitmapFileHeader, który musi zostać odtworzony.
- argumenty:
- sDestFullPath()
- pełna ścieżka dostępu wraz z nazwą pod jaką ma być zapisana bitmapa bitmapy
- bBmpArray()()
- tablica typu Byte (Image.PictureData) zawierająca bajty nieskompresowanej bitmapy
- zwraca:
-
Przy powodzeniu zwraca TRUE a przy niepowodzeniu zwraca FALSE.
- autor: Zbigniew Bratko
- data: 27.02.2019
Public Function bmpDibToDisc(bBmpArray() As Byte, sDestFullPath As String) As Boolean
Dim bfh As BITMAPFILEHEADER
Dim ff As Integer
Dim iAnswer As Integer
' jeżeli plik istnieje, zapytaj użytkownika czy go nadpisać
If plikFileExist(sDestFullPath) Then
iAnswer = MsgBox("Plik docelowy" & vbNewLine & _
sDestFullPath & vbNewLine & _
"istnieje." & vbNewLine & _
"Czy chcesz go zastąpić?", _
vbExclamation + vbYesNo + vbDefaultButton2)
If iAnswer = vbYes Then
' usuń plik
Kill (sDestFullPath)
Else
Exit Function
End If
End If
' sprawdź, czy tablica zawiera poprawne dane 24-bitowej
' nieskompresowanej bitmapy bitmapy o kierunku odczytu bajtów
' „z dołu do góry”. Nie uwzględniaj przy sprawdzaniu bitmapy
' właściwości „Format przechowywania właściwości obrazów”
If bmpIsArrayDIB(bBmpArray(), False) = False Then
MsgBox "Tablica nie zawiera poprawnych danych bitmapy!"
Exit Function
End If
ff = FreeFile
' otwórz plik w trybie Do zapisu
Open sDestFullPath For Binary Access Write As #ff
' sprawdź, czy tablica zaczyna się sygnaturą 'BM'
If Chr$(bBmpArray(0)) & Chr$(bBmpArray(1)) = cBmpSignatureBM Then
' tablica zawiera 14 bajtowy nagłówek BitmapFileFeader
' opcja: 'Zachowaj format obrazu źródłowego' MS Access 2007+
Put #ff, , bBmpArray()
Else
With bfh
' odtwórz nagłówek BitmapFileHeader
' sygnatura 'BM' pliku bitmapy
.bfType = &H4D42
' wielkość pliku bitmapy (DIB + 14)
.bfSize = CLng(UBound(bBmpArray) + cBmpBfhSize + 1)
' 4 bajty rezerwowe
.bfReserved1 = 0
.bfReserved2 = 0
' przesunięcie do bitów bitmapy (14+40=54 bajty)
.bfOffBits = cBmpBfhSize + cBmpBihSize
End With
'zapisz BitmapFileFeader
Put #ff, , bfh
' zpisz pozostałe bajty
Put #ff, , bBmpArray()
End If
' zamknij plik
Close #ff
bmpDibToDisc = True
End Function
Słów kilka o stałych, zmiennych, strukturach i funkcjach.
Niby tak proste zadanie jak sprawdzenie 24-bitowej bitmapy, rozrosło się do dość pokaźnych rozmiarów. Mam zamiar kontynuować temat przetwarzania 24-bitowej bitmap w MS Access, więc jest to jedyna okazja bym uporządkował nieco funkcje i procedury operujące na bitmapach. Na początek utworzyłem kilka modułów standardowych:
- bas_apiFun - deklaracje wszystkich funkcji API
- bas_apiStruct - deklaracje wszystkich struktur API
- bas_bmpFun - własne funkcje graficzne
- bas_Const - deklaracje stałych
- bas_Err - obsługa błędów
- bas_plikiFun - własne funkcje dotyczące przetwarzania plików
i mam nadzieję, że w miarę przybywania przykładów i rozrastanie się modułów, jakoś utrzymam logiczny porządek we wszystkich utworzonych i tworzonych modułach☺
Option Compare Database Option Explicit ' 14 bajtowy nagłówek pliku bitmapy. ' Zawiera informacje o rodzaju, rozmiarze i układzie pliku bitmapy (DIB). Public Type BITMAPFILEHEADER bfType As Integer 'sygnatura BM (0x4D42) hex. &H424D bfSize As Long 'całkowity rozmiar pliku w bajtach bfReserved1 As Integer 'zarezerwowany - zazwyczaj równy ZERO bfReserved2 As Integer 'zarezerwowany - zazwyczaj równy ZERO bfOffBits As Long 'przesunięcie (w bajtach) do bajtów obrazu bitmapy End Type ' 40 bajtowy nagłówek informacyjny bitmapy. ' Zawiera dane o właściwości bitmapy i organizacja jej kolorów. Public Type BITMAPINFOHEADER biSize As Long 'rozmiar struktury biWidth As Long 'szerokość mapy bitowej w pikselach biHeight As Long 'wysokość mapy bitowej w pikselach. Dla dodatniej wartość biHeight, 'bitmapa jest typu „z dołu do góry” i jej punkt początkowy 'znajduje się w lewym dolnym rogu. Dla ujemnych biHeight 'bitmapa jest typu „z góry na dół” i jej początek 'znajduje się w lewym górnym rogu. biPlanes As Integer 'liczba warstw koloru, zawsze = 1 biBitCount As Integer 'liczba bitów koloru na jeden piksel (1,4,8,16,24,32) biCompression As Long 'typ kompresji: BI_RGB = 0 (bez kompresji), BI_RLE8, BI_RLE4, 'BI_BITFIELDS, BI_JPEG, BI_PNG biSizeImage As Long 'wielkość mapy bitowej w bajtach, jeżeli bitmapa jest 'nieskompresowana (element biCompression równy jest BI_RGB) 'wartość biSizeImage może być ustawiona na ZERO biXPelsPerMeter As Long 'rozdzielczość pozioma pixel/metr - zazwyczaj ZERO, 'wartość 2835 odpowiada rozdzielczości 72 dpi, 'wartość 11811 odpowiada rozdzielczości 300 dpi biYPelsPerMeter As Long 'rozdzielczość pionowa pixel/metr - opis jw. biClrUsed As Long 'liczba użytych kolorów (liczba pozycji w tablicy kolorów), 'dla biClrUsed=0 używana jest maksymalna ilość kolorów 'określona przez wartości pola biBitCount biClrImportant As Long 'liczba kolorów znaczących, zazwyczaj ZERO tzn. że wszystkie 'kolory są potrzebne do wyświetlenia bitmapy 'biClrUsed - dla 1-bitowych DIB = 0 lub 2 'biClrUsed - dla 4-bitowych DIB = 0 lub 16, jeżeli 2-15 to wskazuje liczbę pozycji 'w tablicy kolorów 'biClrUsed - dla 8-bitowych DIB = 0 lub 256, jeżeli 2-255 to wskazuje liczbę pozycji 'w tablicy kolorów 'biClrUsed - dla 16, 24, 32 bitowych DIB zwykle wynosi ZERO End Type
Option Compare Database Option Explicit Public Const cAccVersion2007 As Long = 12 'numer wersji MS Access 2007 '+-----------------------------------------------+ '| Const - Bitmap | '+-----------------------------------------------+ Public Const cBmpIntSignature As Integer = &H4D42 'sygnatura bitmapy "BM" jako liczba Integer Public Const cBmpSignatureBM As String = "BM" 'sygnatura bitmapy "BM" jako ciąg znaków Public Const cBmpBfhSize As Long = 14 'wielkość nagłówka BitmaFileHeader Public Const cBmpBihSize As Long = 40 'wielkość nagłówka BitmapInfoHeader Public Const cBmpOffsetToBits As Long = 54 'przesunięcie do bajtów obrazu bitmapy Public Const cBmpBitCount24 As Long = 24 'głębia kolorów - bitów na piksel Public Const cBmpBitCount32 As Long = 32 'głębia kolorów - bitów na piksel Public Const cBmpNotCompressed As Long = 0 'nieskompresowana bitmapa BI_RGB = 0& Public Const cBmpMinSize As Long = 58 'minimalny rozmiar bitmapy 24bit (14+40+4) Public Const cBmpDIBMinSize As Long = 44 'minimalny rozmiar DIB bitmapy 24bit (40+4)
Option Compare Database Option Explicit '+---------------------------------------------+ '| Errors - własna obsługa niektórych błędów | '+---------------------------------------------+ 'inny, nieprzewidziany błąd Public Const errOthUnexpected As Long = vbObjectError + 1 '----------------------------------------------------------------- 'dolna granica zakresu numerów błędów dotyczących plików Private Const errFileError As Long = vbObjectError + 100 'nazwa pliku zawiera nieprawidłowe znaki Public Const errFileBadName As Long = errFileError + 1 'plik istnieje na dysku Public Const errFileExist As Long = errFileError + 3 'plik nie istnieje na dysku Public Const errFileNotExist As Long = errFileError + 4 '-------------------------------------------------------------------- 'dolna granica zakresu numerów błędów dotyczących argumentów funkcji Private Const errArgsError As Long = vbObjectError + 200 'argument musi być tablicą Public Const errArgIsNotArray As Long = errArgsError + 1 'tablica jest niezainicjowana Public Const errArrayNotInitialized As Long = errArgsError + 2 'nieprawidłowa wartość argumentu Public Const errArgFailValue As Long = errArgsError + 3 '-------------------------------------------------------------------- 'dolna granica zakresu numerów błędów dotyczących bitmap Private Const errBmpError As Long = vbObjectError + 300 'błąd formatu pliku (nieprawidłowa sygnatura pliku) Public Const errBmpFailSignature As Long = errBmpError + 1 'błąd formatu nagłówka BitmapInfoHeader Public Const errBihFailFormat As Long = errBmpError + 2 'błąd formatu nagłówka BitmapInfoHeader Public Const errBihFailSize As Long = errBmpError + 3 'brak nagłówka BitmapInfoHeader Public Const errBihNotExist As Long = errBmpError + 4 'nagłówek musi być tablicą jednowymiarową Public Const errBihOneDimension As Long = errBmpError + 5 'obsługiwana jest tylko 24 i 32-bitowa głębia kolorów Public Const errBmpBitCount As Long = errBmpError + 6 'obsługiwana jest tylko 24 głębia kolorów Public Const errBmpOnlyBitCount24 As Long = errBmpError + 7 'obsługiwana jest tylko 24 głębia kolorów Public Const errBmpIsCompressed As Long = errBmpError + 8 'obsługiwana jest tylko bitmapa z 'dołu do góry' Public Const errBmpIsTopDown As Long = errBmpError + 9 'Plik bitmapy jest zbyt mały (min. 58 bajtów) Public Const errBmpTooSmall As Long = errBmpError + 10 'PictureData: DIB jest zbyt mały (min. 44 bajty) Public Const errBmpDibTooSmall As Long = errBmpError + 11 '-------------------------------------------------------------------- 'dolna granica zakresu numerów błędów dotyczących Właściwości Private Const errPrpError As Long = vbObjectError + 1000 'nie można ustawić właściwości „Picture Property Storage Format” '(Format przechowywania właściwości obrazów) Public Const errPropertyStorage As Long = errPrpError + 1 'nieoczekiwany błąd ustawienia właściwości Format przechowywania 'właściwości obrazów (Picture Property Storage Format)" Public Const errPropertyStorageFail As Long = errPrpError + 2 ' zwraca opis błędu własnego o numerze lErrNo Public Function errBmpDescription(lErrNo As Long) As String Dim sErrDscr As String Select Case lErrNo '------------------------- errFileError = vbObjectError + 100 Case errFileBadName sErrDscr = "Pełna nazwa pliku zawiera nieprawidłowy znak" Case errFileExist sErrDscr = "Plik docelowy istnieje." Case errFileNotExist sErrDscr = "Plik nie istnieje na dysku." '------------------------- errArgsError = vbObjectError + 200 Case errArgIsNotArray sErrDscr = "Argumentem funkcji musi być tablicą." Case errArrayNotInitialized sErrDscr = "Tablica nie jest zainicjowana." Case errArgFailValue sErrDscr = "Nieprawidłowa wartość argumentu." '------------------------- errBmpError = vbObjectError + 300 Case errBmpFailSignature sErrDscr = "Niewłaściwa sygnatura pliku bitmapy." Case errBihFailFormat sErrDscr = "Błąd formatu nagłówka BitmapInfoHeader" Case errBihFailSize sErrDscr = "Nagłówek BitmapInfoHeader musi mieć wielkość 40 bajtów""" Case errBihNotExist sErrDscr = "Niezainicjowany nagłówek BitmapInfoHeader bitmapy." Case errBihOneDimension sErrDscr = "Nagłówek BitmapInfoHeader " & _ "musi być tablicą jednowymiarową." Case errBmpBitCount sErrDscr = "Obsługiwana jest tylko bitmapa" & vbNewLine & _ "o 24 lub 32-bitowej głębi kolorów." Case errBmpOnlyBitCount24 sErrDscr = "Obsługiwana jest tylko bitmapa" & vbNewLine & _ "o 24-bitowej głębi kolorów." Case errBmpIsCompressed sErrDscr = "Bitmapa skompresowana nie jest obsługiwana." Case errBmpIsTopDown sErrDscr = "obsługiwana jest tylko bitmapa z 'dołu do góry'." Case errBmpTooSmall sErrDscr = "Plik bitmapy jest zbyt mały." & vbNewLine & _ "Minimalna wielkość to " & cBmpMinSize & " bajtów." Case errBmpDibTooSmall sErrDscr = "Tablica Image.PictureData" & vbNewLine & _ "musi zawierać minimum " & cBmpDIBMinSize & " bajtów." Case Else sErrDscr = "Nieprzewidziany błąd Aplikacji." & vbNewLine & _ "Zanotuj nr błędu i opis" & vbNewLine & _ "i skontaktuj się z Administratorem." End Select errBmpDescription = sErrDscr End Function
' Public Function plikFileExist(sFullPath As String) As Boolean
' Funkcja plikFileExist (...) sprawdza, czy w lokalizacji na którą wskazuje argument sFullPath,
' będący pełna ścieżką do pliku, znajduje się wskazany plik. Funkcja pobiera położenie pierwszego
' wystąpienie znaku ':' oraz położenie ostatniego wystąpienia znaku '\' w pełnej ścieżce
' do pliku sFullPath. Jeżeli znaki te ':' i '\' nie występują, lub gdy znak '\' znajduje się
' na końcu ścieżki funkcja kończy działanie.
' Jeżeli wszystko jest w porządku, funkcja sprawdza, począwszy od znaku po pierwszym
' wystąpieniu znaku ':', czy którykolwiek ze znaków cBadChars = ":/*?<"">|" występuje
' w pełnej ścieżce do pliku.
' Jeżeli którykolwiek nieprawidłowy znak zostaje znaleziony, funkcja generuje błąd wykonania
' informując, że w ścieżce do pliku został znaleziony nieprawidłowy znak. Następnie z pełnej
' ścieżki do pliku pobrana zostaje nazwa pliku wraz z rozszerzeniem która zostaje porównana
' z nazwą pliku jaka została zwrócona przez funkcję Dir.
' argumenty:
' sFullPath
' pełna ścieżka do pliku
'zwraca:
' Przy powodzeniu, jeżeli plik znajduje się na dysku, zwraca TRUE. Przy niepowodzeniu,
' gdy plik nie został znaleziony, lub pełna ścieżka do pliku zawiera nieprawidłowy znak,
'funkcja zwraca FALSE.
'autor: Zbigniew Bratko
'data: 04.02.2019
'
Public Function plikFileExist(sFullPath As String) As Boolean
Dim lInStr As Long
Dim lInStrRev As Long
Dim sFileName As String
Dim sBadChars() As Byte
Dim i As Integer
Const cBadChars As String = ":/*?<"">|"
Const cProcName As String = "Funkcja fileNameFileFromPath(...)"
Const cAttribFile As Long = vbNormal Or vbReadOnly Or vbHidden Or vbArchive
' pobierz położenie pierwszego wystąpienia znaku ":"
lInStr = InStr(1, sFullPath, ":", vbBinaryCompare)
' pobierz położenie ostatniego wystąpienia znaku "\"
lInStrRev = InStrRev(sFullPath, "\", -1, vbBinaryCompare)
' jeżeli nie ma znaku ";" lub "\", lub znak "\" jest na końcu ścieżki to wyjdź
If lInStr = 0 Or lInStrRev = 0 Or lInStrRev = Len(sFullPath) Then Exit Function
'przygotuj tablicę z kodami ASCII nieprawidłowych znaków
sBadChars() = StrConv(cBadChars, vbFromUnicode)
lInStr = lInStr + 1
' sprawdzaj w pętli, od znaku po pierwszym wystąpieniu ':',
' czy ścieżka pliku zawiera nieprawidłowy znak
For i = LBound(sBadChars) To UBound(sBadChars)
If InStr(lInStr, sFullPath, Chr$(sBadChars(i)), vbBinaryCompare) Then
Err.Raise errFileBadName, cProcName, _
"Pełna nazwa pliku zawiera nieprawidłowy znak [ " & Chr$(sBadChars(i)) & " ]."
End If
Next
'wyodrębnij nazwę pliku z rozszerzeniem ze ścieżki
sFileName = Mid$(sFullPath, lInStrRev + 1)
' porównaj, czy funkcja Dir zwróciła taką samą nazwę pliku sFileName
If StrComp(Dir(sFullPath, cAttribFile), sFileName, vbTextCompare) = 0 Then
plikFileExist = True
End If
End Function