'info:
' FileNames array contains long file names without path
' ShortNames array contains short file names without path
' Directories array contains long directories names without path
' ShortNameDir array contains short directories names without path
' FUNCTION __File$ (mask$, parameter) - if is parameter 1, this function return SHORT filename AND PATH to this file (after is this file with Enter selected)
' - if is parameter 2, return 2 arrays (STRING): first array is FilesVisible. Contains long filesnames + path. Second is FilesUsable. Contains short filesnames + path.
' - in X$ = __Files$ (mask$, 2) you need NOT X$, is for call only. In this mode select more files using Enter and then go back pressing Esc.
' in function __Files$ use arrow Up and Down, PageUP, PageDN, Home, End, Enter and Esc. Is possible switching drives and selecting files in more places not in 1 dir only!
' Please test it. Use UNICODE paths, UNICODE filenames, for real hard test. For me all works correctly.
'typy a zpusoby navratu: - vrati seznam souboru ze slozky formou pole ---- v poli FileNames - dlouha jmena, ShortNameFile vraci kratka jmena
' - vrati seznam adresaru ---- v poli Directories dlouha jmena, ShortNameDir vraci kratka jmena adresaru
' - vrati jeden soubor po vyberu (soucasny stav) -- __Files (mask$, 1)
' - vrati vice souboru po vyberu ----- __Files (mask$, 2)
'this program in main loop contains _SNDPLAY statement, so please try selecting and then playing some your MP3 files using your national unicode names.
REM sample program
to get/list/sort lists of filenames
/directories v1.0a PD. Upgraded Erik
's code for solving FILES statement unusuality. ' detect operating system
PRINT "Sorry, this program only works in Windows.." CONST INVALID_HANDLE_VALUE
= -1 CONST ERROR_FILE_NOT_FOUND
= 2 CONST ERROR_NO_MORE_FILES
= &H12
ftCreationTime
AS FILETIME
ftLastAccessTime
AS FILETIME
ftLastWriteTime
AS FILETIME
FUNCTION FileTimeToSystemTime&
(lpFileTime
AS FILETIME
, lpSystemTime
AS SYSTEMTIME
) FUNCTION GetVolumeInformationA&
(lpRootPathName$
, lpVolumeNameBuffer$
, BYVAL nVolumeNameSize~&
, lpVolumeSerialNumber~&
, lpMaximumComponentLength~&
, lpFileSystemFlags~&
, lpFileSystemNameBuffer$
, BYVAL nFileSystemNameSize&
) FUNCTION GetDiskFreeSpaceA&
(f$
, sectors&
, bytes&
, free&
, total&
)
' declare library variables.
' declare byte divisor variable.
'--------------------------------
'moje vklady
REDIM SHARED FilesVisible
(1) AS STRING 'pro vicenasobny vyber - dlouha jmena 'multiple select array, long names + path REDIM SHARED FilesUsable
(1) AS STRING 'pro vicenasobny vyber - kratka jmena 'multiple select array, short names + path
DateTimeType = 1
StoreSort1 = 1
StoreSort2 = -1
' ------------ start mych uprav ------------- Petr's upgrade start
rst:
Maska$ = "*.mp3" 'mask
CALL GetFiles
(Maska$
) ' load files list from kernel32 to memory, Erik work CALL SortFiles
(StoreSort1
, StoreSort2
) 'sort files, Erik work
'telo programu disk
' declare some constants.
ByteDivisor = 1024
ByteDivisor = 1000
ByteDivisor = 1024
ListDrives Nul, 0
ListFiles
'telo disk konec
one$ = __Files$("*.*", 1) '__Files$ (function) is Petr's program full based on Erik's demo.
PRINT "Function return this path to 1 selected file: "; one$
PRINT "Select more files with enter, quit with Esc" e$ = __Files$("*.mp3", 2): e$ = "" 'function return with ,2 outputs in arrays FilesVisible and FilesUsable
PRINT "Long names (use with _MAPUNICODE NOT FOR ACCESS! and short system name, use for access:):"
IF w
MOD 5 = 0 AND w
>= 5 THEN COLOR 15:
PRINT "Press any key...":
SLEEP:
CLS:
PRINT "Long names (use with _MAPUNICODE NOT FOR ACCESS! and short system name, use for access:):" PRINT "After pressing key, sound will stopped and is played selected from mode 2 (if are some MP3 selected)"
' critical error trap
FUNCTION __Files$
(mask
AS STRING, typ
AS _BYTE) 'mask - use "*.*" for all files.... typ: 1 for one file select, 2 for more files (and it can be in different directories) selecting, this is ending after pressing Esc, values are then in arrays FilesVisible and FilesUsable. Visible for long names viewing, Usable for file access! THIS MUSS WORKING ON ALL WINDOWS WORLDWIDE!
begin:
DirLevel = 0
sizindex = 1
GetFiles mask$
SortFiles StoreSort1, StoreSort2
REDIM Vse
(DirCount
+ FileCount
) AS STRING ' Both - first directories, then files - contains long names, unussable for stable file access in other as english languages (not coded in Unicode) REDIM Acces
(UBOUND(vse
)) AS STRING ' Both - short names, usable for worldwide file / folder access ListDirs ' modified - give dir names to array adresar$
ListFiles ' modified - give long file names to array soubor$
akt = 1
vklad = 1
Vse
(rew0
) = UCASE$(Adresar
(rew0
)) ostatni(rew0) = DateTimeDir(rew0)
IF ShortNameDir
(rew0
) <> "" THEN Acces
(rew0
) = ShortNameDir
(rew0
) ELSE Acces
(rew0
) = UCASE$(Directories
(rew0
)) FOR rew1
= 1 TO FileCount
Vse(DirCount + rew1) = Soubor(rew1)
ostatni(DirCount + rew1) = DateTimeFile(rew1)
IF ShortNameFile
(rew1
) <> "" THEN Acces
(DirCount
+ rew1
) = ShortNameFile
(rew1
) ELSE Acces
(DirCount
+ rew1
) = Filenames
(rew1
)
ListStart = 1
ListEnd = 15
pul
= CINT(ListEnd
- ListStart
) / 2 IF ListEnd
> Celkem
THEN ListEnd
= Celkem
akt = 1 'what is selected. First name in list after start
vypis = 1
Pso = 5 ' start printing folder list. This number muss be the same as in line 177!
FOR vypis
= ListStart
TO ListEnd
Pso = Pso + 1
akt
= akt
- 1:
IF akt
< 1 THEN akt
= 1 IF akt
< pul
+ ListStart
THEN ListStart
= ListStart
- 1: ListEnd
= ListEnd
- 1 IF ListStart
< 1 THEN ListStart
= 1: ListEnd
= ListStart
+ (ListEnd
- ListStart
+ 1) akt
= akt
+ 1:
IF akt
> Celkem
THEN akt
= Celkem
IF akt
> pul
+ ListStart
THEN ListEnd
= ListEnd
+ 1: ListStart
= ListStart
+ 1 IF ListEnd
> UBOUND(vse
) THEN ListEnd
= UBOUND(vse
): ListStart
= ListEnd
- (ListEnd
- ListStart
+ 1) akt
= akt
- 15:
IF akt
< 1 THEN akt
= 1 ListStart = ListStart - 15
IF ListStart
< 1 THEN ListStart
= 1 ListEnd = ListEnd + 15
IF ListEnd
- 15 > 1 THEN ListStart
= ListEnd
- 15 ELSE ListStart
= 1 IF Vse
(akt
) = ".." THEN CHDIR "..": DirLevel
= DirLevel
- 1: t$
= "":
GOTO begin
IF akt
<= DirCount
THEN CHDIR Acces
(akt
): DirLevel
= DirLevel
+ 1: t$
= "":
GOTO begin
' CHDIR MUSS BE!!!!! set to Acces array for long DIRECTORIES names!!!! zaznam = zaznam + 1
navic$ = ""
navic$ = ostatni(vypis)
IF FilesVisible
(porovnej
) = path$
+ CHR$(92) + Vse
(vypis
) THEN COLOR 2 'musi byt shoda i s cestou IF vypis
> DirCount
AND vypis
<= FileCount
+ DirCount
THEN LOCATE Pso
, 54:
PRINT " "; Attrib
(vypis
- DirCount
) + SPC(14) ' atributy [pole attrib je velke jako dircount + filecount] i3 = 0
Pso = 5
sizindex = 0
LINE (30, 30)-(610, 360), 15, B
LINE (35, 35)-(605, 355), 15, B
LINE (35, 60)-(605, 65), 15, B
_PRINTSTRING (40, 40), " Select file. Use Esc in mode 2 for end. Mode: " + STR$(typ
)
LINE (610, 360)-(30, 395), 15, B
LINE (605, 360)-(35, 390), 15, B
Available$ = Available$ + Drives(HowDisk) + " "
useavailable$ = useavailable$ + Drives(HowDisk)
_PRINTSTRING (30, 400), "Disk info: " + Drives
(disc
) + LTRIM$(":\ Total space: ") + DiskTotalSpace
(disc
) + " Free space: " + DiskFreeSpace
(disc
) + RTRIM$(" [" + DriveLabels
(disc
) + "]") _PRINTSTRING (30, 420), "Press correct key for select drive. Drives: " + Available$
IF Vse
(akt
) = ".." THEN CHDIR "..": DirLevel
= DirLevel
- 1: t$
= "":
GOTO begin
IF akt
<= DirCount
THEN CHDIR Acces
(akt
): DirLevel
= DirLevel
+ 1:
GOTO begin
IF akt
<= DirCount
THEN __Files$
= path$
+ CHR$(92) + Acces
(akt
) ELSE __Files$
= path$
+ CHR$(92) + Acces
(akt
) maska$ = Var$
Var$ = "*.*"
DIM finddata
AS WIN32_FIND_DATAA
DIM SysTime
AS SYSTEMTIME
DirCount = 0!
FileCount = 0!
IF Wfile.Handle
<> INVALID_HANDLE_VALUE
THEN ' OR WDIR.Handle <> INVALID_HANDLE_VALUE THEN Attribute = finddata.dwFileAttributes
Filename$ = finddata.cFileName
IF Filename$
<> "." AND Filename$
<> ".." THEN
' store date/time
x& = FileTimeToSystemTime&(finddata.ftCreationTime, SysTime)
x& = FileTimeToSystemTime&(finddata.ftLastAccessTime, SysTime)
x& = FileTimeToSystemTime&(finddata.ftLastWriteTime, SysTime)
DirCount = DirCount + 1!
Directories(DirCount) = Filename$
DateTimeDir(DirCount) = Var1$
AttributesDir(DirCount) = Attribute
Filename$ = finddata.cAlternateFileName
ShortNameDir(DirCount) = Filename$
FileCount = FileCount + 1!
Filenames(FileCount) = Filename$
F#
= finddata.nFileSizeHigh
* &H100000000~&&
OR finddata.nFileSizeLow
FileSize(FileCount) = F#
DateTimeFile(FileCount) = Var1$
AttributesFile(FileCount) = Attribute
Filename$ = finddata.cAlternateFileName
ShortNameFile(FileCount) = Filename$
x = FindClose(Wfile.Handle)
IF maska$
<> "*.*" THEN Var$
= maska$: Filtruj maska$
'prepise FileCount podle predimenzovaneho poctu zanamu do poli FileNames, FileSize, DateTimeFile a ShortNameFile. Zaznamy adresaru zustanou stejne!
' Var1=1 filename, Var1=2 datetime, Var1=3 filesize
' Var2=-1 ascending, Var2=0 descending
SUB SortFiles
(Var1
, Var2
) FOR X!
= 1!
TO FileCount
- 1!
FOR Y!
= X!
+ 1!
TO FileCount
IF Filenames
(X!
) > Filenames
(Y!
) THEN SWAP Filenames
(X!
), Filenames
(Y!
) SWAP ShortNameFile
(X!
), ShortNameFile
(Y!
) SWAP FileSize
(X!
), FileSize
(Y!
) SWAP DateTimeFile
(X!
), DateTimeFile
(Y!
) SWAP AttributesFile
(X!
), AttributesFile
(Y!
) IF Filenames
(X!
) < Filenames
(Y!
) THEN SWAP Filenames
(X!
), Filenames
(Y!
) SWAP ShortNameFile
(X!
), ShortNameFile
(Y!
) SWAP FileSize
(X!
), FileSize
(Y!
) SWAP DateTimeFile
(X!
), DateTimeFile
(Y!
) SWAP AttributesFile
(X!
), AttributesFile
(Y!
) IF DateTimeFile
(X!
) > DateTimeFile
(Y!
) THEN SWAP Filenames
(X!
), Filenames
(Y!
) SWAP ShortNameFile
(X!
), ShortNameFile
(Y!
) SWAP FileSize
(X!
), FileSize
(Y!
) SWAP DateTimeFile
(X!
), DateTimeFile
(Y!
) SWAP AttributesFile
(X!
), AttributesFile
(Y!
) IF DateTimeFile
(X!
) < DateTimeFile
(Y!
) THEN SWAP Filenames
(X!
), Filenames
(Y!
) SWAP ShortNameFile
(X!
), ShortNameFile
(Y!
) SWAP FileSize
(X!
), FileSize
(Y!
) SWAP DateTimeFile
(X!
), DateTimeFile
(Y!
) SWAP AttributesFile
(X!
), AttributesFile
(Y!
) IF FileSize
(X!
) > FileSize
(Y!
) THEN SWAP Filenames
(X!
), Filenames
(Y!
) SWAP ShortNameFile
(X!
), ShortNameFile
(Y!
) SWAP FileSize
(X!
), FileSize
(Y!
) SWAP DateTimeFile
(X!
), DateTimeFile
(Y!
) SWAP AttributesFile
(X!
), AttributesFile
(Y!
) IF FileSize
(X!
) < FileSize
(Y!
) THEN SWAP Filenames
(X!
), Filenames
(Y!
) SWAP ShortNameFile
(X!
), ShortNameFile
(Y!
) SWAP FileSize
(X!
), FileSize
(Y!
) SWAP DateTimeFile
(X!
), DateTimeFile
(Y!
) SWAP AttributesFile
(X!
), AttributesFile
(Y!
) FOR X!
= 1!
TO DirCount
- 1!
FOR Y!
= X!
+ 1!
TO DirCount
IF Directories
(X!
) > Directories
(Y!
) THEN SWAP Directories
(X!
), Directories
(Y!
) SWAP ShortNameDir
(X!
), ShortNameDir
(Y!
) SWAP DateTimeDir
(X!
), DateTimeDir
(Y!
) SWAP AttributesDir
(X!
), AttributesDir
(Y!
) IF Directories
(X!
) < Directories
(Y!
) THEN SWAP Directories
(X!
), Directories
(Y!
) SWAP ShortNameDir
(X!
), ShortNameDir
(Y!
) SWAP DateTimeDir
(X!
), DateTimeDir
(Y!
) SWAP AttributesDir
(X!
), AttributesDir
(Y!
) IF DateTimeDir
(X!
) > DateTimeDir
(Y!
) THEN SWAP Directories
(X!
), Directories
(Y!
) SWAP ShortNameDir
(X!
), ShortNameDir
(Y!
) SWAP DateTimeDir
(X!
), DateTimeDir
(Y!
) SWAP AttributesDir
(X!
), AttributesDir
(Y!
) IF DateTimeDir
(X!
) < DateTimeDir
(Y!
) THEN SWAP Directories
(X!
), Directories
(Y!
) SWAP ShortNameDir
(X!
), ShortNameDir
(Y!
) SWAP DateTimeDir
(X!
), DateTimeDir
(Y!
) SWAP AttributesDir
(X!
), AttributesDir
(Y!
)
LineCount = 3
c = 0
q = 0
t = 0
F! = 0!
FOR VarQ
= 1 TO FileCount
F! = F! + 1!
q = -1
Var% = AttributesFile(VarQ)
IF (Var%
AND &H20) = &H20 THEN Attrib
(VarQ
) = "A" IF (Var%
AND &H4) = &H4 THEN Attrib
(VarQ
) = "S" IF (Var%
AND &H2) = &H2 THEN Attrib
(VarQ
) = "H" IF (Var%
AND &H1) = &H1 THEN Attrib
(VarQ
) = "R" ' print filesize
Var# = FileSize(VarQ)
VarX# = VarX# + Var# ' add bytes
CALL Suffix
(Var#
, z$
) ' 1,024.0 KB Size(VarQ) = z$
' print longfilename
z$ = Filenames(VarQ)
Soubor$(VarQ) = z$
CALL Suffix
(VarX#
, z$
) ' 1,024.0 KB
LineCount = 3
c = 0
q = 0
t = 0
F! = 0!
F! = F! + 1!
q = -1
z$ = ShortNameDir(VarQ)
z$ = Directories(VarQ)
Var% = AttributesDir(VarQ)
IF (Var%
AND &H20) = &H20 THEN Attrib
(VarQ
) = "A" IF (Var%
AND &H4) = &H4 THEN Attrib
(VarQ
) = "S" IF (Var%
AND &H2) = &H2 THEN Attrib
(VarQ
) = "H" IF (Var%
AND &H1) = &H1 THEN Attrib
(VarQ
) = "R"
z$ = Directories(VarQ)
IF q
= 0 THEN Adresar$
(0) = "None"
' formats a double numeric string
x$ = ""
FormatString$ = s$
e$ = "-"
s$
= LTRIM$(s$
) ' format string x$
= MID$(s$
, l
- 2, 3) + "," + x$
x$
= MID$(s$
, 1, l
) + "," + x$
x$ = s$
x$ = e$ + x$ + q$ ' construct string
FormatString$ = x$
' calculate byte suffix
REM B
(Byte
) = 00x
- 0FFx
(hexidecimal zero
-based
) REM KB
(Kilobyte
) = 1024 B
REM MB
(Megabyte
) = 1024 KB
(1 MB B
) REM GB
(Gigabyte
) = 1024 MB
REM TB
(Terabyte
) = 1024 GB
(1 MB MB
) REM PB
(Petabyte
) = 1024 TB
REM EB
(Exabyte
) = 1024 PB
(1 MB TB
)
' check double
VarX# = Var#
Var3$ = s$
' get sign
Sign = True
' calculate bytes
TempA = False
VarX# = VarX# / 1024
TempA = TempA + 1
' calculate byte string
Var3$ = FormatString$(VarX#)
Var3$ = Var3$ + ".0"
' calculate byte suffix
Var$ = ""
Var$
= MID$("KMGTPE", TempA
, 1) Var3$ = Var3$ + " " + Var$ + "B"
' calculate byte sign
Var3$ = "-" + Var3$
' lists specified drives.
SUB ListDrives
(Var$
, VarQ
) ' Var$ = "x..." only list drives in string,
' otherwise,
' VarQ = 0 list all drives.
' VarQ = -1 except A: and B:
l = 0
IF Var$
<> Nul
THEN ' display specific drives. x = x - 64
IF VarQ
= 0 THEN ' list all drives ' except A: or B:
h = 0
DisplayDrive:
Out3 = c$
h = h + 1
l = l + 1
q = -1
Drives(l) = c$
' display volume label
Out3 = c$
z$ = DriveType
DriveLabels(l) = z$
' display volume serial number
Out3 = c$
DriveSerials(l) = z$
' display volume file system type
Out3 = c$
DriveType(l) = z$
' display volume total disk space
x1# = x#
CALL Suffix
(x#
, S$
) ' 1,024.0 KB DiskTotalSpace(l) = S$
DiskTotalSpace(l) = "<n/a>"
' display volume free disk space
Out3 = c$
y1# = y#
CALL Suffix
(y#
, S$
) ' 1,024.0 KB DiskFreeSpace(l) = S$
DiskFreeSpace(l) = "<n/a>"
' display volume used disk space
z# = x1# - y1#
CALL Suffix
(z#
, S$
) ' 1,024.0 KB DiskUsedSpace(l) = S$
DiskUsedSpace(l) = "<n/a>"
' DriveHeader:
' h = 2
' RETURN
' calculate byte suffix
' formats a double numeric string
' check drive exists.
' returns -1 if drive not detected.
VarX = GetDriveType(VarX$)
DriveType = Nul
DriveType = "[UNKNOWN]"
DriveType = "[BADROOT]"
DriveType = "[REMOVABLE]"
DriveType = "[FIXED]"
DriveType = "[REMOTE]"
DriveType = "[CDROM]"
DriveType = "[RAMDISK]"
DRIVEEXISTS = False
DRIVEEXISTS = True
' get drive freespace
VarX$
= Var$
+ ":\" + CHR$(0) Var$ = Nul
IF DriveType
= "[REMOVABLE]" THEN r
= GetDiskFreeSpaceExA
(VarX$
, free~&&
, total~&&
, free2~&&
)
r = GetDiskFreeSpaceA(VarX$, sectors&, bytes&, free&, total&)
' sectors per cluster * bytes per sector * free clusters
' get drive totalspace
VarX$
= Var$
+ ":\" + CHR$(0) Var$ = Nul
IF DriveType
= "[REMOVABLE]" THEN r
= GetDiskFreeSpaceExA
(VarX$
, free~&&
, total~&&
, free2~&&
)
r = GetDiskFreeSpaceA(VarX$, sectors&, bytes&, free&, total&)
' sectors per cluster * bytes per sector * total clusters
' get volume label
' Note: in DOS the volume label was 8.3 format,
' however, in windows XP+ it is 32 char.
' get drive info.
VarX$
= Var$
+ ":\" + CHR$(0) Var$ = Nul
R = GetVolumeInformationA(VarX$, Vname$, MAX_PATH, serial~&, empty1~&, empty2~&, Fname$, MAX_PATH)
' get volume label.
' get volume serial number
' get drive info.
VarX$
= Var$
+ ":\" + CHR$(0) Var$ = Nul
R = GetVolumeInformationA(VarX$, Vname$, MAX_PATH, serial~&, empty1~&, empty2~&, Fname$, MAX_PATH)
' serial number.
' get volume system type
' get drive info.
VarX$
= Var$
+ ":\" + CHR$(0) Var$ = Nul
R = GetVolumeInformationA(VarX$, Vname$, MAX_PATH, serial~&, empty1~&, empty2~&, Fname$, MAX_PATH)
' get volume system type.
SUB Filtruj
(maska
AS STRING) 'prepise FileCount podle predimenzovaneho poctu zanamu do poli FileNames, FileSize, DateTimeFile a ShortNameFile. Zaznamy adresaru zustanou stejne! DIM NewFileNames
(1) AS STRING 'is for mask using. There was problem if is mask used directly, so this SUB is filtering all records in arrays for correct mask if is used. ' new = 1
FOR test
= 1 TO FileCount
FileMask$
= RIGHT$(Filenames
(test
), 4) New = New + 1
NewFileNames(New) = Filenames(test)
NewFileSize(New) = FileSize(test)
NewDateTimeFile(New) = DateTimeFile(test)
NewShortNameFile(New) = ShortNameFile(test)
'PRINT UBOUND(attrib), UBOUND(newattrib): SLEEP
'NewAttrib(New) = Attrib(DirCount + New)
FileCount = New
' REDIM Attrib(1) AS STRING
' REDIM _PRESERVE NewAttrib(UBOUND(newattrib) + DirCount) AS STRING
' FOR DirAttrib = 1 TO DirCount
' NewAttrib(DirAttrib) = Attrib(DirAttrib)
' NEXT
Filenames(ReWrite) = NewFileNames(ReWrite)
FileSize(ReWrite) = NewFileSize(ReWrite)
DateTimeFile(ReWrite) = NewDateTimeFile(ReWrite)
ShortNameFile(ReWrite) = NewShortNameFile(ReWrite)
Attrib(ReWrite) = NewAttrib(ReWrite)