PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197

PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197

PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
[RESOLVED] Unicode filename-VBForums
Results 1 to 11 of 11

Thread: [RESOLVED] Unicode filename

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Jun 2011
    Posts
    461

    Resolved [RESOLVED] Unicode filename

    I have searched the Internet for solution but I haven't found any.

    Like I said in title, I want to give unicode filename to some file, nevertheless if I do that directly (for example with command "Open [file] For Output ..."), or renaming it later (i.e. command "Name [file] As [newfile]"), because it does not work in both cases.

    Here is example code where I want to extract YouTube title (which in this case is in Russian) and use that as filename (put this code in module and run):
    VB Code:
    1. Private Const INTERNET_OPEN_TYPE_DIRECT = 1
    2. Private Const INTERNET_OPEN_TYPE_PROXY = 3
    3. Private Const IF_FROM_CACHE = &H1000000
    4. Private Const IF_MAKE_PERSISTENT = &H2000000
    5. Private Const IF_NO_CACHE_WRITE = &H4000000
    6. Private Const BUFFER_LEN = 256
    7. Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
    8. Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
    9. Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
    10. Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
    11.  
    12. Public Function Inet(sURL As String, scUserAgent As String, Optional sProxy As String, Optional sHeaders As String) As String
    13. Dim hOpen As Long, hFile As Long, sBuffer As String * BUFFER_LEN, iResult As Integer, sData As String, lReturn As Long
    14. On Error GoTo Error
    15. If Not InStr(1, sProxy, ":") > 0 And Not InStr(1, sProxy, ".") > 0 Then hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) Else: hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, sProxy, vbNullString, 0)
    16. If sHeaders = "" Then hFile = InternetOpenUrl(hOpen, sURL, vbNullString, ByVal 0&, IF_NO_CACHE_WRITE, ByVal 0&) Else: hFile = InternetOpenUrl(hOpen, sURL, sHeaders, CLng(Len(sHeaders)), IF_NO_CACHE_WRITE, ByVal 0&)
    17. If hFile Then
    18. iResult = InternetReadFile(hFile, sBuffer, BUFFER_LEN, lReturn)
    19. sData = sBuffer
    20. Do While lReturn <> 0
    21. iResult = InternetReadFile(hFile, sBuffer, BUFFER_LEN, lReturn)
    22. sData = sData + Mid(sBuffer, 1, lReturn)
    23. Loop
    24. End If
    25. InternetCloseHandle hFile
    26. InternetCloseHandle hOpen
    27. Inet = sData
    28. Error: Exit Function
    29. End Function
    30.  
    31. Sub Main()
    32. Dim strUserAgent As String, strName As String
    33. strUserAgent = "Mozilla/5.0 (Windows NT 5.1; rv:35.0) Gecko/20100101 Firefox/35.0"
    34. strName = Split(Split(Inet("https://www.youtube.com/watch?v=gi7gs4EGnCI", strUserAgent), "<title>")(1), " - YouTube")(0)
    35. Open strName & ".txt" For Output As #1
    36. Print #1, strName
    37. Close #1
    38. End Sub
    Result is:

    which is not valid.
    But, in that file is also written YouTube title, and it is in it's original state:


    Does somebody know solution for this problem? Thanks in advance!
    Last edited by MikiSoft; Jan 27th, 2015 at 05:20 PM.

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,003

    Re: Unicode filename

    To use unicode on O/S that support it where VB native file functions do not support it,

    a) use APIs. Simply search this forum for these three keywords: Unicode CreateFile API
    b) use FSO. Search forum for : FSO Unicode FileName
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Jun 2011
    Posts
    461

    Re: Unicode filename

    Quote Originally Posted by LaVolpe View Post
    To use unicode on O/S that support it where VB native file functions do not support it,

    a) use APIs. Simply search this forum for these three keywords: Unicode CreateFile API
    b) use FSO. Search forum for : FSO Unicode FileName
    I have found some MoveFile API and result was same. I'll try to look for FSO now.
    Also, I want to ask how to combine that with AsyncDownload? Because native VB functions doesn't support Unicode, do I have to save file first with some ANSI filename and then rename it to desired Unicode one?
    Last edited by MikiSoft; Jan 27th, 2015 at 02:28 PM.

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,003

    Re: Unicode filename

    You should have the option to download to an array instead of a file. Create the file using API or FSO, and also use API/FSO to write the array to the file, finally closing the file with API/FSO. You could do as you suggested, letting AsyncRead save to file & then rename the file to unicode, again using either APIs or FSO.

    FYI: VB usercontrol's AsyncRead function does support unicode URLs, but not unicode filenames.

    Afterthought: Is it unicode-URL compatible on all systems? Not sure. But it definitely is on Vista (and probably all newer systems). For example, this URL returned all the data just fine:
    http://山东大学.cn
    Last edited by LaVolpe; Jan 27th, 2015 at 07:47 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5

    Thread Starter
    Hyperactive Member
    Join Date
    Jun 2011
    Posts
    461

    Re: Unicode filename

    I have found on Microsoft's site function with CreateFile API and modified it to support Unicode (i.e. changed it to CreateFileW and passed filename trough StrPtr), but it doesn't work as it should - it creates file with filename which is filled with null characters. EDIT: I have just fixed it, look below.
    Also, I have tried with FSO but it acts same like native VB commands.
    Last edited by MikiSoft; Jan 29th, 2015 at 03:59 PM.

  6. #6
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,057

    Re: Unicode filename

    Here's another option:

    Code:
    Option Explicit
    
    Private Sub Main()
        Dim sTitle As String
    
        sTitle = GetYouTubeTitle("https://www.youtube.com/watch?v=gi7gs4EGnCI")
        SaveTextToFileW sTitle, sTitle & ".txt"
    End Sub
    
    Public Function GetYouTubeTitle(ByRef URL As String) As String
        Dim StartPos As Long, EndPos As Long, sBuffer As String
    
        With CreateObject("WinHttp.WinHttpRequest.5.1")
            .Open "GET", URL
            .Send
            sBuffer = .ResponseText
        End With
    
        StartPos = InStr(1&, sBuffer, "<title>", vbTextCompare)
    
        If StartPos Then
            StartPos = StartPos + 7& 'Len("<title>")
            EndPos = InStr(StartPos, sBuffer, "</title>", vbTextCompare)
    
            If EndPos Then GetYouTubeTitle = Mid$(sBuffer, StartPos, EndPos - StartPos - 10&) 'Len(" - YouTube")
        End If
    End Function
    
    Public Sub SaveTextToFileW(ByRef Text As String, ByRef FileName As String)
        Const adSaveCreateOverWrite = 2&
    
        With CreateObject("ADODB.Stream")
            .Open
            .WriteText Text
            .SaveToFile FileName, adSaveCreateOverWrite
            .Close
        End With
    End Sub
    FYI, the WinHttpRequest object can also be used asynchronously. The ADO Stream object, OTOH, can deal with either text or binary data and is fully Unicode-aware.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  7. #7

    Thread Starter
    Hyperactive Member
    Join Date
    Jun 2011
    Posts
    461

    Re: Unicode filename

    Your code works perfectly, thanks! But I want to write binary data in file with Unicode name, so let me test that and post results.

    I have one question about WinHttpRequest code - will it work from Windows XP to 10, i.e. does it have some issues or not?
    Last edited by MikiSoft; Jan 27th, 2015 at 05:21 PM.

  8. #8
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,057

    Re: Unicode filename

    Quote Originally Posted by MikiSoft View Post
    I have just one more question about WinHttpRequest code - will it work from Windows XP to 10, i.e. does it have some issues or not?
    Well, according to WinHTTP Versions:

    Quote Originally Posted by MSDN
    With version 5.1, WinHTTP is an operating-system component of the following operating systems:

    • Windows 2000, Service Pack 3 and later (except Datacenter Server)
    • Windows XP with Service Pack 1 (SP1) and later
    • Windows Server 2003 with Service Pack 1 (SP1) and later
    I didn't experience any issues here in Windows 7; not sure about other OSs, though.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  9. #9

    Thread Starter
    Hyperactive Member
    Join Date
    Jun 2011
    Posts
    461

    Re: [RESOLVED] Unicode filename

    I have tested writing binary data with ADODB Stream now, and it's very slow. Is there any faster solution with Unicode filename support (like function with API that I posted above - but it doesn't work)?
    Last edited by MikiSoft; Jan 27th, 2015 at 05:13 PM.

  10. #10
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,057

    Re: [RESOLVED] Unicode filename

    Sorry, but I'm not aware of any equivalent COM object faster than the ADO Stream object. You might want to search the VB6 CodeBank section for examples of using CreateFileW.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  11. #11

    Thread Starter
    Hyperactive Member
    Join Date
    Jun 2011
    Posts
    461

    Re: [RESOLVED] Unicode filename

    I have found problem with code - it was in API declarations. I have moved fixed version here if someone is interested:
    VB Code:
    1. Option Explicit
    2.       Public Const GENERIC_READ = &H80000000
    3.       Public Const GENERIC_WRITE = &H40000000
    4.       Const FILE_ATTRIBUTE_NORMAL = &H80
    5.       Const CREATE_ALWAYS = 2
    6.       Const OPEN_ALWAYS = 4
    7.       Const INVALID_HANDLE_VALUE = -1
    8.  
    9.       Private Declare Function CloseHandle Lib "kernel32" ( _
    10.         ByVal hObject As Long) As Long
    11.  
    12.       Private Declare Function WriteFile Lib "kernel32" ( _
    13.         ByVal hFile As Long, lpBuffer As Any, _
    14.         ByVal nNumberOfBytesToWrite As Long, _
    15.         lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
    16.  
    17.       Private Declare Function CreateFileW Lib "kernel32" ( _
    18.         ByVal lpFileName As Long, _
    19.         ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
    20.         ByVal lpSecurityAttributes As Long, _
    21.         ByVal dwCreationDisposition As Long, _
    22.         ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) _
    23.         As Long
    24.  
    25.       Declare Function FlushFileBuffers Lib "kernel32" ( _
    26.         ByVal hFile As Long) As Long
    27.  
    28.       Public Function WriteArrayToFile(Fname As String, anArray() As Byte)
    29.          Dim fHandle As Long
    30.          Dim fSuccess As Long
    31.          Dim sTest As String
    32.          Dim lBytesWritten As Long
    33.          Dim BytesToWrite As Long
    34.          'Get the length of data to write
    35.          BytesToWrite = (UBound(anArray) + 1) * LenB(anArray(0))
    36.          'Get a handle to a file Fname.
    37.         fHandle = CreateFileW(StrPtr(Fname), GENERIC_WRITE Or GENERIC_READ, _
    38.                               0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    39.          'Here you should test to see if you get a file handle or not.
    40.          'CreateFile returns INVALID_HANDLE_VALUE if it fails.
    41.          If fHandle <> INVALID_HANDLE_VALUE Then
    42.             fSuccess = WriteFile(fHandle, anArray(LBound(anArray)), _
    43.                                  BytesToWrite, lBytesWritten, 0)
    44.             'Check to see if you were successful writing the data
    45.             If fSuccess <> 0 Then
    46.                'Flush the file buffers to force writing of the data.
    47.                fSuccess = FlushFileBuffers(fHandle)
    48.                'Close the file.
    49.                fSuccess = CloseHandle(fHandle)
    50.             End If
    51.          End If
    52.       End Function
    Also, here is adapted code for AsyncDownload user control:
    VB Code:
    1. Option Explicit
    2.  
    3. Event DownloadProgress(ByVal BytesRead As Long, ByVal BytesTotal As Long)
    4. Event DownloadFailed(ByVal Status As String, ByVal StatusCode As AsyncStatusCodeConstants)
    5. Event DownloadComplete()
    6.  
    7. Public LocalFileName As String
    8.  
    9. Public Sub DownloadFile(URL As String, LocalFileName As String, Optional ByVal Mode As AsyncReadConstants = vbAsyncReadForceUpdate)
    10.   CancelDownload
    11.   Me.LocalFileName = LocalFileName
    12.   On Error Resume Next
    13.     AsyncRead URL, vbAsyncTypeByteArray, "File", Mode
    14.   If Err Then
    15.     RaiseEvent DownloadFailed(Err.Description, Err.Number)
    16.   End If
    17. End Sub
    18.  
    19. Public Sub CancelDownload()
    20.   On Error Resume Next
    21.     CancelAsyncRead "File" 'cancel a possibly still running Download with the same Destination-Filename
    22.   On Error GoTo 0
    23. End Sub
    24.  
    25. Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
    26.   With AsyncProp
    27.     If .BytesRead Then RaiseEvent DownloadProgress(.BytesRead, IIf(.BytesMax <= .BytesRead, .BytesRead, .BytesMax))
    28.   End With
    29. End Sub
    30.  
    31. Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
    32.   If AsyncProp.StatusCode <> vbAsyncStatusCodeEndDownloadData Or AsyncProp.BytesRead = 0 Then
    33.     RaiseEvent DownloadFailed(AsyncProp.Status, AsyncProp.StatusCode)
    34.     CancelDownload
    35.   Else
    36.     WriteArrayToFile LocalFileName, AsyncProp.value
    37.     RaiseEvent DownloadComplete
    38.   End If
    39. End Sub
    Thank you guys for the tips, this is finally solved!
    Last edited by MikiSoft; Jan 29th, 2015 at 03:59 PM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width