'===========================================================================
' Subject: Short to Long File Names           Date: 10-19-03 (  :  )       
'  Author: Wilbur H. Davies                   Code: QB, PDS                
'  Origin: nowhere@yahoo.com                Packet: DOS.ABC
'===========================================================================
'Wilbur H. Davis
'nowhere@yahoo.com

'Here's somethin that might be useful. It's in PDS and will run on w95, w98, and w2k 
'with FAT32 set. Don't know if it will run on ME, XP or w2k with NTFS set. 

'Basically it gets the directories on a drive and changes the SFN to LFN. Can be easily 
'adapted to get file names and do the same thing. 

'It only lists the 1st 24 directories found, but with a little enginuity I'm sure some 
'smart fella can get it to list all of em. 

DEFINT A-Z 

' Structure for INTERRUPTX 

TYPE RegTypeX 
AX AS INTEGER 
bx AS INTEGER 
CX AS INTEGER 
DX AS INTEGER 
bp AS INTEGER 
SI AS INTEGER 
DI AS INTEGER 
Flags AS INTEGER 
DS AS INTEGER 
ES AS INTEGER 
END TYPE 

' Data transfer Area, we need this and it has to be shared 

TYPE Dta0 
DTAmisc AS STRING * 21 
Attr AS STRING * 1 ' this..... 
Time AS INTEGER 
Date AS INTEGER 
Size AS LONG 
FileName AS STRING * 13 '..and this, are all we really need 
END TYPE 

TYPE Level 
Level AS INTEGER 
Open AS INTEGER 
END TYPE 

CONST COMPILER = "PDS" 

COMMON SHARED /GFiles/ DTA AS Dta0, Regs AS RegTypeX, Levl() AS Level 
COMMON SHARED /GFiles/ Drvs$(), DrvCount AS INTEGER 
COMMON SHARED /GFiles/ Folders$(), FolderCount AS INTEGER 

DECLARE SUB ABCFiles (path$, Mask$, ABCFls$(), NumFiles) 
DECLARE SUB DirList () 
DECLARE SUB GetFiles (path$, Mask$, ABCFls$(), NumFiles) 
DECLARE SUB INTERRUPTX (Intnum, InRegs AS RegTypeX, OutRegs AS RegTypeX) 
DECLARE SUB SetDTA () 
DECLARE SUB SortFiles (Sfiles$(), Num) 

DECLARE FUNCTION Drive$ (Drv AS INTEGER, Drve AS STRING) 
DECLARE FUNCTION FindFirst$ (FileSpec AS STRING, Attrib AS INTEGER, Folder AS INTEGER) 
DECLARE FUNCTION FindNext$ (FileSpec AS STRING, Attrib AS INTEGER, Folder AS INTEGER) 
DECLARE SUB GetDrives () 
DECLARE FUNCTION LongName$ (path AS STRING) 



path$ = CURDIR$ + "\" 

I = 1 
DIM D$(1 TO I) 


CALL GetFiles(path$, "*.ABC", D$(), NumABC) 

IF NumABC THEN 

FOR I = 1 TO NumABC 
PRINT LongName(path$ + D$(I)) 
NEXT I 
ELSE 

CALL DirList 

END IF 
END 

SUB DirList 

DIM BasePath AS STRING 

BasePath$ = CURDIR$ 

BasePath$ = LEFT$(BasePath$, 3) 

CALL GetDrives 

FOR I = 1 TO DrvCount 
IF Drvs$(I) + "\" = BasePath$ THEN 
Pnt = I 
EXIT FOR 
END IF 
NEXT I 

NumDirs = 1 
REDIM PRESERVE AbcDirs$(1 TO NumDirs) 
AbcDirs$(NumDirs) = Drvs$(Pnt) + "\" 

Set.DTA: ' 

CALL SetDTA 

FileName$ = FindFirst(BasePath$ + "*.*", 16, D) 

IF D < 0 THEN STOP 

IF D > 0 THEN 
NumDirs = NumDirs + 1 
REDIM PRESERVE AbcDirs$(1 TO NumDirs) 
AbcDirs$(NumDirs) = LongName(BasePath + FileName$) 
END IF 

DO 
FileName$ = FindNext("*.*", 16, D) 
IF FileName$ = "" THEN EXIT DO 
IF D < 0 THEN EXIT DO 
IF D > 0 THEN 
NumDirs = NumDirs + 1 
REDIM PRESERVE AbcDirs$(1 TO NumDirs) 
AbcDirs$(NumDirs) = LongName(BasePath + FileName$) 
END IF 
LOOP 


CALL SortFiles(AbcDirs$(), NumDirs) 

REDIM PRESERVE AbcDirs$(1 TO NumDirs + DrvCount - 2) 
J = 1 
FOR I = NumDirs TO NumDirs + DrvCount - 2 
IF J = Pnt THEN 
I = I - 1 
GOTO Next.Add 
END IF 
AbcDirs$(I) = Drvs$(J) 
Next.Add: ' 
J = J + 1 

NEXT I 

NumDirs = NumDirs + DrvCount - 2 


ListDirs: ' 

Blank$ = SPACE$(40) 
SCREEN 0 
WIDTH 80, 25 
COLOR 1, 1 

FOR I = 1 TO 24 
LOCATE I, 20 
PRINT Blank$; 
NEXT I 

Top = 1 
Bottom = 24 
Highlight = Top 
Last = Top 

COLOR 7, 1 
LOCATE Top, 21 
PRINT AbcDirs$(1) 

FOR I = Top + 1 TO Bottom 
LOCATE I, 21 
PRINT " "; MID$(AbcDirs$(I), 4); 
NEXT I 


SLEEP 


END SUB 

FUNCTION Drive$ (Drv AS INTEGER, Drve AS STRING) 

DIM D AS STRING * 2 

IF Drv = 0 THEN 
D$ = CURDIR$ 
Drive$ = D$ 
ELSE 
D$ = Drve$ 
CHDRIVE D$ 
D$ = CURDIR$ 
Drive$ = D$ 
END IF 



END FUNCTION 

FUNCTION FindFirst$ (FileSpec AS STRING, Attrib AS INTEGER, Folder AS INTEGER) 


DIM Czero AS STRING * 1 

Czero = CHR$(0) 

FileSpec$ = FileSpec$ + Czero 

Regs.AX = &H4E00 
Regs.CX = Attrib 
Regs.DS = SSEG(FileSpec$) 
Regs.DX = SADD(FileSpec$) 

CALL INTERRUPTX(&H21, Regs, Regs) 

ErrorCode = Regs.AX 

IF ErrorCode THEN 

FindFirst = "Error: " + STR$(ErrorCode) 
Folder = -1 

ELSE 

AttrCode = ASC(DTA.Attr) 

Null = INSTR(DTA.FileName, Czero) 
FindFirst = LEFT$(DTA.FileName, Null - 1) 

IF (AttrCode AND Attrib) = 16 THEN 
Folder = 1 
EXIT FUNCTION 
END IF 

Folder = 0 

END IF 


END FUNCTION 

FUNCTION FindNext$ (FileSpec AS STRING, Attrib AS INTEGER, Folder AS INTEGER) 

Regs.AX = &H4F00 

CALL INTERRUPTX(&H21, Regs, Regs) 

ErrorCode = Regs.AX 

IF ErrorCode THEN 
FindNext = "Error: " + STR$(ErrorCode) 
Folder = -1 
EXIT FUNCTION 

ELSE 

FileAttrib = ASC(DTA.Attr) 

Null = INSTR(DTA.FileName, CHR$(0)) 
FindNext = LEFT$(DTA.FileName, Null - 1) 

IF (FileAttrib AND Attrib) = Attrib THEN 
Folder = 1 
EXIT FUNCTION 
END IF 
Folder = 0 
END IF 

END FUNCTION 

SUB GetDrives 

DIM Current AS STRING * 1 

Current$ = CURDIR$ 

DrvCount = 0 
Drv1 = ASC("A") 
Drv2 = ASC("Z") 

FOR I = Drv1 TO Drv2 
Drv$ = CHR$(I) 
ON LOCAL ERROR GOTO DrvError 
CHDRIVE Drv$ 
ON LOCAL ERROR GOTO 0 
DrvCount = DrvCount + 1 
REDIM PRESERVE Drvs$(1 TO DrvCount) 
Drvs$(DrvCount) = Drv$ + ":" 

Error.Drive: ' 

NEXT I 

CHDRIVE Current$ 

EXIT SUB 

DrvError: ' 

IF ERR = 68 THEN RESUME Error.Drive 
RESUME NEXT 

END SUB 

SUB GetFiles (path$, Mask$, ABCFls$(), NumFiles) 

DIM TempMask AS STRING 

I = 1 

DIM CdeFiles$(1 TO I) 
DIM ABCFile$(1 TO I) 

IF UCASE$(Mask$) = "*.ABC" THEN 
ABCFlag = 1 
Mask$ = "*.*" 
END IF 

FlName$ = DIR$(path$ + Mask$) 

IF FlName$ <> "" THEN 
IF ABCFlag THEN GOSUB Check.ABC.Files 
END IF 

DO 
FlName$ = DIR$ 
IF FlName$ = "" THEN EXIT DO 
IF ABCFlag THEN GOSUB Check.ABC.Files 
LOOP 

IF NumCde THEN CALL SortFiles(CdeFiles$(), NumCde) 
IF NumABC THEN CALL SortFiles(ABCFile$(), NumABC) 

NumFiles = NumCde + NumABC 

IF NumFiles = 0 THEN EXIT SUB 

REDIM ABCFls$(1 TO NumFiles) 


FOR I = 1 TO NumCde 
ABCFls$(I) = CdeFiles$(I) 
NEXT I 

Cde = I 

FOR I = 1 TO NumABC 
ABCFls$(Cde) = ABCFile$(I) 
Cde = Cde + 1 
NEXT I 


EXIT SUB 

Check.ABC.Files: ' 

Abc = INSTR(FlName$, ".ABC") 

IF Abc THEN 
NumABC = NumABC + 1 
REDIM PRESERVE ABCFile$(1 TO NumABC) 
ABCFile$(NumABC) = FlName$ 
RETURN 
END IF 

Cde = INSTR(FlName$, ".CDE") 

IF Cde THEN 
NumCde = NumCde + 1 
REDIM PRESERVE CdeFiles$(1 TO NumCde) 
CdeFiles$(NumCde) = FlName$ 
RETURN 
END IF 
RETURN 

END SUB 

FUNCTION LongName$ (path AS STRING) 

DIM R1 AS RegTypeX 

te$ = path$ + CHR$(0) ' ASCIIZ terminated 
' 
D$ = STRING$(260, CHR$(255)) ' Max string len of LFN 
' 
R1.AX = &H7160 
R1.CX = 2 


R1.DS = SSEG(te$) 
R1.SI = SADD(te$) 
R1.ES = SSEG(D$) 
R1.DI = SADD(D$) 

CALL INTERRUPTX(&H21, R1, R1) ' 

I = INSTR(D$, CHR$(0)) 
D$ = LEFT$(D$, I - 1) 
LongName$ = D$ 


END FUNCTION 

SUB SetDTA 


Regs.AX = &H1A00 
Regs.DS = VARSEG(DTA) 
Regs.DX = VARPTR(DTA) 
CALL INTERRUPTX(&H21, Regs, Regs) 

END SUB 

SUB SortFiles (Sfiles$(), Num) 

FOR I = 1 TO Num - 1 

Again: ' 

IF UCASE$(Sfiles$(I)) > UCASE$(Sfiles$(I + 1)) THEN 
SWAP Sfiles$(I), Sfiles$(I + 1) 
IF I > 1 THEN 
I = I - 1 
GOTO Again 
END IF 
END IF 

NEXT I 

END SUB