IonicWind Software

IWBasic => The Roundtable => Topic started by: billhsln on January 28, 2009, 02:08:21 PM

Title: Pick a Subdir and send files and dirs to a file to be loaded in Excel
Post by: billhsln on January 28, 2009, 02:08:21 PM
Program I wrote for my wife.  She wanted to pick a subdirectory and get a list of files and subdirectories under that subdirectory.  She needed them sorted, since she knows how to use excel, I wrote the info out to a file that Excel will load.  She could then sort the file any way she wanted within Excel.  I know I could have sorted the file for her, but I was not sure how she wanted it sorted.

' Written by Bill Haesslein
'  for his wife: Julia
'   on 2008-11-30
'
'  uses Sapero's Browse for Folder routines
'
' Select default start directory and then write files and subdirectories
' to a file to be loaded into Excel and then sorted and saved (must do SAVE AS)

DEF version$:string
version$="1.0"

AUTODEFINE "off"

DECLARE IMPORT,SHBrowseForFolder(param1:uint),int
DECLARE IMPORT,SHGetPathFromIDList(param1:uint, param2:uint),int
DECLARE IMPORT,CoTaskMemFree(param1:int),int
DECLARE IMPORT,RtlZeroMemory(dat:uint,length:int),int
DECLARE IMPORT,SendMessageA(hWnd:uint, message:uint, wParam:int, lparam:uint),uint
Declare Import,FlushFileBuffers(uint handle),int

TYPE BROWSEINFO
   UINT hOwner
   UINT pidlRoot
   POINTER pszDisplayName
   POINTER lpszTitle
   UINT ulFlags
   UINT lpfn
   UINT lParam
   UINT iImage
ENDTYPE

CONST WM_USER = 0x400
CONST BFFM_SETSELECTION = WM_USER + 102
CONST BFFM_INITIALIZED = 1
CONST BFFM_VALIDATEFAILED = 3
CONST BIF_RETURNFSANCESTORS = 8
CONST BIF_RETURNONLYFSDIRS = 1
CONST BIF_NEWDIALOGSTYLE = 0x40
CONST BIF_DONTGOBELOWDOMAIN = 2

FILE oFile
ISTRING mdir[261]
INT i, l, mdirl, mdirs, t = 2

OPENCONSOLE

IF FolderRequest(0, "Select Folder to start from", mdir, GETSTARTPATH, 0x441)
IF (OPENFILE(oFile,"C:\\!#!Files.CSV","W") = 0)
mdirl = LEN(mdir)
l = mdirl - 2
FOR i = l TO 1 STEP -1
IF mdir[i] = "\\"
mdirs = i + 2
i = 0
ENDIF
NEXT i
WRITE oFile, MID$(mdir,mdirs,mdirl - mdirs) + ",.."
parsedir(mdir)
FlushFileBuffers(oFile)
CLOSEFILE oFile
SYSTEM "excel.exe", "C:\\!#!Files.CSV"
ELSE
PRINT "Not able to open output file - C:\\!#!Files.TXT"
ENDIF
ELSE
PRINT "No Folder chosen"
ENDIF

'DO
'UNTIL INKEY$ <> ""

CLOSECONSOLE
END

'________________________________________________________________________________________
SUB FolderRequest(hWnd:uint, title:pointer, dir:pointer, initial:pointer, flags:uint),int
'________________________________________________________________________________________
INT r : r = FALSE
ISTRING buffer[261]
UINT item_list
BROWSEINFO bi
RtlZeroMemory(&bi, LEN(bi))
bi.hOwner = hWnd
bi.lpszTitle = title
bi.ulFlags = flags
IF flags = 0 THEN bi.ulFlags = BIF_RETURNFSANCESTORS | BIF_RETURNONLYFSDIRS | BIF_NEWDIALOGSTYLE | BIF_DONTGOBELOWDOMAIN
bi.lpfn = &BrowseFolderCallback
bi.lParam = initial
' Display the browser.
item_list = SHBrowseForFolder(&bi)
IF item_list
IF SHGetPathFromIDList(item_list, &buffer)
#<STRING>dir = buffer + "\\"
r = TRUE
ENDIF
CoTaskMemFree(item_list)
ENDIF
RETURN r
ENDSUB

'___________________________________________________________________________
SUB BrowseFolderCallback(hWnd:uint, uMsg:uint, lParam:uint, lpData:uint),int
'___________________________________________________________________________
SELECT uMsg
CASE BFFM_INITIALIZED
' Set start directory
SendMessageA( hWnd, BFFM_SETSELECTION, TRUE, lpData )
CASE BFFM_VALIDATEFAILED
RETURN 1
ENDSELECT
RETURN 0
ENDSUB

'________________________
SUB parsedir(path:STRING)
'________________________
DEF dir, attrib:INT
DEF filename[261]:ISTRING
DEF fullname[261]:ISTRING
dir = FINDOPEN(path + "\\*.*")
IF (dir)
DO
filename = FINDNEXT(dir,attrib)
IF LEN(filename)
IF attrib & @FILE_DIRECTORY
IF (filename <> ".") AND (filename <> "..")
fullname = path + filename + "\\"
WRITE oFile, "." + MID$(fullname,mdirl + 1) + "," + MID$(fullname,mdirl + 1)
t += 2
parsedir(fullname)
t = t - 2
ENDIF
ELSE
        fullname = path + filename
WRITE oFile, SPACE$(t) + filename + "," + MID$(path,mdirl + 1) + "."
ENDIF
ENDIF
UNTIL filename = ""
FINDCLOSE dir
ENDIF
RETURN
ENDSUB