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

  • Stephane Fonteyne
    replied
    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

    Leave a comment:


  • salvatore renda
    replied
    Good example. Thanks
    Last edited by salvatore renda; 22 Feb 2013, 03:00 PM.

    Leave a comment:


  • norbert doerre
    replied
    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

    Leave a comment:


  • Peter Redei
    replied
    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

    Leave a comment:


  • José Roca
    replied
    Not right. The structure posted by Kev is correct.

    Leave a comment:


  • Peter Redei
    replied
    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

    Leave a comment:


  • Kev Peel
    replied
    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

    Leave a comment:


  • Peter Redei
    replied
    Crashing

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

    wFile = W32W.cFileName

    I am using PBDLL 7.04.


    Peter Redei

    Leave a comment:


  • Paul Purvis
    replied
    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, 01:29 PM.

    Leave a comment:


  • 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, 09:57 AM. Reason: Updated WIN32_FIND_DATA_W structure
Working...
X