Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Directory List with Non-ASCII (Unicode) characters in file names

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Directory List with Non-ASCII (Unicode) characters in file names

    Code:
    ' UNICODE_DIRS.bas
    ' Show the a directory list of a folder containing files with names
    ' containing non-ASCII chararacters in the file name.
    ' Reference: http://www.powerbasic.com/support/pbforums/showthread.php?t=37530
    ' Shows listing of all files in $FOLDER_TO_TEST as retrieved by both the
    ' instrinic DIR$ function (which does not handle non-ASCII characters)
    ' and by the Unicode versions the WinAPI functions FindFirstFile() and FindNextFile()
    ' -------------------------------------------------------------------------------------
    ' 05-31-08
    ' COMPILERS:  PB/CC 4.03 or PB/Win 8.03  (compiles "as is" with either)
    ' AUTHOR   :  Michael Mattias Racine WI
    ' COPYRIGHT:  Placed in public domain by author 5/31/08
    ' THANKS TO:  Keve Peel for suggestion to set Unicode-friendly font in display windows
    ' UPDATES:    06/04/08 Changed WIN32_FIND_DATA_W structure to make cAlternateFilename
    '                  28 instead of 14 characters in size, as discovered by others.
    ' --------------------------------------------------------------------------------------
    #COMPILE   EXE
    #DIM       ALL
    #REGISTER  NONE
    #DEBUG     ERROR  ON
    #TOOLS     OFF
    
    ' ----------------------------------------------------------------
    ' #COMPILER statement can be handy, but since it is not
    ' supported until CC4 and WIN8, it has to be coded like
    ' this to work with earlier versions of compilers.
    ' Ditto #CONSOLE OFF
    ' Like, why bother?
    ' -----------------------------------------------------------------
    
    #IF %DEF(%PB_WIN32)
       #IF NOT (%PB_REVISION AND &hFF00) - &h800
           #COMPILER PBWIN, PBCC
       #ENDIF
    #ELSE    ' must be PB/CC
      #IF NOT (%PB_REVISION AND &hFF00) - &h400
           #COMPILER PBWIN, PBCC
          ' #CONSOLE  OFF  <<< Works but you'll regret it if you want to use the STDOUT
      #ENDIF
    #ENDIF
    
    ' ----------------------------------------
    ' PROGRAM EQUATES
    $FOLDER_TO_TEST  = "D:\Work"   ' files "*.*"  in this folder will be listed
    $UNICODE_NULL    =  CHR$(0,0)
    $NUL_W           = $UNICODE_NULL
    ' ----------------------------------------
    ' For some functions we'll be using
    #INCLUDE "WIN32API.INC"
    ' --------------------------------------
    '  MAKE STDOUT a Valid function on PB/WIN
    ' --------------------------------------
    #IF %DEF(%PB_WIN32)
    ' For detection of existing console, I an using this #OPTION VERSION 5 function
    ' necessary on Win/XP
    DECLARE FUNCTION GetConsoleWindow LIB "KERNEL32.DLL" ALIAS "GetConsoleWindow"  () AS LONG
    ' If I have no console window, I know to AllocConsole before doing all the tests.
    
     FUNCTION STDOUT (Z AS STRING) AS LONG
     ' returns TRUE (non-zero) on success
    
       LOCAL hStdOut AS LONG, nCharsWritten AS LONG
       LOCAL nStdHandle   AS DWORD   ' casting problems>
       LOCAL w AS STRING
       STATIC CSInitialized AS LONG, CS AS CRITICAL_SECTION
       LOCAL iRET AS LONG, LE AS LONG
       LOCAL hWndConsole   AS LONG
       ' ------------------------
    
       IF ISFALSE CSInitialized THEN
           InitializeCriticalSection CS
           CSInitialized  =  1
           ' -------------------------------------------------------------------
           'Just comment these lines out if running PB/Windows on Windows 9x/ME.
           hWndConsole       = GetConsoleWindow ()
           IF ISFALSE hWndConsole THEN
              ALLOCConsole
           END IF
           ' === END OF LINES TO BE REMOVED IF RUNNING WIN/9X with PB/WINDOWS
       END IF
    
       nStdHandle = BITS???(%STD_OUTPUT_HANDLE)   'STD_OUTPUT_HANDLE defined in Win32API.INC as -11&
    
       EntercriticalSection Cs
    
       hStdOut         = GetStdHandle (nStdHandle)  ' per Win32API.INC wants DWORD param, returns DWORD
    
       SELECT CASE AS LONG hStdOut
           CASE %NULL, -1&
               iRet = AllocConsole        ' OK, it creates the first time
               LE   = GetLAstError
               #IF 0
               IF ISFALSE iRet THEN
                   MSGBOX "Could not create Console" & $CRLF & SystemErrorMessageText (LE)
               ELSE
                   MSGBOX "Created Console"
               END IF
               #ENDIF
    
               hStdOut       = GetStdHandle (%STD_OUTPUT_HANDLE)
    
       END SELECT
    
       LeaveCriticalSection    CS
    
       w                     = Z & $CRLF
       iRet                  = WriteFile(hStdOut, BYVAL STRPTR(W), LEN(W),  nCharsWritten, BYVAL %NULL)
       LE                    = GETLastError
    
       FUNCTION = iRet   ' true is good
    
     END FUNCTION
    #ENDIF
    
    ' ----------------------------------------------------
    ' CONSTANTS, STRUCTURES AND DECLARES REQUIRED TO USE
    ' UNICODE VERSION OF FINDFIRSTFILE/FINDNEXTFILE
    ' ----------------------------------------------------
    
    %MAX_PATH_W    = %MAX_PATH * 2
    
    TYPE WIn32_FIND_DATA_W
      dwFileAttributes AS DWORD
      ftCreationTime     AS FILETIME
      ftLastAccessTime   AS FILETIME
      ftLastWriteTime    AS FILETIME
      nFileSizeHigh      AS DWORD
      nFileSizeLow       AS DWORD
      dwReserved0        AS DWORD
      dwReserved1        AS DWORD
      cFileName          AS STRING * %MAX_PATH_W
    ' update 6/04/08 
    ' delete:
    '  cAlternateFileName AS ASCIIZ * 14     ' <<<<< SEE NOTE  ALSO SEE UPDATE NOTES
    ' add
      cAlternateFileName  AS STRING * 28  
    ' === END update 6/04/08
    END TYPE
    ' -------------------------------------------------------------------------------
    ' NOTE: "14" is the value for the ANSI version. I "think" this might have to be
    ' "28" for the unicode version. However, since we never read past the
    ' "cFileName" member if this structure in this program, it's moot.
    ' 6/04/08  Not moot at all. I was just lucky. It needs to be 28 
    ' -------------------------------------------------------------------------------
    
    DECLARE FUNCTION FindFirstFileW LIB "KERNEL32.DLL" ALIAS "FindFirstFileW" _
           (BYVAL lpFileName AS DWORD, W32W AS WIN32_FIND_DATA_W) AS DWORD
    
    DECLARE FUNCTION FindNextFileW LIB "KERNEL32.DLL" ALIAS "FindNextFileW" _
          (BYVAL hFindFile AS DWORD, W32W AS WIN32_FIND_DATA_W) AS LONG
    
    ' ** FindClose is not ANSI/UNICODE sensitive can use the standard DECLARE in WIN32API.INC ***
    
    ' ----------------------
    ' PROGRAM ENTRY POINT
    ' ----------------------
    
    FUNCTION PBMAIN() AS LONG
    
        LOCAL sADirList () AS STRING , sWDirList() AS STRING
        LOCAL I AS LONG
    
        REDIM  sADirList(0), sWDirList(0)
        CALL   GetAnsiDirList ($FOLDER_TO_TEST, sADirList ())
        
        
       ' OPTIONAL PROGRESS DISPLAYS (Waitkey$ only supported PB/CC)
       ' CALL DisplayFileList (sADirList())
       ' STDOUT "End of Ansi File list, any key"
       ' WAITKEY$
    
        CALL GetUnicodeDirList ($FOLDER_TO_TEST, sWDirList())
    
       ' CALL DisplayFileList (sWDirList(), %TRUE)
       ' STDOUT "End of Unicode File list, any key"
       ' WAITKEY$
    
       ' FOR I = 1 TO UBOUND (swDirList,1)
       '      STDOUT USING$ ("A:'&'    W:'&'", LSET$(sADirList(I), 30), ACODE$(sWDirList(I) & $NUL))
       ' NEXT
       ' STDOUT "End of Side-by-Size File list, any key"
       ' WAITKEY$
    
        CALL DisplayArraysSideBySide (sADirList(), sWDirList())
        'STDOUT "End of Demo, Any Key"
        'WAITKEY$
    
    END FUNCTION
    
    ' DIR$ does not return the "." and ".." entries; Findfirst/next file does.
    FUNCTION GetAnsiDirList (Folder AS STRING, sA () AS STRING) AS LONG
    
        LOCAL sF AS STRING, mask AS STRING
        LOCAL nFile AS LONG
    
        mask = Folder & "\*.*"
        
       ' --------------------------------------
       ' Do a count loop just to see how big
       ' we need to make our sa() array
       ' --------------------------------------
        sf   = DIR$(Mask, %SUBDIR)
        WHILE LEN (sf)
            INCR nFile
            sf = DIR$
        WEND
        DIR$ CLOSE
        
        ' --------------------------
        ' resize array and fill it
        ' using the DIR$ function
        ' --------------------------
        REDIM SA(nFile)
        nFile   = 0
        sf      = DIR$(Mask, %SUBDIR)
        WHILE LEN (sf)
            INCR nFile
            sA(nFile) = sf
            sf = DIR$
        WEND
    
    END FUNCTION
    
    ' -----------------------------------------------------
    ' Get Directory list as an array of Unicode strings
    ' using FindFirstFileW and FindNextFileW
    ' You will note I had to play with the NULL characters
    ' to get this to work correctly
    ' -----------------------------------------------------
    FUNCTION GetUnicodeDirList (Folder AS STRING, sW () AS STRING) AS LONG
    
        LOCAL W32W AS  WIN32_FIND_DATA_W, hSearch AS LONG
        LOCAL mask AS STRING, wMask AS STRING
        LOCAL nFile AS LONG, bFound AS LONG
        LOCAL nDot  AS LONG
        LOCAL wFile AS STRING
    
        mask = folder & "\*.*" & $NUL   ' add explicit null so it gets to uncode with double-null
        wMask = UCODE$(Mask)            ' convert to unicode
    
        hSearch = FindFirstFileW (BYVAL STRPTR (wMask), W32W)
        IF hSearch <> %INVALID_HANDLE_VALUE THEN
            bFound = %TRUE
        END IF
        ' ----------------
        ' count files
        ' ----------------
        WHILE ISTRUE bFound
                 INCR nFile
                 bFound = FindNextFileW (hSearch, W32W)
        WEND
        FindClose hSearch
        
        ' ------------------------------------
        ' resize array and fill it with
        ' unicode file names returned
        ' by FindFirstFileW and FindNextFileW
        ' ------------------------------------
        REDIM     SW (nFile)
        nDot    = 0&
    
        hSearch = FindFirstFileW (BYVAL STRPTR (wMask), W32W)
        IF hSearch <> %INVALID_HANDLE_VALUE THEN
            bFound = %TRUE
        END IF
        nFile = 0               ' reset
        WHILE ISTRUE bFound
                 ' get entire returned filename
                 wFile      = W32W.cFileName
                 'get the portion of the filename up to the unicode terminator
                 wFile = EXTRACT$ (wFile, $UNICODE_NULL)
                 WFile = wFile & $NUL   ' needs this extra null here.
                 ' optional debug displays
                 'STDOUT USING$ ("Filename found LEN # ==> '&'", LEN(wFile), ACODE$(wFile))
                 'WAITKEY$
                 ' Look for the "." entries whilst still in Unicode...
    
                 IF LEN(Wfile) > 1     THEN ' I was getting a null entry
                    IF ACODE$(LEFT$(WFile, 2) & $NUL) <> "." THEN
                        INCR  nFile
                        sw (nFile) =  wFile
                    ELSE
                        INCR nDot
                    END IF
                 ELSE
                     STDOUT "Got NUll Back getting Unicode file (should not happen)"
                     #IF %DEF (%PB_CC32)
                         WAITKEY$
                     #ELSE
                         SLEEP 2000
                     #ENDIF
                 END IF
                 bFound      = FindNextFileW (hSearch, W32w)
        WEND
        FindClose hSearch
        IF nDot THEN
             REDIM PRESERVE sW (UBOUND (sw,1) - nDot)
        END IF
    
    
    
    END FUNCTION
    
    FUNCTION DisplayFileList (sF() AS STRING, OPTIONAL BYVAL IsUnicode AS LONG) AS LONG
    
     LOCAL i AS LONG
    
     FOR I =  1 TO UBOUND (Sf,1)
         IF ISTRUE IsUnicode THEN
             STDOUT ACODE$(sf(i))
         ELSE
             STDOUT sf(i)
         END IF
     NEXT
    
    END FUNCTION
    
    ' ----------------------------------------------------
    ' DECLARE the UNICODE versions of the window creation
    ' and management functions we use in this program
    ' ----------------------------------------------------
    
    DECLARE FUNCTION CreateWindowExW LIB "USER32.DLL" ALIAS "CreateWindowExW" _
    (BYVAL dwExStyle AS DWORD, BYVAL lpClassName AS DWORD, BYVAL lpWindowName AS DWORD, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _
        BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
        BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD
    
    DECLARE FUNCTION SetWindowTextW LIB "USER32.DLL" ALIAS "SetWindowTextW" (BYVAL hWnd AS DWORD, BYVAL lpString AS DWORD) AS LONG
    
    DECLARE FUNCTION SendMessageW LIB "USER32.DLL" ALIAS "SendMessageW" _
            (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, _
             BYVAL lParam AS LONG) AS LONG
             
             
    ' -----------------------------------------------------------------------------
    ' Create Windows to show the Directory lists.
    ' The Ansi window shows the names of the files as retrieved by DIR$ function
    ' The Unicode window shows the names of the files as retrieved by the
    ' Unicode versions of FindFirstFile and FindNextFile WinAPI functions
    ' ----------------------------------------------------------------------------
    
    FUNCTION DisplayArraysSideBySide (sA() AS STRING, sw() AS STRING) AS LONG
       LOCAL hWnd() AS LONG
       LOCAL dwStyle AS DWORD, sWClass AS STRING, sWTitle AS STRING
       LOCAL hParent AS LONG
       LOCAL i AS LONG
       LOCAL X AS LONG, Y AS LONG, cx AS LONG, Cy AS LONG
       LOCAL sWindowText AS STRING
       LOCAL hInst AS LONG
       LOCAL hFont AS LONG
    
       ' ---------------------------------
       ' Stuff the same for both windows
       ' ---------------------------------
       hInst   =   GetModuleHandle (BYVAL %NULL)
       sWClass =  "edit" & $NUL
       swClass =  UCODE$(swClass)   ' we create BOTH windows as Unicode windows.
       dwstyle =     %WS_OVERLAPPEDWINDOW OR %ES_MULTILINE OR %WS_BORDER _
                  OR %WS_VISIBLE OR %WS_THICKFRAME OR %WS_SYSMENU
    
       dwStyle =  DWSTYLE OR %ES_WANTRETURN OR %ES_READONLY OR %WS_VSCROLL OR %WS_HSCROLL
    
       hParent =  %NULL
       x       =  %CW_USEDEFAULT
       y       =  %CW_USEDEFAULT
       cx      =  %cW_USEDEFAULT
       cy      =  %CW_USEDEFAULT
    
       REDIM hWnd(1)
       FOR I = 0 TO 1
           sWindowText = ""
           IF I = 0 THEN
               swTitle      = "ANSI Directory List" & $NUL
               sa(0)        = "ANSI LIST FROM DIR$"    ' element zero not used when making list
               sWindowText  = JOIN$(sA(), $CRLF) & $NUL
               sWindowText  = UCODE$(sWindowText)
           ELSE
               swTitle     = "Unicode Directory List" & $NUL
               sW(0)       =  UCODE$ ("Unicode List from FindFirstFileW/FindNextFileW")
               sWindowText = JOIN$(sW(), UCODE$($CRLF)) & $UNICODE_NULL
           END IF
           swTitle      = UCODE$(sWTitle)
           hWnd (i)     = CreateWindowExW ( %NULL, STRPTR(swClass), STRPTR(swTitle), _
                             dwStyle, X, Y, Cx, Cy, hParent, %NULL, hInst, BYVAL %NULL)
                             
           ' we need a Unicode font, create it the first time
           IF I = 0  THEN
                CALL CreateUnicodeFont (hWnd(i)) TO hFont
           END IF
           ' set the font to be used in our window...
           SendMessageW   hWnd(i), %WM_SETFONT, hFont, %NULL
           ' set the text of the edit control
           SetWindowTextW hWnd(I), BYVAL STRPTR(sWindowText)
           ' show the window
           ShowWindow hWnd(i), %SW_SHOWNORMAL
    
      NEXT
      
      ' -------------------------------------------
      ' Set up a message loop so windows will
      ' respond to move, scroll and Exit commands
      ' ------------------------------------------
    
      LOCAL msg AS TagMsg
      LOCAL iMsg AS LONG
    
      DO
         iMsg =  GetMessage ( msg, %NULL, 0,0)
         IF ISTRUE iMSg THEN
            TranslateMessage msg
            DispatchMessage  msg
         END IF
      LOOP UNTIL ISFALSE ISwindow(hWnd(0)) AND ISFALSE IsWindow (hWnd(1))
      
     ' clean up
      DeleteObject hFont
    
    END FUNCTION
    
    ' -----------------------------------------------------------
    ' Create a UNICODE-friendly font to use in the display windows
    ' Returns: handle to a font; if NULL, function failed
    ' ------------------------------------------------------------
    
    FUNCTION CreateUNicodeFont(BYVAL hWnd AS LONG) AS LONG
     LOCAL nHeight AS LONG, nWidth AS LONG, nEscapement AS LONG, nOrientation AS LONG, _
           fdwCharset AS LONG, _
           fnWeight AS LONG, fdwItalic AS LONG, fdwUNderLine AS LONG, fdwStrikeOut AS LONG, _
           fdwOutputPrecision AS LONG, _
           fdwClipPrecision   AS LONG, _
           fdwQuality         AS LONG, _
           fdwPitchAndFamily  AS LONG,_
           lpszFace           AS ASCIIZ * 48
     LOCAL PointSizeHeight AS LONG, HDc AS LONG, hFont AS LONG
           PointSizeHeight  = 10
           hDC = GetDc(hwnd)
           nHeight       =  -MulDiv(PointSizeHeight, GetDeviceCaps(hDC, %LOGPIXELSY), 72)
           nWidth        =  nHeight * .5   ' value is a guess. Looks OK.
           nEscapement   = 0
           nOrientation  = 0
           fnWeight      = %FW_NORMAL
           fdwItalic     = %FALSE
           fdwUnderline  = %FALSE
           fdwStrikeout  = %FALSE
           fdwCharset    = %ANSI_CHARSET    ' %OEM_CHARSET  works with either the same way,
           fdwOutputPrecision = %OUT_DEFAULT_PRECIS
           fdwClipPrecision   = %CLIP_DEFAULT_PRECIS
           fdwQuality         = %DEFAULT_QUALITY
           lpszFace           = "Arial"
           hFont = CreateFont(nHeight,_
                              nWidth, _
                              nEscapement,_
                              nOrientation,_
                              fnWeight,_
                              fdwItalic,_
                              fdwUnderline,_
                              fdwStrikeOut,_
                              fdwCharSet,_
                              fdwOutputPrecision,_
                              fdwClipPrecision,_
                              fdwQuality,_
                              fdwPitchAndFamily,_
                              lpszFace)
    
      IF ISTRUE hDc THEN
         ReleaseDc hWnd, hDc
      END IF
      FUNCTION = hFont
    END FUNCTION
    
    '  ** END OF FILE UNICODE_DIRS.BAS ***
    Last edited by Michael Mattias; 4 Jun 2008, 08:57 AM. Reason: Updated WIN32_FIND_DATA_W structure
    Michael Mattias
    Tal Systems Inc. (retired)
    Racine WI USA
    [email protected]
    http://www.talsystems.com

  • #2
    MCM
    i hope that you did not mind me making some small alterations of the program to just list the files and not the directories.
    just saving you some time if you wanted to do so.

    MCM thanks for going the whole way on this program and not just listing the source to create two arrays for listing.


    actually with the addition of one parameter in the GetUnicodeDirList function, this program could be made easily to list files, directories or both files and directories.

    Key Peel provided the code to determine whether the filename was file or directory. look for the "isfolder" variable and its usage.
    the "isfolder" variable addition made negating the use of the "ndot" variable and its use, so i remove all use of the "nDot" variable
    otherwise the code should be exactly the same


    added:
    correction to double the lengths of two variables in the type variable WIN32_FIND_DATA_W
    Code:
    cFileName AS STRING * %MAX_PATH * 2
    cAlternateFileName AS STRING * 14 * 2
    Code:
    ' UNICODE_DIRS.bas
    ' Show the a directory list of a folder containing files with names
    ' containing non-ASCII chararacters in the file name.
    ' Reference: http://www.powerbasic.com/support/pbforums/showthread.php?t=37530
    ' Shows listing of all files in $FOLDER_TO_TEST as retrieved by both the
    ' instrinic DIR$ function (which does not handle non-ASCII characters)
    ' and by the Unicode versions the WinAPI functions FindFirstFile() and FindNextFile()
    ' -------------------------------------------------------------------------------------
    ' 05-31-08
    ' COMPILERS:  PB/CC 4.03 or PB/Win 8.03  (compiles "as is" with either)
    ' AUTHOR   :  Michael Mattias Racine WI
    ' COPYRIGHT:  Placed in public domain by author 5/31/08
    ' THANKS TO:  Keve Peel for suggestion to set Unicode-friendly font in display windows
    ' --------------------------------------------------------------------------------------
    #COMPILE   EXE
    #DIM       ALL
    #REGISTER  NONE
    #DEBUG     ERROR  ON
    #TOOLS     OFF
    
    ' ----------------------------------------------------------------
    ' #COMPILER statement can be handy, but since it is not
    ' supported until CC4 and WIN8, it has to be coded like
    ' this to work with earlier versions of compilers.
    ' Ditto #CONSOLE OFF
    ' Like, why bother?
    ' -----------------------------------------------------------------
    
    #IF %DEF(%PB_WIN32)
       #IF NOT (%PB_REVISION AND &hFF00) - &h800
           #COMPILER PBWIN, PBCC
       #ENDIF
    #ELSE    ' must be PB/CC
      #IF NOT (%PB_REVISION AND &hFF00) - &h400
           #COMPILER PBWIN, PBCC
          ' #CONSOLE  OFF  <<< Works but you'll regret it if you want to use the STDOUT
      #ENDIF
    #ENDIF
    
    ' ----------------------------------------
    ' PROGRAM EQUATES
    $FOLDER_TO_TEST  = "D:\Work"   ' files "*.*"  in this folder will be listed
    $UNICODE_NULL    =  CHR$(0,0)
    $NUL_W           = $UNICODE_NULL
    ' ----------------------------------------
    ' For some functions we'll be using
    #INCLUDE "WIN32API.INC"
    ' --------------------------------------
    '  MAKE STDOUT a Valid function on PB/WIN
    ' --------------------------------------
    #IF %DEF(%PB_WIN32)
    ' For detection of existing console, I an using this #OPTION VERSION 5 function
    ' necessary on Win/XP
    DECLARE FUNCTION GetConsoleWindow LIB "KERNEL32.DLL" ALIAS "GetConsoleWindow"  () AS LONG
    ' If I have no console window, I know to AllocConsole before doing all the tests.
    
     FUNCTION STDOUT (Z AS STRING) AS LONG
     ' returns TRUE (non-zero) on success
    
       LOCAL hStdOut AS LONG, nCharsWritten AS LONG
       LOCAL nStdHandle   AS DWORD   ' casting problems>
       LOCAL w AS STRING
       STATIC CSInitialized AS LONG, CS AS CRITICAL_SECTION
       LOCAL iRET AS LONG, LE AS LONG
       LOCAL hWndConsole   AS LONG
       ' ------------------------
    
       IF ISFALSE CSInitialized THEN
           InitializeCriticalSection CS
           CSInitialized  =  1
           ' -------------------------------------------------------------------
           'Just comment these lines out if running PB/Windows on Windows 9x/ME.
           hWndConsole       = GetConsoleWindow ()
           IF ISFALSE hWndConsole THEN
              ALLOCConsole
           END IF
           ' === END OF LINES TO BE REMOVED IF RUNNING WIN/9X with PB/WINDOWS
       END IF
    
       nStdHandle = BITS???(%STD_OUTPUT_HANDLE)   'STD_OUTPUT_HANDLE defined in Win32API.INC as -11&
    
       EntercriticalSection Cs
    
       hStdOut         = GetStdHandle (nStdHandle)  ' per Win32API.INC wants DWORD param, returns DWORD
    
       SELECT CASE AS LONG hStdOut
           CASE %NULL, -1&
               iRet = AllocConsole        ' OK, it creates the first time
               LE   = GetLAstError
               #IF 0
               IF ISFALSE iRet THEN
                   MSGBOX "Could not create Console" & $CRLF & SystemErrorMessageText (LE)
               ELSE
                   MSGBOX "Created Console"
               END IF
               #ENDIF
    
               hStdOut       = GetStdHandle (%STD_OUTPUT_HANDLE)
    
       END SELECT
    
       LeaveCriticalSection    CS
    
       w                     = Z & $CRLF
       iRet                  = WriteFile(hStdOut, BYVAL STRPTR(W), LEN(W),  nCharsWritten, BYVAL %NULL)
       LE                    = GETLastError
    
       FUNCTION = iRet   ' true is good
    
     END FUNCTION
    #ENDIF
    
    ' ----------------------------------------------------
    ' CONSTANTS, STRUCTURES AND DECLARES REQUIRED TO USE
    ' UNICODE VERSION OF FINDFIRSTFILE/FINDNEXTFILE
    ' ----------------------------------------------------
    
    %MAX_PATH_W    = %MAX_PATH * 2
    
    TYPE WIn32_FIND_DATA_W
      dwFileAttributes AS DWORD
      ftCreationTime     AS FILETIME
      ftLastAccessTime   AS FILETIME
      ftLastWriteTime    AS FILETIME
      nFileSizeHigh      AS DWORD
      nFileSizeLow       AS DWORD
      dwReserved0        AS DWORD
      dwReserved1        AS DWORD
      'cFileName          AS STRING * %MAX_PATH_W 
      'cAlternateFileName AS ASCIIZ * 14    *  ' <<<<< SEE NOTE
      'made change in last two lines, added (* 2) from Kev's Peel correction to allow for the double extra characters in unicode  filenames
      cFileName          AS STRING * %MAX_PATH_W * 2   '
      cAlternateFileName AS ASCIIZ * 14    * 2 ' <<<<< SEE NOTE
    END TYPE
    ' -------------------------------------------------------------------------------
    ' NOTE: "14" is the value for the ANSI version. I "think" this might have to be
    ' "28" for the unicode version. However, since we never read past the
    ' "cFileName" member if this structure in this program, it's moot.
    ' -------------------------------------------------------------------------------
    
    DECLARE FUNCTION FindFirstFileW LIB "KERNEL32.DLL" ALIAS "FindFirstFileW" _
           (BYVAL lpFileName AS DWORD, W32W AS WIN32_FIND_DATA_W) AS DWORD
    
    DECLARE FUNCTION FindNextFileW LIB "KERNEL32.DLL" ALIAS "FindNextFileW" _
          (BYVAL hFindFile AS DWORD, W32W AS WIN32_FIND_DATA_W) AS LONG
    
    ' ** FindClose is not ANSI/UNICODE sensitive can use the standard DECLARE in WIN32API.INC ***
    
    ' ----------------------
    ' PROGRAM ENTRY POINT
    ' ----------------------
    
    FUNCTION PBMAIN() AS LONG
    
        LOCAL sADirList () AS STRING , sWDirList() AS STRING
        LOCAL I AS LONG
    
        REDIM  sADirList(0), sWDirList(0)
        CALL   GetAnsiDirList ($FOLDER_TO_TEST, sADirList ())
    
    
       ' OPTIONAL PROGRESS DISPLAYS (Waitkey$ only supported PB/CC)
       ' CALL DisplayFileList (sADirList())
       ' STDOUT "End of Ansi File list, any key"
       ' WAITKEY$
    
        CALL GetUnicodeDirList ($FOLDER_TO_TEST, sWDirList())
    
       ' CALL DisplayFileList (sWDirList(), %TRUE)
       ' STDOUT "End of Unicode File list, any key"
       ' WAITKEY$
    
       ' FOR I = 1 TO UBOUND (swDirList,1)
       '      STDOUT USING$ ("A:'&'    W:'&'", LSET$(sADirList(I), 30), ACODE$(sWDirList(I) & $NUL))
       ' NEXT
       ' STDOUT "End of Side-by-Size File list, any key"
       ' WAITKEY$
    
        CALL DisplayArraysSideBySide (sADirList(), sWDirList())
        'STDOUT "End of Demo, Any Key"
        'WAITKEY$
    
    END FUNCTION
    
    ' DIR$ does not return the "." and ".." entries; Findfirst/next file does.
    FUNCTION GetAnsiDirList (Folder AS STRING, sA () AS STRING) AS LONG
    
        LOCAL sF AS STRING, mask AS STRING
        LOCAL nFile AS LONG
    
        mask = Folder & "\*.*"
    
       ' --------------------------------------
       ' Do a count loop just to see how big
       ' we need to make our sa() array
       ' --------------------------------------
        sf   = DIR$(Mask, %SUBDIR)
        WHILE LEN (sf)
            INCR nFile
            sf = DIR$
        WEND
        DIR$ CLOSE
    
        ' --------------------------
        ' resize array and fill it
        ' using the DIR$ function
        ' --------------------------
        REDIM SA(nFile)
        nFile   = 0
        sf      = DIR$(Mask, %SUBDIR)
        WHILE LEN (sf)
            INCR nFile
            sA(nFile) = sf
            sf = DIR$
        WEND
    
    END FUNCTION
    
    ' -----------------------------------------------------
    ' Get Directory list as an array of Unicode strings
    ' using FindFirstFileW and FindNextFileW
    ' You will note I had to play with the NULL characters
    ' to get this to work correctly
    ' -----------------------------------------------------
    FUNCTION GetUnicodeDirList (Folder AS STRING, sW () AS STRING) AS LONG
    
        LOCAL W32W AS  WIN32_FIND_DATA_W, hSearch AS LONG
        LOCAL mask AS STRING, wMask AS STRING
        LOCAL nFile AS LONG, bFound AS LONG
        LOCAL wFile AS STRING
        LOCAL isfolder AS LONG
        mask = folder & "\*.*" & $NUL   ' add explicit null so it gets to uncode with double-null
        wMask = UCODE$(Mask)            ' convert to unicode
    
        hSearch = FindFirstFileW (BYVAL STRPTR (wMask), W32W)
        IF hSearch <> %INVALID_HANDLE_VALUE THEN
            bFound = %TRUE
        END IF
        ' ----------------
        ' count files
        ' ----------------
        WHILE ISTRUE bFound
                 INCR nFile
                 bFound = FindNextFileW (hSearch, W32W)
        WEND
        FindClose hSearch
    
        ' ------------------------------------
        ' resize array and fill it with
        ' unicode file names returned
        ' by FindFirstFileW and FindNextFileW
        ' ------------------------------------
        REDIM     SW (nFile)
    
        hSearch = FindFirstFileW (BYVAL STRPTR (wMask), W32W)
        IF hSearch <> %INVALID_HANDLE_VALUE THEN
            bFound = %TRUE
        END IF
        nFile = 0               ' reset
        WHILE ISTRUE bFound
                 ' get entire returned filename
                 wFile      = W32W.cFileName
                 'get the portion of the filename up to the unicode terminator
                 wFile = EXTRACT$ (wFile, $UNICODE_NULL)
                 WFile = wFile & $NUL   ' needs this extra null here.
                 ' optional debug displays
                 'STDOUT USING$ ("Filename found LEN # ==> '&'", LEN(wFile), ACODE$(wFile))
                 'WAITKEY$
                 ' Look for the "." entries whilst still in Unicode...
    
                 IF LEN(Wfile) > 1     THEN ' I was getting a null entry
                    IF ACODE$(LEFT$(WFile, 2) & $NUL) <> "." THEN
                      IsFolder = (w32w.dwFileAttributes AND %FILE_ATTRIBUTE_DIRECTORY)
                       IF isfolder=0 THEN  'isfolder=0 get files, isfolder<>0 get directories
                          INCR  nFile
                          sw (nFile) =  wFile
                      END IF
                    END IF
                 ELSE
                     STDOUT "Got NUll Back getting Unicode file (should not happen)"
                     #IF %DEF (%PB_CC32)
                         WAITKEY$
                     #ELSE
                         SLEEP 2000
                     #ENDIF
                 END IF
                 bFound      = FindNextFileW (hSearch, W32w)
        WEND
        FindClose hSearch
        REDIM PRESERVE sW (nFile)
    
    
    END FUNCTION
    
    FUNCTION DisplayFileList (sF() AS STRING, OPTIONAL BYVAL IsUnicode AS LONG) AS LONG
    
     LOCAL i AS LONG
    
     FOR I =  1 TO UBOUND (Sf,1)
         IF ISTRUE IsUnicode THEN
             STDOUT ACODE$(sf(i))
         ELSE
             STDOUT sf(i)
         END IF
     NEXT
    
    END FUNCTION
    
    ' ----------------------------------------------------
    ' DECLARE the UNICODE versions of the window creation
    ' and management functions we use in this program
    ' ----------------------------------------------------
    
    DECLARE FUNCTION CreateWindowExW LIB "USER32.DLL" ALIAS "CreateWindowExW" _
    (BYVAL dwExStyle AS DWORD, BYVAL lpClassName AS DWORD, BYVAL lpWindowName AS DWORD, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _
        BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
        BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD
    
    DECLARE FUNCTION SetWindowTextW LIB "USER32.DLL" ALIAS "SetWindowTextW" (BYVAL hWnd AS DWORD, BYVAL lpString AS DWORD) AS LONG
    
    DECLARE FUNCTION SendMessageW LIB "USER32.DLL" ALIAS "SendMessageW" _
            (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, _
             BYVAL lParam AS LONG) AS LONG
    
    
    ' -----------------------------------------------------------------------------
    ' Create Windows to show the Directory lists.
    ' The Ansi window shows the names of the files as retrieved by DIR$ function
    ' The Unicode window shows the names of the files as retrieved by the
    ' Unicode versions of FindFirstFile and FindNextFile WinAPI functions
    ' ----------------------------------------------------------------------------
    
    FUNCTION DisplayArraysSideBySide (sA() AS STRING, sw() AS STRING) AS LONG
       LOCAL hWnd() AS LONG
       LOCAL dwStyle AS DWORD, sWClass AS STRING, sWTitle AS STRING
       LOCAL hParent AS LONG
       LOCAL i AS LONG
       LOCAL X AS LONG, Y AS LONG, cx AS LONG, Cy AS LONG
       LOCAL sWindowText AS STRING
       LOCAL hInst AS LONG
       LOCAL hFont AS LONG
    
       ' ---------------------------------
       ' Stuff the same for both windows
       ' ---------------------------------
       hInst   =   GetModuleHandle (BYVAL %NULL)
       sWClass =  "edit" & $NUL
       swClass =  UCODE$(swClass)   ' we create BOTH windows as Unicode windows.
       dwstyle =     %WS_OVERLAPPEDWINDOW OR %ES_MULTILINE OR %WS_BORDER _
                  OR %WS_VISIBLE OR %WS_THICKFRAME OR %WS_SYSMENU
    
       dwStyle =  DWSTYLE OR %ES_WANTRETURN OR %ES_READONLY OR %WS_VSCROLL OR %WS_HSCROLL
    
       hParent =  %NULL
       x       =  %CW_USEDEFAULT
       y       =  %CW_USEDEFAULT
       cx      =  %cW_USEDEFAULT
       cy      =  %CW_USEDEFAULT
    
       REDIM hWnd(1)
       FOR I = 0 TO 1
           sWindowText = ""
           IF I = 0 THEN
               swTitle      = "ANSI Directory List" & $NUL
               sa(0)        = "ANSI LIST FROM DIR$"    ' element zero not used when making list
               sWindowText  = JOIN$(sA(), $CRLF) & $NUL
               sWindowText  = UCODE$(sWindowText)
           ELSE
               swTitle     = "Unicode Directory List" & $NUL
               sW(0)       =  UCODE$ ("Unicode List from FindFirstFileW/FindNextFileW")
               sWindowText = JOIN$(sW(), UCODE$($CRLF)) & $UNICODE_NULL
           END IF
           swTitle      = UCODE$(sWTitle)
           hWnd (i)     = CreateWindowExW ( %NULL, STRPTR(swClass), STRPTR(swTitle), _
                             dwStyle, X, Y, Cx, Cy, hParent, %NULL, hInst, BYVAL %NULL)
    
           ' we need a Unicode font, create it the first time
           IF I = 0  THEN
                CALL CreateUnicodeFont (hWnd(i)) TO hFont
           END IF
           ' set the font to be used in our window...
           SendMessageW   hWnd(i), %WM_SETFONT, hFont, %NULL
           ' set the text of the edit control
           SetWindowTextW hWnd(I), BYVAL STRPTR(sWindowText)
           ' show the window
           ShowWindow hWnd(i), %SW_SHOWNORMAL
    
      NEXT
    
      ' -------------------------------------------
      ' Set up a message loop so windows will
      ' respond to move, scroll and Exit commands
      ' ------------------------------------------
    
      LOCAL msg AS TagMsg
      LOCAL iMsg AS LONG
    
      DO
         iMsg =  GetMessage ( msg, %NULL, 0,0)
         IF ISTRUE iMSg THEN
            TranslateMessage msg
            DispatchMessage  msg
         END IF
      LOOP UNTIL ISFALSE ISwindow(hWnd(0)) AND ISFALSE IsWindow (hWnd(1))
    
     ' clean up
      DeleteObject hFont
    
    END FUNCTION
    
    ' -----------------------------------------------------------
    ' Create a UNICODE-friendly font to use in the display windows
    ' Returns: handle to a font; if NULL, function failed
    ' ------------------------------------------------------------
    
    FUNCTION CreateUNicodeFont(BYVAL hWnd AS LONG) AS LONG
     LOCAL nHeight AS LONG, nWidth AS LONG, nEscapement AS LONG, nOrientation AS LONG, _
           fdwCharset AS LONG, _
           fnWeight AS LONG, fdwItalic AS LONG, fdwUNderLine AS LONG, fdwStrikeOut AS LONG, _
           fdwOutputPrecision AS LONG, _
           fdwClipPrecision   AS LONG, _
           fdwQuality         AS LONG, _
           fdwPitchAndFamily  AS LONG,_
           lpszFace           AS ASCIIZ * 48
     LOCAL PointSizeHeight AS LONG, HDc AS LONG, hFont AS LONG
           PointSizeHeight  = 10
           hDC = GetDc(hwnd)
           nHeight       =  -MulDiv(PointSizeHeight, GetDeviceCaps(hDC, %LOGPIXELSY), 72)
           nWidth        =  nHeight * .5   ' value is a guess. Looks OK.
           nEscapement   = 0
           nOrientation  = 0
           fnWeight      = %FW_NORMAL
           fdwItalic     = %FALSE
           fdwUnderline  = %FALSE
           fdwStrikeout  = %FALSE
           fdwCharset    = %ANSI_CHARSET    ' %OEM_CHARSET  works with either the same way,
           fdwOutputPrecision = %OUT_DEFAULT_PRECIS
           fdwClipPrecision   = %CLIP_DEFAULT_PRECIS
           fdwQuality         = %DEFAULT_QUALITY
           lpszFace           = "Arial"
           hFont = CreateFont(nHeight,_
                              nWidth, _
                              nEscapement,_
                              nOrientation,_
                              fnWeight,_
                              fdwItalic,_
                              fdwUnderline,_
                              fdwStrikeOut,_
                              fdwCharSet,_
                              fdwOutputPrecision,_
                              fdwClipPrecision,_
                              fdwQuality,_
                              fdwPitchAndFamily,_
                              lpszFace)
    
      IF ISTRUE hDc THEN
         ReleaseDc hWnd, hDc
      END IF
      FUNCTION = hFont
    END FUNCTION
    
    '  ** END OF FILE UNICODE_DIRS.BAS ***
    Last edited by Paul Purvis; 3 Jun 2008, 12:29 PM.
    p purvis

    Comment


    • #3
      Crashing

      Weird...
      It is crashing for me at this line

      wFile = W32W.cFileName

      I am using PBDLL 7.04.


      Peter Redei

      Comment


      • #4
        Windows might be writing past the structure boundary. Try using this structure:

        Code:
        %CHAR_S = 2 ' Unicode character size
        
        TYPE WIN32_FIND_DATA_W
          dwFileAttributes AS DWORD
          ftCreationTime AS FILETIME
          ftLastAccessTime AS FILETIME
          ftLastWriteTime AS FILETIME
          nFileSizeHigh AS DWORD
          nFileSizeLow AS DWORD
          dwReserved0 AS DWORD
          dwReserved1 AS DWORD
          cFileName AS STRING * %MAX_PATH * %CHAR_S
          cAlternateFileName AS STRING * 14 * %CHAR_S
        END TYPE
        Let me know if that works
        kgpsoftware.com | Slam DBMS | PrpT Control | Other Downloads | Contact Me

        Comment


        • #5
          I think correctly should be...

          Kev, this works, so does the original with correct %MAX_PATH_W value, that should be

          %MAX_PATH_W = 2 * %MAX_PATH + 2

          because double wide characters plus two bytes for $UNICODE_NULL. Right?

          Peter Redei

          Comment


          • #6
            Not right. The structure posted by Kev is correct.
            Forum: http://www.jose.it-berater.org/smfforum/index.php

            Comment


            • #7
              You are right.

              Jose, you are right I realized that actually the cAlternateFileName length caused the crash. It should be 28 instead of 14.

              Peter Redei

              Comment


              • #8
                A quick alternative vor ANSI Search

                Code:
                '------------------------------------------------------------------------
                '  FUNCTION GetAnsiDirList
                '------------------------------------------------------------------------
                FUNCTION GetAnsiFileList(iKind AS LONG, sFolder AS STRING, sMask AS STRING, sList() AS STRING) AS LONG
                   'INPUT:  iKind: %NORMAL, %HIDDEN, %SYSTEM, %VLABEL, %SUBDIR 
                   '        sFolder = The Folder where to start searching, "c:\Programme\PB10\"
                   '        sMask = The file extension to be searched for, "*.exe"
                   'OUTPUT: sList() = 1-based list with the found items, "Prg.exe"
                   'Function value: Number of folders and/or files found.
                   'See above: DIR$ does not return the "." and ".." entries; 
                                    'Findfirst/Findnext file does.
                   LOCAL sF AS STRING
                   LOCAL nFile AS LONG
                   'Loop to count folders and/or files:
                   sf = DIR$(sFolder & sMask, iKind)
                   WHILE LEN(sf) > 0
                      INCR nFile
                      sf = DIR$
                   WEND
                   DIR$ CLOSE
                   'Dimension Array 'sList(nFile)' and fill with data from DIR$:
                   REDIM sList(nFile)
                   nFile = 0
                   sf = DIR$(sFolder & sMask, iKind)
                   WHILE LEN(sf) > 0
                      INCR nFile
                      sList(nFile) = sf
                      sf = DIR$
                   WEND
                   FUNCTION = nFile
                END FUNCTION
                Norbert Doerre

                Comment


                • #9
                  Good example. Thanks
                  Last edited by salvatore renda; 22 Feb 2013, 02:00 PM.

                  Comment


                  • #10
                    Hi,

                    It' cannot compile with Jose Roca includes and the new pb includes. I try to compile it with PBCC 5 & PBCC 6 and PBWin9 & PBWin10.
                    Not successfull

                    PBCC 5.0
                    Code:
                    ' UNICODE_DIRS.bas
                    ' Show the a directory list of a folder containing files with names
                    ' containing non-ASCII chararacters in the file name.
                    ' Reference: http://www.powerbasic.com/support/pbforums/showthread.php?t=37530
                    ' Shows listing of all files in $FOLDER_TO_TEST as retrieved by both the
                    ' instrinic DIR$ function (which does not handle non-ASCII characters)
                    ' and by the Unicode versions the WinAPI functions FindFirstFile() and FindNextFile()
                    ' -------------------------------------------------------------------------------------
                    ' 05-31-08
                    ' COMPILERS:  PB/CC 4.03 or PB/Win 8.03  (compiles "as is" with either)
                    ' AUTHOR   :  Michael Mattias Racine WI
                    ' COPYRIGHT:  Placed in public domain by author 5/31/08
                    ' THANKS TO:  Keve Peel for suggestion to set Unicode-friendly font in display windows
                    ' UPDATES:    06/04/08 Changed WIN32_FIND_DATA_W structure to make cAlternateFilename
                    '                  28 instead of 14 characters in size, as discovered by others.
                    ' --------------------------------------------------------------------------------------
                    #COMPILE   EXE "cc50_Unicode_Dir_List_v1.1.exe"
                    #DIM       ALL
                    #REGISTER  NONE
                    #DEBUG     ERROR  ON
                    #TOOLS     OFF
                    
                    ' ----------------------------------------------------------------
                    ' #COMPILER statement can be handy, but since it is not
                    ' supported until CC4 and WIN8, it has to be coded like
                    ' this to work with earlier versions of compilers.
                    ' Ditto #CONSOLE OFF
                    ' Like, why bother?
                    ' -----------------------------------------------------------------
                    
                    #IF %DEF(%PB_WIN32)
                       #IF NOT (%PB_REVISION AND &hFF00) - &h800
                           #COMPILER PBWIN, PBCC
                       #ENDIF
                    #ELSE    ' must be PB/CC
                      #IF NOT (%PB_REVISION AND &hFF00) - &h400
                           #COMPILER PBWIN, PBCC
                          ' #CONSOLE  OFF  <<< Works but you'll regret it if you want to use the STDOUT
                      #ENDIF
                    #ENDIF
                    
                    ' ----------------------------------------
                    ' PROGRAM EQUATES
                    $FOLDER_TO_TEST  = "D:\Work"   ' files "*.*"  in this folder will be listed
                    $UNICODE_NULL    =  CHR$(0,0)
                    $NUL_W           = $UNICODE_NULL
                    ' ----------------------------------------
                    ' For some functions we'll be using
                    #INCLUDE "WIN32API.INC"
                    ' --------------------------------------
                    '  MAKE STDOUT a Valid function on PB/WIN
                    ' --------------------------------------
                    #IF %DEF(%PB_WIN32)
                    ' For detection of existing console, I an using this #OPTION VERSION 5 function
                    ' necessary on Win/XP
                    DECLARE FUNCTION GetConsoleWindow LIB "KERNEL32.DLL" ALIAS "GetConsoleWindow"  () AS LONG
                    ' If I have no console window, I know to AllocConsole before doing all the tests.
                    
                     FUNCTION STDOUT (Z AS STRING) AS LONG
                     ' returns TRUE (non-zero) on success
                    
                       LOCAL hStdOut AS LONG, nCharsWritten AS LONG
                       LOCAL nStdHandle   AS DWORD   ' casting problems>
                       LOCAL w AS STRING
                       STATIC CSInitialized AS LONG, CS AS CRITICAL_SECTION
                       LOCAL iRET AS LONG, LE AS LONG
                       LOCAL hWndConsole   AS LONG
                       ' ------------------------
                    
                       IF ISFALSE CSInitialized THEN
                           InitializeCriticalSection CS
                           CSInitialized  =  1
                           ' -------------------------------------------------------------------
                           'Just comment these lines out if running PB/Windows on Windows 9x/ME.
                           hWndConsole       = GetConsoleWindow ()
                           IF ISFALSE hWndConsole THEN
                              ALLOCConsole
                           END IF
                           ' === END OF LINES TO BE REMOVED IF RUNNING WIN/9X with PB/WINDOWS
                       END IF
                    
                       nStdHandle = BITS???(%STD_OUTPUT_HANDLE)   'STD_OUTPUT_HANDLE defined in Win32API.INC as -11&
                    
                       EntercriticalSection Cs
                    
                       hStdOut         = GetStdHandle (nStdHandle)  ' per Win32API.INC wants DWORD param, returns DWORD
                    
                       SELECT CASE AS LONG hStdOut
                           CASE %NULL, -1&
                               iRet = AllocConsole        ' OK, it creates the first time
                               LE   = GetLAstError
                               #IF 0
                               IF ISFALSE iRet THEN
                                   MSGBOX "Could not create Console" & $CRLF & SystemErrorMessageText (LE)
                               ELSE
                                   MSGBOX "Created Console"
                               END IF
                               #ENDIF
                    
                               hStdOut       = GetStdHandle (%STD_OUTPUT_HANDLE)
                    
                       END SELECT
                    
                       LeaveCriticalSection    CS
                    
                       w                     = Z & $CRLF
                       iRet                  = WriteFile(hStdOut, BYVAL STRPTR(W), LEN(W),  nCharsWritten, BYVAL %NULL)
                       LE                    = GETLastError
                    
                       FUNCTION = iRet   ' true is good
                    
                     END FUNCTION
                    #ENDIF
                    
                    ' ----------------------------------------------------
                    ' CONSTANTS, STRUCTURES AND DECLARES REQUIRED TO USE
                    ' UNICODE VERSION OF FINDFIRSTFILE/FINDNEXTFILE
                    ' ----------------------------------------------------
                    
                    %MAX_PATH_W    = %MAX_PATH * 2
                    
                    TYPE WIn32_FIND_DATA_W
                      dwFileAttributes AS DWORD
                      ftCreationTime     AS FILETIME
                      ftLastAccessTime   AS FILETIME
                      ftLastWriteTime    AS FILETIME
                      nFileSizeHigh      AS DWORD
                      nFileSizeLow       AS DWORD
                      dwReserved0        AS DWORD
                      dwReserved1        AS DWORD
                      'cFileName          AS STRING * %MAX_PATH_W
                      'cAlternateFileName AS ASCIIZ * 14    *  ' <<<<< SEE NOTE
                      'made change in last two lines, added (* 2) from Kev's Peel correction to allow for the double extra characters in unicode  filenames
                      cFileName          AS STRING * %MAX_PATH_W * 2   '
                      cAlternateFileName AS ASCIIZ * 14    * 2 ' <<<<< SEE NOTE
                    END TYPE
                    ' -------------------------------------------------------------------------------
                    ' NOTE: "14" is the value for the ANSI version. I "think" this might have to be
                    ' "28" for the unicode version. However, since we never read past the
                    ' "cFileName" member if this structure in this program, it's moot.
                    ' -------------------------------------------------------------------------------
                    
                    DECLARE FUNCTION FindFirstFileW LIB "KERNEL32.DLL" ALIAS "FindFirstFileW" _
                           (BYVAL lpFileName AS DWORD, W32W AS WIN32_FIND_DATA_W) AS DWORD
                    
                    DECLARE FUNCTION FindNextFileW LIB "KERNEL32.DLL" ALIAS "FindNextFileW" _
                          (BYVAL hFindFile AS DWORD, W32W AS WIN32_FIND_DATA_W) AS LONG
                    
                    ' ** FindClose is not ANSI/UNICODE sensitive can use the standard DECLARE in WIN32API.INC ***
                    
                    ' ----------------------
                    ' PROGRAM ENTRY POINT
                    ' ----------------------
                    
                    FUNCTION PBMAIN() AS LONG
                    
                        LOCAL sADirList () AS STRING , sWDirList() AS STRING
                        LOCAL I AS LONG
                    
                        REDIM  sADirList(0), sWDirList(0)
                        CALL   GetAnsiDirList ($FOLDER_TO_TEST, sADirList ())
                    
                    
                       ' OPTIONAL PROGRESS DISPLAYS (Waitkey$ only supported PB/CC)
                       ' CALL DisplayFileList (sADirList())
                       ' STDOUT "End of Ansi File list, any key"
                       ' WAITKEY$
                    
                        CALL GetUnicodeDirList ($FOLDER_TO_TEST, sWDirList())
                    
                       ' CALL DisplayFileList (sWDirList(), %TRUE)
                       ' STDOUT "End of Unicode File list, any key"
                       ' WAITKEY$
                    
                       ' FOR I = 1 TO UBOUND (swDirList,1)
                       '      STDOUT USING$ ("A:'&'    W:'&'", LSET$(sADirList(I), 30), ACODE$(sWDirList(I) & $NUL))
                       ' NEXT
                       ' STDOUT "End of Side-by-Size File list, any key"
                       ' WAITKEY$
                    
                        CALL DisplayArraysSideBySide (sADirList(), sWDirList())
                        'STDOUT "End of Demo, Any Key"
                        'WAITKEY$
                    
                    END FUNCTION
                    
                    ' DIR$ does not return the "." and ".." entries; Findfirst/next file does.
                    FUNCTION GetAnsiDirList (Folder AS STRING, sA () AS STRING) AS LONG
                    
                        LOCAL sF AS STRING, mask AS STRING
                        LOCAL nFile AS LONG
                    
                        mask = Folder & "\*.*"
                    
                       ' --------------------------------------
                       ' Do a count loop just to see how big
                       ' we need to make our sa() array
                       ' --------------------------------------
                        sf   = DIR$(Mask, %SUBDIR)
                        WHILE LEN (sf)
                            INCR nFile
                            sf = DIR$
                        WEND
                        DIR$ CLOSE
                    
                        ' --------------------------
                        ' resize array and fill it
                        ' using the DIR$ function
                        ' --------------------------
                        REDIM SA(nFile)
                        nFile   = 0
                        sf      = DIR$(Mask, %SUBDIR)
                        WHILE LEN (sf)
                            INCR nFile
                            sA(nFile) = sf
                            sf = DIR$
                        WEND
                    
                    END FUNCTION
                    
                    ' -----------------------------------------------------
                    ' Get Directory list as an array of Unicode strings
                    ' using FindFirstFileW and FindNextFileW
                    ' You will note I had to play with the NULL characters
                    ' to get this to work correctly
                    ' -----------------------------------------------------
                    FUNCTION GetUnicodeDirList (Folder AS STRING, sW () AS STRING) AS LONG
                    
                        LOCAL W32W AS  WIN32_FIND_DATA_W, hSearch AS LONG
                        LOCAL mask AS STRING, wMask AS STRING
                        LOCAL nFile AS LONG, bFound AS LONG
                        LOCAL wFile AS STRING
                        LOCAL isfolder AS LONG
                        mask = folder & "\*.*" & $NUL   ' add explicit null so it gets to uncode with double-null
                        wMask = UCODE$(Mask)            ' convert to unicode
                    
                        hSearch = FindFirstFileW (BYVAL STRPTR (wMask), W32W)
                        IF hSearch <> %INVALID_HANDLE_VALUE THEN
                            bFound = %TRUE
                        END IF
                        ' ----------------
                        ' count files
                        ' ----------------
                        WHILE ISTRUE bFound
                                 INCR nFile
                                 bFound = FindNextFileW (hSearch, W32W)
                        WEND
                        FindClose hSearch
                    
                        ' ------------------------------------
                        ' resize array and fill it with
                        ' unicode file names returned
                        ' by FindFirstFileW and FindNextFileW
                        ' ------------------------------------
                        REDIM     SW (nFile)
                    
                        hSearch = FindFirstFileW (BYVAL STRPTR (wMask), W32W)
                        IF hSearch <> %INVALID_HANDLE_VALUE THEN
                            bFound = %TRUE
                        END IF
                        nFile = 0               ' reset
                        WHILE ISTRUE bFound
                                 ' get entire returned filename
                                 wFile      = W32W.cFileName
                                 'get the portion of the filename up to the unicode terminator
                                 wFile = EXTRACT$ (wFile, $UNICODE_NULL)
                                 WFile = wFile & $NUL   ' needs this extra null here.
                                 ' optional debug displays
                                 'STDOUT USING$ ("Filename found LEN # ==> '&'", LEN(wFile), ACODE$(wFile))
                                 'WAITKEY$
                                 ' Look for the "." entries whilst still in Unicode...
                    
                                 IF LEN(Wfile) > 1     THEN ' I was getting a null entry
                                    IF ACODE$(LEFT$(WFile, 2) & $NUL) <> "." THEN
                                      ISFOLDER = (w32w.dwFileAttributes AND %FILE_ATTRIBUTE_DIRECTORY)
                                       IF ISFOLDER=0 THEN  'isfolder=0 get files, isfolder<>0 get directories
                                          INCR  nFile
                                          sw (nFile) =  wFile
                                      END IF
                                    END IF
                                 ELSE
                                     STDOUT "Got NUll Back getting Unicode file (should not happen)"
                                     #IF %DEF (%PB_CC32)
                                         WAITKEY$
                                     #ELSE
                                         SLEEP 2000
                                     #ENDIF
                                 END IF
                                 bFound      = FindNextFileW (hSearch, W32w)
                        WEND
                        FindClose hSearch
                        REDIM PRESERVE sW (nFile)
                    
                    
                    END FUNCTION
                    
                    FUNCTION DisplayFileList (sF() AS STRING, OPTIONAL BYVAL IsUnicode AS LONG) AS LONG
                    
                     LOCAL i AS LONG
                    
                     FOR I =  1 TO UBOUND (Sf,1)
                         IF ISTRUE IsUnicode THEN
                             STDOUT ACODE$(sf(i))
                         ELSE
                             STDOUT sf(i)
                         END IF
                     NEXT
                    
                    END FUNCTION
                    
                    ' ----------------------------------------------------
                    ' DECLARE the UNICODE versions of the window creation
                    ' and management functions we use in this program
                    ' ----------------------------------------------------
                    
                    DECLARE FUNCTION CreateWindowExW LIB "USER32.DLL" ALIAS "CreateWindowExW" _
                    (BYVAL dwExStyle AS DWORD, BYVAL lpClassName AS DWORD, BYVAL lpWindowName AS DWORD, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _
                        BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
                        BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD
                    
                    DECLARE FUNCTION SetWindowTextW LIB "USER32.DLL" ALIAS "SetWindowTextW" (BYVAL hWnd AS DWORD, BYVAL lpString AS DWORD) AS LONG
                    
                    DECLARE FUNCTION SendMessageW LIB "USER32.DLL" ALIAS "SendMessageW" _
                            (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, _
                             BYVAL lParam AS LONG) AS LONG
                    
                    
                    ' -----------------------------------------------------------------------------
                    ' Create Windows to show the Directory lists.
                    ' The Ansi window shows the names of the files as retrieved by DIR$ function
                    ' The Unicode window shows the names of the files as retrieved by the
                    ' Unicode versions of FindFirstFile and FindNextFile WinAPI functions
                    ' ----------------------------------------------------------------------------
                    
                    FUNCTION DisplayArraysSideBySide (sA() AS STRING, sw() AS STRING) AS LONG
                       LOCAL hWnd() AS LONG
                       LOCAL dwStyle AS DWORD, sWClass AS STRING, sWTitle AS STRING
                       LOCAL hParent AS LONG
                       LOCAL i AS LONG
                       LOCAL X AS LONG, Y AS LONG, cx AS LONG, Cy AS LONG
                       LOCAL sWindowText AS STRING
                       LOCAL hInst AS LONG
                       LOCAL hFont AS LONG
                    
                       ' ---------------------------------
                       ' Stuff the same for both windows
                       ' ---------------------------------
                       hInst   =   GetModuleHandle (BYVAL %NULL)
                       sWClass =  "edit" & $NUL
                       swClass =  UCODE$(swClass)   ' we create BOTH windows as Unicode windows.
                       dwstyle =     %WS_OVERLAPPEDWINDOW OR %ES_MULTILINE OR %WS_BORDER _
                                  OR %WS_VISIBLE OR %WS_THICKFRAME OR %WS_SYSMENU
                    
                       dwStyle =  DWSTYLE OR %ES_WANTRETURN OR %ES_READONLY OR %WS_VSCROLL OR %WS_HSCROLL
                    
                       hParent =  %NULL
                       x       =  %CW_USEDEFAULT
                       y       =  %CW_USEDEFAULT
                       cx      =  %cW_USEDEFAULT
                       cy      =  %CW_USEDEFAULT
                    
                       REDIM hWnd(1)
                       FOR I = 0 TO 1
                           sWindowText = ""
                           IF I = 0 THEN
                               swTitle      = "ANSI Directory List" & $NUL
                               sa(0)        = "ANSI LIST FROM DIR$"    ' element zero not used when making list
                               sWindowText  = JOIN$(sA(), $CRLF) & $NUL
                               sWindowText  = UCODE$(sWindowText)
                           ELSE
                               swTitle     = "Unicode Directory List" & $NUL
                               sW(0)       =  UCODE$ ("Unicode List from FindFirstFileW/FindNextFileW")
                               sWindowText = JOIN$(sW(), UCODE$($CRLF)) & $UNICODE_NULL
                           END IF
                           swTitle      = UCODE$(sWTitle)
                           hWnd (i)     = CreateWindowExW ( %NULL, STRPTR(swClass), STRPTR(swTitle), _
                                             dwStyle, X, Y, Cx, Cy, hParent, %NULL, hInst, BYVAL %NULL)
                    
                           ' we need a Unicode font, create it the first time
                           IF I = 0  THEN
                                CALL CreateUnicodeFont (hWnd(i)) TO hFont
                           END IF
                           ' set the font to be used in our window...
                           SendMessageW   hWnd(i), %WM_SETFONT, hFont, %NULL
                           ' set the text of the edit control
                           SetWindowTextW hWnd(I), BYVAL STRPTR(sWindowText)
                           ' show the window
                           ShowWindow hWnd(i), %SW_SHOWNORMAL
                    
                      NEXT
                    
                      ' -------------------------------------------
                      ' Set up a message loop so windows will
                      ' respond to move, scroll and Exit commands
                      ' ------------------------------------------
                    
                      LOCAL msg AS TagMsg
                      LOCAL iMsg AS LONG
                    
                      DO
                         iMsg =  GetMessage ( msg, %NULL, 0,0)
                         IF ISTRUE iMSg THEN
                            TranslateMessage msg
                            DispatchMessage  msg
                         END IF
                      LOOP UNTIL ISFALSE ISwindow(hWnd(0)) AND ISFALSE IsWindow (hWnd(1))
                    
                     ' clean up
                      DeleteObject hFont
                    
                    END FUNCTION
                    
                    ' -----------------------------------------------------------
                    ' Create a UNICODE-friendly font to use in the display windows
                    ' Returns: handle to a font; if NULL, function failed
                    ' ------------------------------------------------------------
                    
                    FUNCTION CreateUNicodeFont(BYVAL hWnd AS LONG) AS LONG
                     LOCAL nHeight AS LONG, nWidth AS LONG, nEscapement AS LONG, nOrientation AS LONG, _
                           fdwCharset AS LONG, _
                           fnWeight AS LONG, fdwItalic AS LONG, fdwUNderLine AS LONG, fdwStrikeOut AS LONG, _
                           fdwOutputPrecision AS LONG, _
                           fdwClipPrecision   AS LONG, _
                           fdwQuality         AS LONG, _
                           fdwPitchAndFamily  AS LONG,_
                           lpszFace           AS ASCIIZ * 48
                     LOCAL PointSizeHeight AS LONG, HDc AS LONG, hFont AS LONG
                           PointSizeHeight  = 10
                           hDC = GetDc(hwnd)
                           nHeight       =  -MulDiv(PointSizeHeight, GetDeviceCaps(hDC, %LOGPIXELSY), 72)
                           nWidth        =  nHeight * .5   ' value is a guess. Looks OK.
                           nEscapement   = 0
                           nOrientation  = 0
                           fnWeight      = %FW_NORMAL
                           fdwItalic     = %FALSE
                           fdwUnderline  = %FALSE
                           fdwStrikeout  = %FALSE
                           fdwCharset    = %ANSI_CHARSET    ' %OEM_CHARSET  works with either the same way,
                           fdwOutputPrecision = %OUT_DEFAULT_PRECIS
                           fdwClipPrecision   = %CLIP_DEFAULT_PRECIS
                           fdwQuality         = %DEFAULT_QUALITY
                           lpszFace           = "Arial"
                           hFont = CreateFont(nHeight,_
                                              nWidth, _
                                              nEscapement,_
                                              nOrientation,_
                                              fnWeight,_
                                              fdwItalic,_
                                              fdwUnderline,_
                                              fdwStrikeOut,_
                                              fdwCharSet,_
                                              fdwOutputPrecision,_
                                              fdwClipPrecision,_
                                              fdwQuality,_
                                              fdwPitchAndFamily,_
                                              lpszFace)
                    
                      IF ISTRUE hDc THEN
                         ReleaseDc hWnd, hDc
                      END IF
                      FUNCTION = hFont
                    END FUNCTION
                    
                    '  ** END OF FILE UNICODE_DIRS.BAS ***
                    
                    PowerBASIC Console Compiler
                    PB/CC   Version 5.05.
                    Copyright (c) 1998-2010 PowerBasic Inc.
                    Englewood, Florida USA
                    All Rights Reserved
                    
                    Error 519 in D:\POWERB~1\PB_SOU~1\2013\feb\DIRLIS~1\project\src\main\cc60_unicode_dirs_1.bas(242:015):  Missing declaration: FINDFIRSTFILEW
                    Line 242:     hSearch = FindFirstFileW (BYVAL STRPTR (wMask), W32W)
                    ==============================
                    Compile failed at 13:33:26 on 18/01/2015
                    
                    PowerBASIC Console Compiler
                    PB/CC   Version 5.05.
                    Copyright (c) 1998-2010 PowerBasic Inc.
                    Englewood, Florida USA
                    All Rights Reserved
                    
                    Error 426 in D:\POWERB~1\PB_SOU~1\2013\feb\DIRLIS~1\project\cc50_Unicode_Dir_List_v1.2.bas(232:011):  Variable expected
                    Line 232:     LOCAL isfolder AS LONG
                    ==============================
                    Compile failed at 13:42:11 on 18/01/2015
                    
                    PowerBASIC Console Compiler
                    PB/CC   Version 5.05.
                    Copyright (c) 1998-2010 PowerBasic Inc.
                    Englewood, Florida USA
                    All Rights Reserved
                    
                    Primary source:  D:\POWERB~1\PB_SOU~1\2013\feb\DIRLIS~1\project\src\main\cc50_Unicode_Dir_List_v1.0.bas   {50273 total lines}
                    Target compilation:  cc50_Unicode_Dir_List_v1.0.exe
                    Compile time:  0.4 seconds, at 7540950 lines/minute
                    
                    5596 bytes compiled code, 13409 bytes RTLibrary,
                    276 bytes string literals, and 4676 bytes dgroup.
                    Executable stack size:  1048576 bytes.
                    Disk image: 27136 bytes   Memory image: 18361 bytes.
                    
                    Component Files:
                    ----------------
                    D:\POWERB~1\PB_SOU~1\2013\feb\DIRLIS~1\project\src\main\cc50_Unicode_Dir_List_v1.0.bas
                    C:\PROGRA~1\POWERB~1\COMPIL~1\PBCC\V5.00\WINAPI\WIN32API.INC
                    ==============================
                    Compile succeeded at 13:47:55 on 18/01/2015
                    
                    PowerBASIC Console Compiler
                    PB/CC   Version 5.05.
                    Copyright (c) 1998-2010 PowerBasic Inc.
                    Englewood, Florida USA
                    All Rights Reserved
                    
                    Primary source:  D:\POWERB~1\PB_SOU~1\2013\feb\DIRLIS~1\project\src\main\cc50_Unicode_Dir_List_v1.0.bas   {50273 total lines}
                    Target compilation:  cc50_Unicode_Dir_List_v1.0.exe
                    Compile time:  0.4 seconds, at 7540950 lines/minute
                    
                    5596 bytes compiled code, 13409 bytes RTLibrary,
                    276 bytes string literals, and 4676 bytes dgroup.
                    Executable stack size:  1048576 bytes.
                    Disk image: 27136 bytes   Memory image: 18361 bytes.
                    
                    Component Files:
                    ----------------
                    D:\POWERB~1\PB_SOU~1\2013\feb\DIRLIS~1\project\src\main\cc50_Unicode_Dir_List_v1.0.bas
                    C:\PROGRA~1\POWERB~1\COMPIL~1\PBCC\V5.00\WINAPI\WIN32API.INC
                    ==============================
                    Compile succeeded at 13:48:00 on 18/01/2015
                    
                    PowerBASIC Console Compiler
                    PB/CC   Version 5.05.
                    Copyright (c) 1998-2010 PowerBasic Inc.
                    Englewood, Florida USA
                    All Rights Reserved
                    
                    Error 426 in D:\POWERB~1\PB_SOU~1\2013\feb\DIRLIS~1\project\src\main\cc50_Unicode_Dir_List_v1.1.bas(233:011):  Variable expected
                    Line 233:     LOCAL isfolder AS LONG
                    ==============================
                    Compile failed at 13:48:13 on 18/01/2015
                    Thanks

                    Comment

                    Working...
                    X