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 :

‰PNG


IHDR a E صYش
sRGB ®خé gAMA ±ڈüa pHYs أ أ
اo¨d
چIDATx^يط±چآ0@ل”””)ƒپR²
%c0%#¤dŒ””œuù…’ثء»‚أژx¯KىHè“LىT7£4â4â4 â4â4â4â4â4â4â4â4â4â4â4â4â4â4â4â4â4âٍu]·كïW«U5.ف9ڈ1)kyŒN§سeعb±ˆ²–ا¨®ë`*âپ¬هù
0n¸¸âض'¥Eمî‹+®?ظèp8„ء¸¦ iْ q‎ةFXiô¤زèQi»BMKûةفn<Uµفnc k¥ےr¹*ھعl6×ë5ئ²V„رهrY¯×aَ]9@©جF‎am¸]*çکv/›Q¯3\\I*ي›b¸¤2MuRi*¥3
ë*F؟길~ô؟Fmغ¦wù£د هëô½قè/ك†و¢س÷z£ç@َزé{½رًL_×u:تںدç›go‎د*iqqqqqqqqqqqqqqqqqqqqqqqqqqQ ·غ‎èO¹1ل¼ IEND®B`‚


but with my code in debug window data is :
‰PNG

? ? ? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ? ? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ? ? ???? ???? ???? ???? ???? ???? ???? ???? ??¦iú qýÉFXiô¤ÒèQi»BMKûÉÝn<UµÝnc k¥ÿr¹žªÚl6×ë5ƲV„ÑårY¯×aó]9@©ÌFýam¸]*ç˜v/›Q¯3\\I*í›b¸¤2MuRi*¥3
ë*F¿ê¸¸~ô¿FmÛ¦wù£Ï åëô½Þè/߆æ¢Ó÷z£ç@óÒé{½ÑðL_×u:ÊŸÏç›goýÏžiqqqqqqqqqqqqqqqqqqqq qqqqqqQ·ÛýèO¹1á¼ IEND®B`‚

how can fix this problem?

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.

Why do you use OpenTextFile on a PNG file??

its just sample and i found it in another forum,but how can fix that?

If you read further about the FSO you will see that it can only be used for non binary files.

Try the ADODB.Stream object??

Well first of all, the debug window can't display Unicode no matter what.

If you're opening a Unicode filename, look for examples for the CreateFileW API.

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

Quote:

---

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

---

http://www.vbforums.com/search.php?searchid=13749649

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.

Quote:

---

Originally Posted by xxdoc123

http://www.vbforums.com/search.php?searchid=13749649

---

your link is not valid.

Quote:

---

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.

---

can u fix my problem in attachment in #6?

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.

Quote:

---

Originally Posted by Black_Storm

your link is not valid.

---

http://www.vbforums.com/showthread.p...highlight=dirw