i hv problem with read unicode filenames and get data and save it unicode names
hi.
i hv this code and i can read unicode names files but my problem is about get content data and then save unicode names with same content data.
Code:
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameW" (ByRef pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Dim sString As String
Dim tmpsave As String
Private opFile As OPENFILENAME
Private FSO As FileSystemObject
Private Function ShowOpenUnicode() As String
With opFile
.flags = &H2 Or &H4
.hInstance = App.hInstance
.hWndOwner = Me.hWnd
.lpstrFilter = StrConv(("all Files" & Chr(0) & "*.*" & Chr(0) & Chr(0)), vbUnicode)
.lpstrTitle = StrConv("Open File", vbUnicode)
.lpstrFile = StrConv(String(256, Chr(0)), vbUnicode)
.nMaxFile = 512
.lStructSize = Len(opFile)
End With
Call GetOpenFileName(opFile)
ShowOpenUnicode = opFile.lpstrFile
End Function
Private Function ShowSaveUnicode() As String
With opFile
.flags = &H2 Or &H4
.hInstance = App.hInstance
.hWndOwner = Me.hWnd
.lpstrFilter = StrConv(("all files" & Chr(0) & "*.*" & Chr(0) & Chr(0)), vbUnicode)
.lpstrTitle = StrConv("Save File", vbUnicode)
.nMaxFile = 512
.lpstrFile = sString & String(512 - Len(sString), Chr(0))
.lStructSize = Len(opFile)
End With
Call GetSaveFileName(opFile)
ShowSaveUnicode = opFile.lpstrFile
End Function
Private Function ConvertFileName(sToConvert) As String
Dim bFileName() As Byte
Dim lRet As Long
Dim sBuf As String
'Get rid of the trailing Null characters
sToConvert = Left$(sToConvert, InStr(sToConvert, (Chr(0) & Chr(0))) - 1)
If Len(sToConvert) Mod 2 <> 0 Then
sToConvert = sToConvert & Chr(0) 'If the file has an ANSI extension or just an ANSI last character of
'a file with no extension, add one on the end
'If we don't add it, the string will end one character too short
End If
bFileName = StrConv(sToConvert, vbFromUnicode) 'Put the string into a byte array
sBuf = ""
For lRet = 0 To Len(sToConvert) - 1 Step 2
'At this point, the unicode characters will show up in sBuf as ?, but, when we actually go
'to use this in the FSO function, it will find the right file
sBuf = sBuf & StrConv(Chr(bFileName(lRet)) & Chr(bFileName(lRet + 1)), vbFromUnicode)
Next
'And return the string for use
ConvertFileName = sBuf
End Function
Private Sub UnicodeSaveMethod()
Dim sFileName As String
'Show the save dialog and get the file path as Unicode in a VB String
sFileName = ShowSaveUnicode
If Left$(sFileName, 1) = Chr(0) Then Exit Sub 'Exit on Cancel
'Convert the file name to be used
sFileName = ConvertFileName(sFileName)
'Here is where you'd create the file, input the text, and save it
'For this example, I just try to create the file
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject
' Dim f As TextStream
' Set f = FSO.CreateTextFile(sFileName, False)
' f.Close
End Sub
Private Sub UnicodeOpenMethod()
Dim sFileName As String
'Show the open dialog and get the file path as Unicode in a VB String
sFileName = ShowOpenUnicode
If Left$(sFileName, 1) = Chr(0) Then Exit Sub 'Exit on Cancel
'Convert the file name to be used
sFileName = ConvertFileName(sFileName)
'This line will print everything in the file to show you it works
'Otherwise, you'd have normal open/read/etc code here
Debug.Print FSO.OpenTextFile(sFileName, ForReading, False, TristateUseDefault).ReadAll
End Sub
Private Sub Form_Load()
Set FSO = New FileSystemObject
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set FSO = Nothing
End Sub
Private Sub Command1_Click()
UnicodeOpenMethod
End Sub
Private Sub Command2_Click()
UnicodeSaveMethod
End Sub
for exmaple orginal data of (نمونه تصویر.png) is :
and then i want save it to like as "تصویر نمونه ذخیره شده.png" ( my means is unicode names) with same data content.but UnicodeSaveMethod is just creat text file.
Re: i hv problem with read unicode filenames and get data and save it unicode names
can u send a sample to i can read content data of unicode files names and then can save content data to another file with unicode file name?
i did try for fso or CreateFileW but my first poblem is about read content data and then second problem is about save same content data as another unicode file name
i sent my source code hv problem.
in mt attachment i attached a file png example with unicode for open in program.
tmpsave is a string variable to keep content data,so i want read file and save file(unicode file name support).
Command1 is about read file
Command2 is about save file opened (by command1 click and saved content data in tmpsave)
any body can fix error and problem.
error :
f.Write tmpsave
Last edited by Black_Storm; Mar 21st, 2018 at 10:43 AM.
Re: i hv problem with read unicode filenames and get data and save it unicode names
Originally Posted by Black_Storm
can u send a sample to i can read content data of unicode files names and then can save content data to another file with unicode file name?
i did try for fso or CreateFileW but my first poblem is about read content data and then second problem is about save same content data as another unicode file name
i sent my source code hv problem.
in mt attachment i attached a file png example with unicode for open in program.
tmpsave is a string variable to keep content data,so i want read file and save file(unicode file name support).
Command1 is about read file
Command2 is about save file opened (by command1 click and saved content data in tmpsave)
any body can fix error and problem.
error :
f.Write tmpsave
Re: i hv problem with read unicode filenames and get data and save it unicode names
The FSO isn't exactly garbage, but it has so many warts that it almost may as well be. Most of the time you should seek out alternatives. It was only designed to handle text stream files, and was really designed for scripting. It is too bad we didn't get a more practical alternative built into VB6, but .Net came along and killed that for us and we never got a legitimate VB7.
So instead you need to use API calls. Appropriate wrappers for these can be found in the CodeBank, but I presume you are fighting both your programming skills and a language barrier, and that can make searching difficult.
Here's an example based on a couple of things from the CodeBank:
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxW" ( _
ByVal hWnd As Long, _
ByVal lpText As Long, _
ByVal lpCaption As Long, _
ByVal uType As VbMsgBoxStyle) As VbMsgBoxResult
Private Sub Main()
Dim HBF As HugeBinaryFile
Dim FileSize As Currency
Dim FileBytes() As Byte
With New CommonDlgsW
.DialogTitle = "Open a file"
.Flags = cdlOFNFileMustExist _
Or cdlOFNPathMustExist _
Or cdlOFNExplorer _
Or cdlOFNHideReadOnly _
Or cdlOFNLongNames _
Or cdlOFNShareAware
.Filter = "All files (*.*)|*.*"
If .ShowOpen(WIN32_NULL) Then
Set HBF = New HugeBinaryFile
On Error Resume Next
HBF.OpenFile .FileName, FILE_SHARE_ALL
If Err Then
On Error GoTo 0
MessageBox WIN32_NULL, _
StrPtr("Failed to open file:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Open failed"), _
vbExclamation
Else
On Error GoTo 0
FileSize = HBF.LOF
ReDim FileBytes(FileSize - 1)
If HBF.ReadBytes(FileBytes) <> FileSize Then
HBF.CloseFile
MessageBox WIN32_NULL, _
StrPtr("Failed to read full file:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Failed to read file"), _
vbExclamation
Else
HBF.CloseFile
.DialogTitle = "File to write to"
.Flags = cdlOFNPathMustExist _
Or cdlOFNExplorer _
Or cdlOFNHideReadOnly _
Or cdlOFNLongNames _
Or cdlOFNShareAware
If .ShowSave(WIN32_NULL) Then
On Error Resume Next
HBF.OpenFile .FileName, FILE_SHARE_EXCLUSIVE
If Err Then
On Error GoTo 0
MessageBox WIN32_NULL, _
StrPtr("Failed to create new file:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Failed to create file"), _
vbExclamation
Else
On Error GoTo 0
If HBF.WriteBytes(FileBytes) <> FileSize Then
HBF.CloseFile
MessageBox WIN32_NULL, _
StrPtr("Failed to write full file:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Failed to write file"), _
vbExclamation
Else
HBF.CloseFile
MessageBox WIN32_NULL, _
StrPtr("Success. New file written:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Success"), _
vbInformation
End If
End If
Else
MessageBox WIN32_NULL, _
StrPtr("Canceled save"), _
StrPtr("Canceled"), _
vbInformation
End If
End If
End If
Else
MessageBox WIN32_NULL, _
StrPtr("Canceled open"), _
StrPtr("Canceled"), _
vbInformation
End If
End With
End Sub
Most of the code above is calling the Unicode MessageBox function. Here is a stripped down version that might be clearer to read:
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Sub Main()
Dim HBF As HugeBinaryFile
Dim FileSize As Currency
Dim FileBytes() As Byte
With New CommonDlgsW
.DialogTitle = "Open a file"
.Flags = cdlOFNFileMustExist _
Or cdlOFNPathMustExist _
Or cdlOFNExplorer _
Or cdlOFNHideReadOnly _
Or cdlOFNLongNames _
Or cdlOFNShareAware
.Filter = "All files (*.*)|*.*"
If .ShowOpen(WIN32_NULL) Then
Set HBF = New HugeBinaryFile
On Error Resume Next
HBF.OpenFile .FileName, FILE_SHARE_ALL
If Err Then
On Error GoTo 0
MsgBox "Failed"
Else
On Error GoTo 0
FileSize = HBF.LOF
ReDim FileBytes(FileSize - 1)
HBF.ReadBytes FileBytes
HBF.CloseFile
.DialogTitle = "File to write to"
.Flags = cdlOFNPathMustExist _
Or cdlOFNExplorer _
Or cdlOFNHideReadOnly _
Or cdlOFNLongNames _
Or cdlOFNShareAware
If .ShowSave(WIN32_NULL) Then
On Error Resume Next
HBF.OpenFile .FileName, FILE_SHARE_EXCLUSIVE
If Err Then
On Error GoTo 0
MsgBox "Failed"
Else
On Error GoTo 0
HBF.WriteBytes FileBytes
HBF.CloseFile
MsgBox "Success!"
End If
Else
MsgBox "Canceled"
End If
End If
Else
MsgBox "Canceled"
End If
End With
End Sub
But you really need to hire a programmer if this stuff is important to you. Otherwise you might consider moving to VB.Net where a great deal of it is already done for you. It is very late to be trying to learn VB6 today.
Re: i hv problem with read unicode filenames and get data and save it unicode names
Originally Posted by dilettante
The FSO isn't exactly garbage, but it has so many warts that it almost may as well be. Most of the time you should seek out alternatives. It was only designed to handle text stream files, and was really designed for scripting. It is too bad we didn't get a more practical alternative built into VB6, but .Net came along and killed that for us and we never got a legitimate VB7.
So instead you need to use API calls. Appropriate wrappers for these can be found in the CodeBank, but I presume you are fighting both your programming skills and a language barrier, and that can make searching difficult.
Here's an example based on a couple of things from the CodeBank:
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxW" ( _
ByVal hWnd As Long, _
ByVal lpText As Long, _
ByVal lpCaption As Long, _
ByVal uType As VbMsgBoxStyle) As VbMsgBoxResult
Private Sub Main()
Dim HBF As HugeBinaryFile
Dim FileSize As Currency
Dim FileBytes() As Byte
With New CommonDlgsW
.DialogTitle = "Open a file"
.Flags = cdlOFNFileMustExist _
Or cdlOFNPathMustExist _
Or cdlOFNExplorer _
Or cdlOFNHideReadOnly _
Or cdlOFNLongNames _
Or cdlOFNShareAware
.Filter = "All files (*.*)|*.*"
If .ShowOpen(WIN32_NULL) Then
Set HBF = New HugeBinaryFile
On Error Resume Next
HBF.OpenFile .FileName, FILE_SHARE_ALL
If Err Then
On Error GoTo 0
MessageBox WIN32_NULL, _
StrPtr("Failed to open file:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Open failed"), _
vbExclamation
Else
On Error GoTo 0
FileSize = HBF.LOF
ReDim FileBytes(FileSize - 1)
If HBF.ReadBytes(FileBytes) <> FileSize Then
HBF.CloseFile
MessageBox WIN32_NULL, _
StrPtr("Failed to read full file:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Failed to read file"), _
vbExclamation
Else
HBF.CloseFile
.DialogTitle = "File to write to"
.Flags = cdlOFNPathMustExist _
Or cdlOFNExplorer _
Or cdlOFNHideReadOnly _
Or cdlOFNLongNames _
Or cdlOFNShareAware
If .ShowSave(WIN32_NULL) Then
On Error Resume Next
HBF.OpenFile .FileName, FILE_SHARE_EXCLUSIVE
If Err Then
On Error GoTo 0
MessageBox WIN32_NULL, _
StrPtr("Failed to create new file:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Failed to create file"), _
vbExclamation
Else
On Error GoTo 0
If HBF.WriteBytes(FileBytes) <> FileSize Then
HBF.CloseFile
MessageBox WIN32_NULL, _
StrPtr("Failed to write full file:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Failed to write file"), _
vbExclamation
Else
HBF.CloseFile
MessageBox WIN32_NULL, _
StrPtr("Success. New file written:" _
& vbNewLine & vbNewLine _
& .FileName), _
StrPtr("Success"), _
vbInformation
End If
End If
Else
MessageBox WIN32_NULL, _
StrPtr("Canceled save"), _
StrPtr("Canceled"), _
vbInformation
End If
End If
End If
Else
MessageBox WIN32_NULL, _
StrPtr("Canceled open"), _
StrPtr("Canceled"), _
vbInformation
End If
End With
End Sub
Most of the code above is calling the Unicode MessageBox function. Here is a stripped down version that might be clearer to read:
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Sub Main()
Dim HBF As HugeBinaryFile
Dim FileSize As Currency
Dim FileBytes() As Byte
With New CommonDlgsW
.DialogTitle = "Open a file"
.Flags = cdlOFNFileMustExist _
Or cdlOFNPathMustExist _
Or cdlOFNExplorer _
Or cdlOFNHideReadOnly _
Or cdlOFNLongNames _
Or cdlOFNShareAware
.Filter = "All files (*.*)|*.*"
If .ShowOpen(WIN32_NULL) Then
Set HBF = New HugeBinaryFile
On Error Resume Next
HBF.OpenFile .FileName, FILE_SHARE_ALL
If Err Then
On Error GoTo 0
MsgBox "Failed"
Else
On Error GoTo 0
FileSize = HBF.LOF
ReDim FileBytes(FileSize - 1)
HBF.ReadBytes FileBytes
HBF.CloseFile
.DialogTitle = "File to write to"
.Flags = cdlOFNPathMustExist _
Or cdlOFNExplorer _
Or cdlOFNHideReadOnly _
Or cdlOFNLongNames _
Or cdlOFNShareAware
If .ShowSave(WIN32_NULL) Then
On Error Resume Next
HBF.OpenFile .FileName, FILE_SHARE_EXCLUSIVE
If Err Then
On Error GoTo 0
MsgBox "Failed"
Else
On Error GoTo 0
HBF.WriteBytes FileBytes
HBF.CloseFile
MsgBox "Success!"
End If
Else
MsgBox "Canceled"
End If
End If
Else
MsgBox "Canceled"
End If
End With
End Sub
But you really need to hire a programmer if this stuff is important to you. Otherwise you might consider moving to VB.Net where a great deal of it is already done for you. It is very late to be trying to learn VB6 today.
Re: i hv problem with read unicode filenames and get data and save it unicode names
Your attachment in #6 has an odd problem that doesn't look like anything you did in VB. It created the file, with a unicode filename (though it wasn't pre-filled in), but then the file it saved was corrupted--- byte 0x8 through byte 0x103 were replaced with 0x00, but byte 0x00-0x07 and 0x104-0x1F7 (the rest) were the same as the original. Gotta agree with dilettante here, avoid FSO.
Reply With Quote
Originally Posted by Black_Storm
