Home Page

R. T. RUSSELL

BBC BASIC for Windows

Directory print



This program prints a directory listing (i.e. the contents of a file folder) to the printer or to a tab-delimited text file. The text file can be imported, for example, into Excel for subsequent processing. Various options are provided for file selection and display, such as whether or not file folders are listed. The listing can be sorted by clicking on the appropriate column header.

Download DIRPRINT.BBC Run DIRPRINT.EXE

     REM. Directory print in BBC BASIC for Windows, RTR 01-May-2007, 24-Apr-2013
     REM!Exefile C:\www\bbcwin\examples\dirprint.exe

     REM. Install libraries:
     
INSTALL @lib$+"WINLIB"
     INSTALL @lib$+"WINLIB2"
     INSTALL @lib$+"WINLIB5"

     REM. Program constants:
     
MAXFILE = 5000
     MAXCOL  = 4

     REM. Windows constants:
     
WM_NOTIFY = 78
     WM_COMMAND = 273
     HDN_ITEMCLICKA = -302
     LVM_GETITEMCOUNT   = &1004
     LVM_INSERTITEM     = &1007
     LVM_DELETEALLITEMS = &1009
     LVM_INSERTCOLUMN   = &101B
     LVM_GETITEMTEXTA   = &102D
     LVM_SETITEMTEXT    = &102E
     LVM_SORTITEMS      = &1030

     REM. Set initial options:
     
ListFilter$ = "*"
     ListFolders% = TRUE
     
FoldersFirst% = TRUE
     
ListHidden% = FALSE
     
Folder$ = @dir$

     REM. Declare arrays:
     
DIM Res$(MAXFILE,MAXCOL), Rank%(MAXFILE,MAXCOL)
     DIM Head$(MAXCOL), Width%(MAXCOL), Tab%(MAXCOL)
     Head$() = "Name", "Size", "Type", "Date Modified", "Attributes"
     Width%() = 200, 80, 150, 120, 70
     Tab%() = 0, 24, 36, 60, 77
     PROCassemble(^Res$(0,1) - ^Res$(0,0))

     ON ERROR VDU 6,3 : SYS "MessageBox", @hwnd%, REPORT$, 0, 48 : PROCcleanup : QUIT
     ON CLOSE PROC
cleanup : QUIT

     
REM. Create menu bar:
     
SYS "CreatePopupMenu" TO hfile%
     SYS "AppendMenu", hfile%, 0, &101, "&Browse for Folder..."
     SYS "AppendMenu", hfile%, 0, &102, "&Save to File..."
     SYS "AppendMenu", hfile%, 0, &103, "Page Se&tup..."
     SYS "AppendMenu", hfile%, 0, &104, "&Print..."
     SYS "AppendMenu", hfile%, &800, 0, 0
     SYS "AppendMenu", hfile%, 0, &108, "&Options"
     SYS "AppendMenu", hfile%, &800, 0, 0
     SYS "AppendMenu", hfile%, 0, &109, "E&xit"

     SYS "CreateMenu" TO hmenu%
     SYS "AppendMenu", hmenu%, 16, hfile%, "&File"
     SYS "SetMenu", @hwnd%, hmenu%
     SYS "DrawMenuBar", @hwnd%

     REM. Create Options dialogue:
     
Options% = FN_newdialog("Options",50,50,135,97,8,424)
     PROC_static(Options%,"Filename filter:",100,5,11,50,16,2)
     PROC_editbox(Options%,"",101,66,8,60,12,&80)
     PROC_checkbox(Options%,"List folders",102,10,26,64,16,0)
     PROC_checkbox(Options%,"List folders first",103,10,41,64,16,0)
     PROC_checkbox(Options%,"List hidden files",104,10,56,64,16,0)
     PROC_pushbutton(Options%,"OK",1,8,75,56,14,1)
     PROC_pushbutton(Options%,"Cancel",2,71,75,56,14,0)

     REM. Create toolbar:
     
DIM button%(2), buttid%(2), buttip$(2)
     button%() = 7,8,14
     buttid%() = &101,&102,&104
     buttip$() = "Browse for Folder", "Save to File", "Print"
     hToolbar% = FN_createtoolbar(3, button%(), buttid%())
     PROC_addtooltips(hToolbar%, 3, buttip$(), buttid%())
     VDU 26

     REM. Initialise PRINTDLG structure:
     
DIM Pd{lStructSize%, hwndOwner%, hDevMode%, hDevNames%, \
     
\      hdc%, flags%, nFromPage{l&,h&}, nToPage{l&,h&}, \
     
\      nMinPage{l&,h&}, nMaxPage{l&,h&}, nCopies{l&,h&}, \
     
\      hInstance%, lCustData%, lpfnPrintHook%, lpfnSetupHook%, \
     
\      lpPrintTemplateName%, lpSetupTemplateName%, \
     
\      hPrintTemplate%, hSetupTemplate%}
     Pd.lStructSize% = DIM(Pd{})
     Pd.hwndOwner% = @hwnd%
     Pd.flags% = &500 : REM. PD_RETURNDC | PD_RETURNDEFAULT
     
SYS "PrintDlg", Pd{}

     REM. Initialise PAGESETUPDLG structure:
     
DIM Psd{lStructSize%, hwndOwner%, hDevMode%, hDevNames%, \
     
\      flags%, ptPaperSize{w%,h%}, rtMinMargin{l%,t%,r%,b%}, \
     
\      rtMargin{l%,t%,r%,b%}, hInstance%, lCustData%, \
     
\      lpfnPageSetupHook%, lpfnPagePaintHook%, \
     
\      lpPageSetupTemplateName%, hPageSetupTemplate%}
     Psd.lStructSize% = DIM(Psd{})
     Psd.hwndOwner% = @hwnd%
     Psd.flags% = &A : REM. PSD_MARGINS | PSD_INHUNDREDTHSOFMILLIMETERS
     
Psd.rtMargin.l% = 1000 : REM. Left margin
     
Psd.rtMargin.t% = 1000 : REM. Top margin
     
Psd.rtMargin.r% = 1000 : REM. Right margin
     
Psd.rtMargin.b% = 1000 : REM. Bottom margin

     REM. Initialise BROWSEINFO structure:
     
DIM Bi{hOwner%, pidlRoot%, pszDisplayName%, lpszTitle%, ulFlags%, lpfn%, \
     
\      lParam%, iImage%}, folder% 255
     Bi.hOwner% = @hwnd%
     Bi.pszDisplayName% = folder%

     REM. Initialise OPENFILENAME structure:
     
DIM Ofn{lStructSize%, hwndOwner%, hInstance%, lpstrFilter%, \
     
\      lpstrCustomFilter%, nMaxCustFilter%, nFilterIndex%, \
     
\      lpstrFile%, nMaxFile%, lpstrFileTitle%, \
     
\      nMaxFileTitle%, lpstrInitialDir%, lpstrTitle%, \
     
\      flags%, nFileOffset{l&,h&}, nFileExtension{l&,h&}, \
     
\      lpstrDefExt%, lCustData%, lpfnHook%, lpTemplateName%}
     DIM fn% 255
     filter$ = "Text (tab delimited)"+CHR$0+"*.TXT"+CHR$0+CHR$0
     Ofn.lStructSize% = DIM(Ofn{})
     Ofn.hwndOwner% = @hwnd%
     Ofn.lpstrFilter% = !^filter$
     Ofn.lpstrFile% = fn%
     Ofn.nMaxFile% = 256
     Ofn.flags% = 6 : REM OFN_OVERWRITEPROMPT | OFN_HIDEREADONLY

     REM. Initialise LV_COLUMN and LV_ITEM structures:
     
DIM lc{mask%, fmt%, cx%, pszText%, cchTextMax%, iSubItem%}
     DIM Lvitem{mask%, iItem%, iSubItem%, state%, stateMask%, pszText%, \
     
\          cchTextMax%, iImage%, lParam%}
     lc.mask% = 15 : REM mask = LVCF_WIDTH | LVCF_SUBITEM | LVCF_FMT | LVCF_TEXT
     
Lvitem.mask% = 13 : REM LVIF_TEXT | LVIF_STATE | LVIF_PARAM

     REM. Create list view control:
     
SYS "InitCommonControls"
     hList% = FN_createwindow("SysListView32","",0,36,@vdu%!28,@vdu%!36-36,0,&0001,0) : REM LVS_REPORT
     
FOR C% = 0 TO MAXCOL
       Head$(C%) += CHR$0
       IF C% = 1 lc.fmt% = 1 ELSE lc.fmt% = 0 : REM right-justify size
       
lc.cx%         = Width%(C%)
       lc.pszText%    = !^Head$(C%)
       lc.cchTextMax% = LENHead$(C%)
       lc.iSubItem%   = C%
       SYS "SendMessage", hList%, LVM_INSERTCOLUMN, C%, lc{}
     NEXT

     DIM
Move%(2), Click%(1), click%(1)
     Click%(0) = -1
     SortCol% = -1
     Direction% = 1

     ON SYS Click%() = @wparam% AND &FFFF, @lparam% : RETURN
     ON MOVE
Move%() = @msg%, @wparam%, @lparam% : PROCmove(Move%()) : RETURN

     
REM. Polling loop:
     
PROCupdate
     REPEAT
       
click%(0) = INKEY(10)
       SWAP Click%(), click%()
       CASE click%(0) OF
         WHEN
WM_NOTIFY:
           IF click%(1) = SortCol% Direction% *= -1 ELSE Direction% = 1
           SortCol% = click%(1)
           CASE SortCol% OF
             WHEN
0: SYS "SendMessage", hList%, LVM_SORTITEMS, 0, scomp
             WHEN 1: SYS "SendMessage", hList%, LVM_SORTITEMS, 1, ncomp
             WHEN 2: SYS "SendMessage", hList%, LVM_SORTITEMS, 2, scomp
             WHEN 3: SYS "SendMessage", hList%, LVM_SORTITEMS, 3, ncomp
             WHEN 4: SYS "SendMessage", hList%, LVM_SORTITEMS, 4, scomp
           ENDCASE
           IF
FoldersFirst% SYS "SendMessage", hList%, LVM_SORTITEMS, 0, ncomp
         WHEN &101: IF FNbrowse PROCupdate
         WHEN &102: PROCwrite
         WHEN &103: PROCpagesetup
         WHEN &104: PROCprint
         WHEN &108: IF FNoptions PROCupdate
         WHEN &109: PROCcleanup : QUIT
       ENDCASE
     UNTIL FALSE

     
DEF FNbrowse : LOCAL pidl%, malloc%
     SYS "SHBrowseForFolder", Bi{} TO pidl%
     IF pidl% = 0 THEN = FALSE
     SYS
"SHGetPathFromIDList", pidl%, Bi.pszDisplayName%
     SYS "SHGetMalloc", ^malloc%
     SYS !(!malloc%+20), malloc%, pidl% : REM. IMalloc::Free
     
Folder$ = $$Bi.pszDisplayName%
     = TRUE

     
DEF PROCupdate : LOCAL found%, C%, I%
     IF Folder$ = "" ENDPROC
     IF
ListFolders% found% = FNdir(Folder$,"*",Res$(),Rank%(),TRUE,ListHidden%,0)
     found% = FNdir(Folder$,ListFilter$,Res$(),Rank%(),FALSE,ListHidden%,found%)
     SYS "SendMessage", hList%, LVM_DELETEALLITEMS, 0, 0
     IF found% THEN
       SYS
"SetWindowText", @hwnd%, "Listing of "+Folder$
       FOR I% = 0 TO found%-1
         FOR C% = 0 TO MAXCOL
           text$ = Res$(I%,C%)+CHR$0
           Lvitem.iItem%      = I%
           Lvitem.iSubItem%   = C%
           Lvitem.pszText%    = !^text$
           Lvitem.cchTextMax% = LENtext$
           Lvitem.lParam%     = I%
           IF C% THEN
             SYS
"SendMessage", hList%, LVM_SETITEMTEXT, I%, Lvitem{}
           ELSE
             SYS
"SendMessage", hList%, LVM_INSERTITEM, I%, Lvitem{}
           ENDIF
         NEXT
C%
       NEXT I%
     ENDIF
     
Direction% = 1
     SYS "SendMessage", hList%, LVM_SORTITEMS, 0, scomp
     IF FoldersFirst% SYS "SendMessage", hList%, LVM_SORTITEMS, 0, ncomp
     ENDPROC

     
DEF PROCpagesetup : LOCAL ok%, dm%
     Psd.hDevMode%  = Pd.hDevMode%
     Psd.hDevNames% = Pd.hDevNames%
     SYS "PageSetupDlg", Psd{} TO ok%
     IF ok% = 0 ENDPROC
     IF
Psd.hDevMode% THEN
       SYS
"GlobalLock", Psd.hDevMode% TO dm%
       SYS "ResetDC", @prthdc%, dm%
       SYS "GlobalUnlock", Psd.hDevMode%
     ENDIF
     ENDPROC

     
DEF PROCprint : LOCAL ok%
     Pd.flags% = &108
     SYS "PrintDlg", Pd{} TO ok%
     IF ok% = 0 ENDPROC
     SYS
"DeleteDC", @prthdc%
     @prthdc% = Pd.hdc%
     *PRINTERFONT Courier New,10
     OSCLI "MARGINS "+STR$(Psd.rtMargin.l%DIV100)+","+STR$(Psd.rtMargin.b%DIV100)+\
     
\            ","+STR$(Psd.rtMargin.r%DIV100)+","+STR$(Psd.rtMargin.t%DIV100)
     VDU 2,21
     PROClist(FALSE)
     VDU 1,12,6,3
     ENDPROC

     
DEF PROCwrite : LOCAL fn$, res%
     SYS "GetSaveFileName", Ofn{} TO res%
     IF res% = 0 ENDPROC
     
fn$ = $$Ofn.lpstrFile%
     IF FNupper(RIGHT$(fn$,4)) <> ".TXT" fn$ += ".txt"
     VDU 21
     OSCLI "SPOOL " + fn$
     PROClist(TRUE)
     *SPOOL
     VDU 6
     ENDPROC

     
DEF PROClist(flag%) : LOCAL C%, I%, N%, buf%
     DIM buf% LOCAL 255
     SYS "SendMessage", hList%, LVM_GETITEMCOUNT, 0, 0 TO N%
     IF N% THEN
       FOR
I% = 0 TO N%-1
         FOR C% = 0 TO MAXCOL
           Lvitem.iItem%      = I%
           Lvitem.iSubItem%   = C%
           Lvitem.pszText%    = buf%
           Lvitem.cchTextMax% = 256
           SYS "SendMessage", hList%, LVM_GETITEMTEXTA, I%, Lvitem{} TO N% : buf%?N% = 13
           IF C% IF flag% PRINT CHR$9; ELSE PRINT TAB(Tab%(C%));
           IF C% = 1 $buf% = RIGHT$("         "+$buf%,10)
           PRINT $buf% " ";
         NEXT
         PRINT
       NEXT
I%
     ENDIF
     ENDPROC

     
DEF FNoptions : LOCAL ok%, hdlg%, hchk%, buf%
     DIM buf% LOCAL 255
     PROC_showdialog(Options%)
     hdlg% = !Options%
     SYS "SetDlgItemText", hdlg%, 101, ListFilter$
     SYS "CheckDlgButton", hdlg%, 102, ListFolders% AND 1
     SYS "CheckDlgButton", hdlg%, 103, FoldersFirst% AND 1
     SYS "CheckDlgButton", hdlg%, 104, ListHidden% AND 1
     REPEAT
       
click%(0) = INKEY(2)
       IF click%(0) = -1 SWAP click%(),Click%()
       SYS "IsDlgButtonChecked", hdlg%, 102 TO ok%
       SYS "GetDlgItem", hdlg%, 103 TO hchk%
       SYS "EnableWindow", hchk%, ok%
     UNTIL !Options% = 0 OR click%(0) = 1 OR click%(0) = 2
     IF click%(0) = 1 THEN
       SYS
"GetDlgItemText", hdlg%, 101, buf%, 255
       ListFilter$ = $$buf%
       SYS "IsDlgButtonChecked", hdlg%, 102 TO ok%
       ListFolders% = ok% <> 0
       SYS "IsDlgButtonChecked", hdlg%, 103 TO ok%
       FoldersFirst% = ok% <> 0
       SYS "IsDlgButtonChecked", hdlg%, 104 TO ok%
       ListHidden% = ok% <> 0
     ENDIF
     PROC
_closedialog(Options%)
     = (click%(0) = 1)

     DEF PROCmove(M%())
     SYS "SendMessage", hToolbar%, M%(0), M%(1), M%(2)
     IF M%(0) = 5 SYS "MoveWindow", hList%, 0, 36, M%(2) AND &FFFF, (M%(2) >> 16) - 36, 1
     ENDPROC

     
DEF PROCcleanup
     hList% += 0   : IF hList%   PROC_closewindow(hList%)
     Options% += 0 : IF Options% PROC_closedialog(Options%)
     PROC_removetoolbar
     SYS "SetWindowLong", @hwnd%, -4, !oldwndproc
     ENDPROC

     
DEF FNdir(path$,find$,Res$(),Rank%(),folder%,hidden%,index%)
     LOCAL @%, dir%, buf%, dot%, l%, st%, sh%, key%, res%
     @% = &1010
     DIM dir% LOCAL 317, buf% LOCAL 255, st% LOCAL 15
     IF RIGHT$(path$,1)<>"\" path$ += "\"
     IF find$ = "" find$ = "*"
     SYS "FindFirstFile", path$+find$, dir% TO sh%
     IF sh% <> -1 THEN
       REPEAT
         IF
(!dir% AND 16) = (folder% AND 16) AND (!dir% AND 2) <= (hidden% AND 2) THEN
           
REM File name:
           
Res$(index%,0) = $$(dir%+44)
           Rank%(index%,0) = 16 - (!dir% AND 16)
           REM File size:
           
Res$(index%,1) = STR$(2^32*dir%!28 + 2*(dir%!32>>>1) + (dir%!32AND1))
           Rank%(index%,1) = dir%!32
           REM File type:
           
Res$(index%,2) = " "
           IF !dir% AND 16 THEN
             
Res$(index%,2) = "File Folder"
           ELSE
             
l% = 0
             REPEAT
               
dot% = l%
               l% = INSTR(Res$(index%,0),".",l%+1)
             UNTIL l% = 0
             IF dot% THEN
               
Res$(index%,2) = FNupper(MID$(Res$(index%,0),dot%+1)) + " file"
               SYS "RegOpenKeyEx", &80000000, MID$(Res$(index%,0),dot%), 0, &20001, ^key% TO res%
               IF res% = 0 THEN
                 
l% = 255 : SYS "RegQueryValueEx", key%, "", 0, 0, buf%, ^l% TO res%
                 SYS "RegCloseKey", key%
                 SYS "RegOpenKeyEx", &80000000, buf%, 0, &20001, ^key% TO res%
                 IF res% = 0 THEN
                   
l% = 255 : SYS "RegQueryValueEx", key%, "", 0, 0, buf%, ^l% TO res%
                   buf%?(l%-1) = 13
                   Res$(index%,2) = $buf%
                   SYS "RegCloseKey", key%
                 ENDIF
               ENDIF
             ENDIF
           ENDIF
           
REM Date/time modified:
           
SYS "FileTimeToSystemTime", dir%+20, st%
           SYS "GetDateFormat", 0, 0, st%, 0, buf%, 256 TO l%
           IF l% buf%?(l%-1) = 13 : Res$(index%,3) = $buf%
           SYS "GetTimeFormat", 0, 10, st%, 0, buf%, 256 TO l%
           IF l% buf%?(l%-1) = 13 : Res$(index%,3) += " "+$buf%
           Rank%(index%,3) = dir%!23
           REM File attributes:
           
Res$(index%,4) = " "
           IF !dir% AND 32 Res$(index%,4) += "A"
           IF !dir% AND  2 Res$(index%,4) += "H"
           IF !dir% AND  4 Res$(index%,4) += "S"
           IF !dir% AND  1 Res$(index%,4) += "R"
           REM Don't list "." and "..":
           
IF Res$(index%,0) <> "." AND Res$(index%,0) <> ".." index% += 1
         ENDIF
         SYS
"FindNextFile", sh%, dir% TO res%
       UNTIL res% = 0
       SYS "FindClose", sh%
     ENDIF
     
= index%

     DEF FNupper(A$) : LOCAL I%
     FOR I% = 1 TO LENA$
       IF MID$(A$,I%,1) >= "a" AND MID$(A$,I%,1) <= "z" MID$(A$,I%,1) = CHR$(ASCMID$(A$,I%,1)-&20)
     NEXT I%
     = A$

     REM. Assembler code is required to intercept the WM_NOTIFY message and
     REM. for the numeric and string compare routines used by LVM_SORTITEMS
     
DEF PROCassemble(S%)
     DIM code 230, L% -1
     FOR pass% = 8 TO 10 STEP 2
       P% = code
       [OPT pass%
       .ncomp
       mov edx,^Rank%(0,0)
       mov ecx,[esp+4]
       imul ecx,MAXCOL+1
       add ecx,[esp+12]
       mov eax,[edx+4*ecx]
       mov ecx,[esp+8]
       imul ecx,MAXCOL+1
       add ecx,[esp+12]
       sub eax,[edx+4*ecx]
       imul eax,[^Direction%]
       ret 12
       ;
       .scomp
       mov edx,^Res$(0,0)
       mov ecx,[esp+8]
       imul ecx,MAXCOL+1
       add ecx,[esp+12]
       imul ecx,S%
       movzx eax,word [edx+ecx+4]
       push eax
       push dword [edx+ecx]
       mov eax,[edx+ecx]
       mov ecx,[esp+12]
       imul ecx,MAXCOL+1
       add ecx,[esp+20]
       imul ecx,S%
       movzx eax,word [edx+ecx+4]
       push eax
       push dword [edx+ecx]
       push 1
       push &400
       call "CompareString"
       sub eax,2
       imul eax,[^Direction%]
       ret 12
       ;
       .oldwndproc
       dd 0
       :
       .hdn_itemclick
       mov eax,[eax+12]
       mov [esp+16],eax
       mov dword [esp+8],WM_COMMAND
       mov dword [esp+12],WM_NOTIFY
       pop eax : push dword [oldwndproc]
       push eax : jmp "CallWindowProc"
       :
       .wm_notify
       mov eax,[esp+16]
       cmp dword [eax+8],HDN_ITEMCLICKA
       jz hdn_itemclick
       pop eax : push dword [oldwndproc]
       push eax : jmp "CallWindowProc"
       :
       .newwndproc
       cmp dword [esp+8],WM_NOTIFY
       jz wm_notify
       pop eax : push dword [oldwndproc]
       push eax : jmp "CallWindowProc"
       ]
     NEXT pass%
     SYS "GetWindowLong", @hwnd%, -4 TO !oldwndproc
     SYS "SetWindowLong", @hwnd%, -4, newwndproc
     ENDPROC


Home - Products - Contact us

Best viewed with Any Browser Valid HTML 3.2!
© Richard Russell 2013