Rubrik: Dateisystem · Dateien lesen/schreiben | VB-Versionen: VB6 | 23.01.06 |
Dateien mit Unicode-Namen öffnen Mit diesen Funktionen ist es möglich, Dateien, deren Namen Unicode Zeichen enthalten, zu öffnen. | ||
Autor: Simon Rettberg | Bewertung: | Views: 15.045 |
ohne Homepage | System: WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | kein Beispielprojekt |
Mit ein paar kleinen Änderungen kann man die Funktionen aus dem Tipp Öffnen/Speichern-Dialog ohne ActiveX Unicode-fähig machen. Hierzu verwendet man lediglich die Widechar Versionen der API Funktionen und passt die OPENFILENAME Struktur ein wenig an.
Kopieren Sie folgenden Code in ein Modul:
Option Explicit ' Für Unicode müssen die Strings als Pointer übergeben werden, ' daher Long statt String Private Type OPENFILENAME_WCHAR lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As Long lpstrCustomFilter As Long nMaxCustFilter As Long nFilterIndex As Long lpstrFile As Long nMaxFile As Long lpstrFileTitle As Long nMaxFileTitle As Long lpstrInitialDir As Long lpstrTitle As Long flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As Long lCustData As Long lpfnHook As Long lpTemplateName As Long End Type Private Const OFN_READONLY = &H1 Private Const OFN_OVERWRITEPROMPT = &H2 Private Const OFN_HIDEREADONLY = &H4 Private Const OFN_NOCHANGEDIR = &H8 Private Const OFN_SHOWHELP = &H10 Private Const OFN_ENABLEHOOK = &H20 Private Const OFN_ENABLETEMPLATE = &H40 Private Const OFN_ENABLETEMPLATEHANDLE = &H80 Private Const OFN_NOVALIDATE = &H100 Private Const OFN_ALLOWMULTISELECT = &H200 Private Const OFN_EXTENSIONDIFFERENT = &H400 Private Const OFN_PATHMUSTEXIST = &H800 Private Const OFN_FILEMUSTEXIST = &H1000 Private Const OFN_CREATEPROMPT = &H2000 Private Const OFN_SHAREAWARE = &H4000 Private Const OFN_NOREADONLYRETURN = &H8000 Private Const OFN_NOTESTFILECREATE = &H10000 Private Const OFN_NONETWORKBUTTON = &H20000 Private Const OFN_NOLONGNAMES = &H40000 Private Const OFN_EXPLORER = &H80000 Private Const OFN_NODEREFERENCELINKS = &H100000 Private Const OFN_LONGNAMES = &H200000 Private Const OFN_SHAREFALLTHROUGH = 2 Private Const OFN_SHARENOWARN = 1 Private Const OFN_SHAREWARN = 0 Private Declare Function GetSaveFileName Lib "comdlg32.dll" _ Alias "GetSaveFileNameW" ( _ pOpenfilename As OPENFILENAME_WCHAR) As Long Private Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameW" ( _ pOpenfilename As OPENFILENAME_WCHAR) As Long
' Öffnen-Dialog Public Function ShowOpenDlg(F As Form, strFilter As String, _ strTitel As String, strInitDir As String) As String Dim lngOpenFileName As OPENFILENAME_WCHAR Dim lngAnt As Long Dim strFile As String With lngOpenFileName .lStructSize = Len(lngOpenFileName) .hwndOwner = F.hWnd .hInstance = App.hInstance strFilter = Replace$(strFilter, "|", vbNullChar) ' Der Filter muss durch 2 NullChars terminiert werden Do Until Right$(strFilter, 2) = vbNullChar & vbNullChar strFilter = strFilter & vbNullChar Loop strFile = String$(512, 0) ' Sollte bei Multiselect vergrößert werden. .lpstrFilter = StrPtr(strFilter) .lpstrFile = StrPtr(strFile) .nMaxFile = Len(strFile) .lpstrInitialDir = StrPtr(strInitDir) .lpstrTitle = StrPtr(strTitel) .flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST ' Or OFN_ALLOWMULTISELECT Or OFN_EXPLORER lngAnt = GetOpenFileName(lngOpenFileName) If lngAnt Then strFile = TrimNull(strFile) ShowOpenDlg = strFile Else ShowOpenDlg = "" End If End With End Function
' Speichern-Dialog Public Function ShowSaveDlg(F As Form, strFilter As String, _ strTitel As String, strInitDir As String) As String Dim lngOpenFileName As OPENFILENAME_WCHAR Dim lngAnt As Long Dim strFile As String With lngOpenFileName .lStructSize = Len(lngOpenFileName) .hwndOwner = F.hWnd .hInstance = App.hInstance strFilter = Replace$(strFilter, "|", vbNullChar) Do Until Right$(strFilter, 2) = vbNullChar & vbNullChar strFilter = strFilter & vbNullChar Loop strFile = String$(512, 0) .lpstrFilter = StrPtr(strFilter) .lpstrFile = StrPtr(strFile) .nMaxFile = Len(strFile) .lpstrInitialDir = StrPtr(strInitDir) .lpstrTitle = StrPtr(strTitel) .flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or _ OFN_CREATEPROMPT lngAnt = GetSaveFileName(lngOpenFileName) If lngAnt Then strFile = TrimNull(strFile) ShowSaveDlg = strFile Else ShowSaveDlg = "" End If End With End Function
' Trim Funktion für vbNullChars Public Function TrimNull(ByVal Text As String) As String Dim lngStart As Long Dim lngEnd As Long lngEnd = Len(Text) For lngStart = 1 To lngEnd If Asc(Mid$(Text, lngStart, 1)) <> 0 Then For lngEnd = lngEnd To lngStart Step -1 If Asc(Mid$(Text, lngEnd, 1)) <> 0 Then TrimNull = Mid$(Text, lngStart, lngEnd - lngStart + 1) Exit Function End If Next lngEnd End If Next lngStart End Function
Ein Aufruf von
strFile = ShowOpenDlg(Me, "Musik|*.mp3|Videos|*.avi;*.mpg", "Datei öffnen", "C:\")
liefert nun korrekte Ergebnisse bei Unicode Dateinamen.
Versucht man jetzt allerdings eine Datei mit Unicode Zeichen im Namen mit VB Bordmitteln zu öffnen, schlägt dies leider fehl, da VB offensichtlich mit solchen Dateinamen nicht umgehen kann. Doch hier kann man Abhilfe schaffen, indem man die Unicode Variante der GetShortPathName API verwendet, um den Dateinamen ins alte 8.3 Format umzuwandeln. Dann enthält dieser keine Unicode-Zeichen mehr und die Datei kann mit der Open Anweisung geöffnet werden.ü>
Ergänzen Sie das Modul mit folgender Deklaration und Funktion:
Private Declare Function GetShortPathName Lib "kernel32" _ Alias "GetShortPathNameW" ( _ ByVal lpszLongPath As Long, _ ByVal lpszShortPath As Long, _ ByVal cchBuffer As Long) As Long
Public Function GetShortName(ByVal strLongName As String) As String Dim ShortName As String Dim sLen As Long ShortName = Space$(256) sLen = GetShortPathName(StrPtr(strLongName), _ StrPtr(ShortName), Len(ShortName)) ShortName = Left$(ShortName, sLen) GetShortName = ShortName End Function
Eine Datei mit Unicode Namen kann man dann wie folgt öffnen:
Open GetShortName(strFile) For (….) as #FN
Hinweis:
Der obige Code enthält der Vollständigkeit halber noch eine ShowSaveDlg Funktion, allerdings ist es mit den Standard VB Funktionen nicht möglich, eine Datei mit Unicode Namen zu erstellen. Hierzu müssen Sie z.B. auf das Stream Object (ab MSADO 2.5) zurückgreifen.