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 PROCcleanup : 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
