'===========================================================================
' Subject: DOS Commands for LB and IBASIC     Date: 06-16-02 (  :  )       
'  Author: Walt Decker                        Code: pbdll                  
'  Origin: lydia2hg@yahoo.com               Packet: PBDLL.ABC
'===========================================================================
'DOSCMD32.DLL
'FUNCTION DosCmd ALIAS "Cmd"(lpCmd AS ASCIIZ) AS LONG

'USAGE:
'DOSCMD.DLL provides directory and subdirectory listings along with redirection to a file,
'default drive changing, and default directory changeing.  It does not have to be in the
'windows directory, but a full path must be provided for loading. The first return value is
'the number of files found.  Each subsequent request decreases the return value by one
'
'SYNTAX:
'lpCmd is a null-terminated string.  If redirection is not in effect, the string must be
'long enough to accomodate complete path and file name, probably between 128 and 132 characters.
'lpCmd must have the following syntax:
'DIRECTORY LISTING:
'
' DIR [path]filespec [flag(s)][options][> redirction [path]filename]
' [path], [flag(s)], [options], and [> redirection] are optional

' [path] can be a full or partial path, eg C:\MyDir, D:
' If [path] is partial the default path is used
'
'  Filespec can be any valid filename including wildcard characters (* and ?)

' [flag(s)]:
'    /s        searches sub-directories
'    /o[d][f]  sort in ascending order on path
'    /od       sort in descending order on path
'    /of       sort in ascending order on file name
'    /odf      sort in descending order on file name
'    /a        show file attributes

' [options] can be any one or a combination of +H, +S, -R, -A.
'  +H returns HIDDEN files
'  +S returns SYSTEM files
'  -R Do NOT return READ-ONLY files
'  -A Do NOT return ARCHIVE files

'  Specifiying no options will return only files that are read-only, archive
'  or normal (not archive, not hidden, not system).
'
' [> redirection] must be preceeded by ">" followed by either an optional full or partial path
' and a valid file name
'
' EXAMPLE: DIR D:*.BAS /S > c:\M$List.T$X
'          DIR C:\*.hlp /s /od /a > a:\Mylist.txt
'
' If redirection is not in effect, multiple calls to "Cmd" will return the files via lpCmd.
' The return value of each call is the number of files left.
' With multiple calls, lpCmd must evaluate to a null string.  When there are no files left,
' lpCmd will contain "Total Files = " + then number of files found and the return value will be
' zero.
' If redirection is in effect, lpCmd will return "REDIRECTION COMPLETE : Total Files =" when the
'operation is finished.

'DIRECTORY CHANGING:
'
' CD path
'
' EXAMPLE: CD D:\MyDir\MySubDir
'          CD ..\MyDir
'
'DRIVE CHANGING:
'
' drive
'
' EXAMPLE: A:
'          A
'------------------------------------------------------------------
'            IBASIC SAMPLE FOLLOWS
'------------------------------------------------------------------
'DECLARE "c:\pbdll61\61proj\doscmd32.dll",Cmd(sCmd:STRING), INT

'OPENCONSOLE
'DEF sCmd:STRING
'DEF R:INT


'DEF M:INT

'sCmd = "DIR c:\*.ini /s +s +h" + CHR$(0)
'LABEL Again
'R = Cmd(sCmd)
'sCmd = LTRIM$(RTRIM$(sCmd))
'PRINT sCmd
'sCmd = " "
'IF R = 0 THEN GOTO endit
'GOTO Again

'LABEL endit
'INPUT M
'closeconsole

'----------------------------------------------------------------------------------------------
'  FOR LibertyBASIC users, see the example code below
'----------------------------------------------------------------------------------------------
'sZero$ = CHR$(0)
'A$ = "DIR c:\pbdll60\*.inc /s/o" + sZero$
'A$ = A$ + SPACE$(128 - LEN(A$))
'OPEN "c:\liberty3\projects\doscmd32.dll" FOR DLL AS #Dos

'[AGAIN]
'calldll #Dos, "Cmd", A$ AS PTR, R AS LONG
'J = INSTR(A$, sZero$)
'IF J THEN
'    A$ = LEFT$(A$, J - 1) + MID$(A$, J + 1)
'    A$ = TRIM$(A$)
'END IF
'PRINT A$
'IF R = 0 THEN GOTO [endit]
'A$ = SPACE$(127) + sZero$
'GOTO [AGAIN]

'[endit]

'A$ = "DIR c:\pbdll60\*.inc /s/o > Temp.txt" + sZero$
'A$ = A$ + SPACE$(128 - LEN(A$))
'Calldll #Dos, "Cmd", A$ AS PTR, r AS LONG
'PRINT A$

'CLOSE #Dos

'+++++++++++++++++++++++ END OF SAMPLE CODE +++++++++++++++++++++++++

'======================= CREDITS ====================================
'FUNCTION LIBMAIN PROVIDED BY: POWERBASIC
'EQUATES PROVIDED BY: POWERBASIC in WIN32API.INC
'====================================================================
'                     PB/DLL CODE FOLLOWS
'====================================================================

'
#COMPILE DLL "DosCmd32.DLL"

%DLL_PROCESS_DETACH = 0
%DLL_PROCESS_ATTACH = 1
%DLL_THREAD_ATTACH  = 2
%DLL_THREAD_DETACH  = 3

DECLARE SUB DosDir(lpPath AS STRING, lpCount AS LONG)
DECLARE SUB DosSort(bSort AS BYTE, lCount AS LONG, Dirs() AS STRING)
DECLARE SUB Gdirs(Count AS LONG, Path AS STRING, Dirs() AS STRING)
DECLARE SUB CngDrv(lpDrive AS STRING)
DECLARE SUB CngDir(lpDir AS STRING)

DECLARE FUNCTION DosCmd ALIAS"Cmd"(lpCmd AS ASCIIZ) AS LONG

GLOBAL sZero AS STRING * 2

FUNCTION LIBMAIN (BYVAL hInstance   AS LONG, _
                  BYVAL fwdReason   AS LONG, _
                  BYVAL lpvReserved AS LONG) AS LONG


    SELECT CASE fwdReason

    CASE %DLL_PROCESS_ATTACH
        'Indicates that the DLL is being loaded by another process (a DLL
        'or EXE is loading the DLL).  DLLs can use this opportunity to
        'initialize any instance or global data, such as arrays.
        ' MSGBOX ("process attach")

         sZero = " " + CHR$(0)

         FUNCTION = 1   'success!

         'FUNCTION = 0   'failure!

    CASE %DLL_PROCESS_DETACH
        'Indicates that the DLL is being unloaded or detached from the
        'calling application.  DLLs can take this opportunity to clean
        'up all resources for all threads attached and known to the DLL.

         FUNCTION = 1   'success!

         'FUNCTION = 0   'failure!

    CASE %DLL_THREAD_ATTACH
        'Indicates that the DLL is being loaded by a new thread in the
        'calling application.  DLLs can use this opportunity to
        'initialize any thread local storage (TLS).

         FUNCTION = 1   'success!

         'FUNCTION = 0   'failure!

    CASE %DLL_THREAD_DETACH
        'Indicates that the thread is exiting cleanly.  If the DLL has
        'allocated any thread local storage, it should be released.

         FUNCTION = 1   'success!

         'FUNCTION = 0   'failure!

    END SELECT

END FUNCTION

FUNCTION DosCmd ALIAS "Cmd"(lpCmd AS ASCIIZ) EXPORT AS LONG

LOCAL sTemp AS STRING
LOCAL sCmd  AS STRING

LOCAL L AS LONG

sTemp = TRIM$(lpCmd, ANY sZero)

L = LEN(sTemp)

IF L = 0 THEN
  CALL DosDir(sTemp, L)
  lpCmd = sTemp
  DosCmd = L
  EXIT FUNCTION
END IF

IF (L = 1) OR (L = 2) THEN
  CALL CngDrv(sTemp)
  DosCmd = 1
END IF

IF L > 2 THEN
  sCmd = UCASE$(LTRIM$(LEFT$(sTemp, 3)))
  SELECT CASE sCmd
    CASE "DIR"
      L = INSTR(sTemp, " ")
      sTemp = MID$(sTemp, L + 1)
      CALL DosDir(sTemp, L)
      lpCmd = sTemp
      DosCmd = L
    CASE "CD"
      L = INSTR(sTemp, " ")
      sTemp = MID$(sTemp, L + 1)
      CALL CngDir(sTemp)
      DosCmd = 1
    CASE ELSE
      DosCmd = -2
  END SELECT
END IF
END FUNCTION

SUB DosDir(lpPath AS STRING, lpCount AS LONG)

STATIC lFCount   AS LONG, lFcntr  AS LONG

STATIC sFile() AS STRING

LOCAL bRedirect AS BYTE, bAttr AS BYTE
LOCAL bSort AS BYTE, bSubDir AS BYTE

LOCAL lAttr() AS LONG, lAtrCk() AS LONG
LOCAL DirCount AS LONG, DirCntr AS LONG

LOCAL sAray() AS STRING, sDir() AS STRING
LOCAL sTemp   AS STRING, sPMask AS STRING
LOCAL sFMask  AS STRING, sBMask AS STRING
LOCAL sRedPath AS STRING, sAttrMask AS STRING

LOCAL I AS LONG, J AS LONG, K AS LONG
LOCAL L AS LONG, M AS LONG, N AS LONG

sTemp = lpPath

sTemp = TRIM$(sTemp, ANY sZero)

IF sTemp = "" THEN GOTO DosDir_End

IF lFcount > 0 THEN
  lFcount = 0
  lFcntr = 0
  ERASE sFile()
END IF
I = 1
J = 6

REDIM lAttr(I TO J), lAtrCk(I TO J)

lAttr(1) = 1
lAttr(2) = 2
lAttr(3) = 4
lAttr(4) = 8
lAttr(5) = 16
lAttr(6) = 32

lAtrCk(1) = 1
lAtrCk(5) = 5
lAtrCk(6) = 6

'look for redirection tag. Must be last in string

I = INSTR(sTemp, ">")
IF I THEN
  bReDirect = 1
  sRedPath = TRIM$(MID$(sTemp, I + 1))
  sTemp = LEFT$(sTemp, I - 1)
END IF

'look for subdirectory search tag

I = INSTR(UCASE$(sTemp), "/S")
IF I THEN
  bSubDir = 1
  sTemp = LEFT$(sTemp, I - 1) + MID$(sTemp, I + 2)
END IF

'look for display file attributes tag

I = INSTR(UCASE$(sTemp), "/A")
IF I THEN
  bAttr = 1
  sTemp = LEFT$(sTemp, I - 1) + MID$(sTemp, I + 2)
END IF

'look for sort order tag

I = INSTR(UCASE$(sTemp), "/O")
IF I THEN
  sBMask = "/"
  MID$(sTemp, I, 1) = " "
  J = I + 1
  DO
    sFMask = UCASE$(MID$(sTemp, J, 1))
    SELECT CASE sFMask
      CASE " ", "/", ">", "+", "-"
        EXIT DO
      CASE "O", "D", "F"
        sBMask = sBMask + sFMask
        MID$(sTemp, J, 1) = " "
      CASE ELSE
        EXIT DO
    END SELECT
    INCR J
  LOOP
  SELECT CASE sBMask
    CASE "/O"
      bSort = 1
    CASE "/OF"
      bSort = 2
    CASE "/OD"
      bSort = 3
    CASE "/ODF", "/OFD"
      bSort = 4
    CASE ELSE
      bSort = 1
  END SELECT
  sBMask = ""
  sFMask = ""
END IF

J = 0
DO
  I = INSTR(-1, sTemp, "+")
  IF I = 0 THEN I = INSTR(-1, sTemp, "-")
  IF I = 0 THEN EXIT DO
  INCR J
  REDIM PRESERVE sAray(1 TO J)
  sAray(J) = MID$(sTemp, I , 2)
  sTemp = LEFT$(sTemp, I - 1) + MID$(sTemp, I + 2)
  sAray(J) = UCASE$(sAray(J))
LOOP

FOR I = 1 TO J
  IF sAray(I) = "+R" THEN lAtrCk(1) = 1
  IF sAray(I) = "+H" THEN lAtrCk(2) = 2
  IF sAray(I) = "+S" THEN lAtrCk(3) = 3
  IF sAray(I) = "+A" THEN lAtrCk(6) = 6
  IF sAray(I) = "-R" THEN lAtrCk(1) = 0
  IF sAray(I) = "-H" THEN lAtrCk(2) = 0
  IF sAray(I) = "-S" THEN lAtrCk(3) = 0
  IF sAray(I) = "-A" THEN lAtrCk(6) = 0
NEXT I

ERASE sAray

sTemp = TRIM$(sTemp)

I = INSTR(-1, sTemp, "\")
IF I THEN
  IF I = 3 THEN
    sPMask = LEFT$(sTemp, I)
    sFMask = MID$(sTemp, I + 1)
  ELSE
    sPMask = LEFT$(sTemp, I - 1)
    sFMask = MID$(sTemp, I + 1)
  END IF
ELSEIF I = 0 THEN
  I = INSTR(sTemp, ":")
  IF I THEN
    sPMask = LEFT$(sTemp, I)
    sFMask = MID$(sTemp, I + 1)
  ELSE
    sFMask = sTemp
    sPMask = CURDIR$
    IF RIGHT$(sPMask, 1) = "\" THEN
      sPMask = LEFT$(sPMask, LEN(sPMask) - 1)
    END IF
  END IF
END IF

IF bSubDir THEN
  DirCntr = 1
  REDIM sDir(DirCntr TO DirCntr)
  DirCntr = 0
  CALL GDirs(DirCount, sPMask, sDir())
END IF

sBMask = SPMask + "\" + sFMask
IF (LEN(sPMask) = 2) OR (LEN(sPMask) = 3) THEN
  sBMask = sPMask + sFMask
  IF LEN(sPMask) = 3 THEN sPMask = LEFT$(sPMask, 2)
END IF

I = 0
First_File: '

sTemp = DIR$(sBMask, 23)

IF sTemp = "" THEN GOTO Check_SubDirs

INCR I
REDIM PRESERVE sAray(1 TO I)
sAray(I) = sPMask + "\" + sTemp

DO
  sTemp = DIR$
  IF sTemp = "" THEN EXIT DO
  INCR I
  REDIM PRESERVE sAray(1 TO I)
  sAray(I) = sPMask + "\" + sTemp
LOOP

'Find_Next: '

'sTemp = DIR$
'IF sTemp <> "" THEN GOTO File_Attr

Check_SubDirs: '

IF bSubDir THEN
  IF DirCount THEN
    INCR DirCntr
    IF DirCntr > DirCount THEN GOTO File_Attr: '
    sPMask = sDir(DirCntr)
    sBMask = sDir(DirCntr) + "\" + sFMask
    GOTO First_File
  END IF
END IF

File_Attr: '

DirCntr = 0

IF bSort THEN
  CALL DosSort(bSort, I, sAray())
END IF

FOR L = 1 TO I
  sAttrMask = ""
  J = GETATTR(sAray(L))

  IF (J = 0) OR (J = 128) THEN
    sAttrMask = " Normal"
    GOTO File_Check
  END IF

  IF (J AND lAttr(5)) = lAttr(5) THEN sAttrMask = " DIRECTORY "

  FOR M = 1 TO 6
    IF M = 5 THEN GOTO Skip_Attrck
    K = lAtrCk(M)
    IF K THEN
      IF (J AND lAttr(K)) = lAttr(K) THEN
        IF K = 1 THEN sAttrMask = sAttrMask + " R "
        IF K = 2 THEN sAttrMask = sAttrMask + " H "
        IF K = 3 THEN sAttrMask = sAttrMask + " S "
        IF K = 4 THEN sAttrMask = sAttrMask + " V "
        IF K = 6 THEN sAttrMask = sAttrMask + " A "
      END IF
    END IF
Skip_Attrck: '
  NEXT M

File_Check: '

  IF sAttrMask <> "" THEN
    IF bAttr = 0 THEN
      IF INSTR(sAttrMask, "DIRECTORY") THEN
        sAttrMask = "DIRECTORY"
      ELSE
        sAttrMask = ""
      END IF
    END IF
    INCR lFcount
    REDIM PRESERVE sFile(1 TO lFcount)
    sFile(lFcount) = sAray(L) + sAttrMask
  END IF

NEXT L

DosDir_End: '

IF bReDirect THEN
  OPEN sRedPath FOR OUTPUT AS #1
  FOR I = 1 TO lFcount
    PRINT #1, sFile(I)
  NEXT I
  PRINT #1, "Total Files = " + STR$(lFcount)
  CLOSE #1
  lpPath = "REDIRECTION COMPLETE : Total Files = " + STR$(lFcount)
  lpCount = 0
ELSE
  INCR lFcntr
  IF lFcntr > lFcount THEN
    lpPath = "Total files = " + STR$(lFcount)
    lpCount = 0
  ELSE
    lpPath = sFile(lFcntr)
    lpCount = lFcount - lFcntr + 1
    EXIT SUB
  END IF
END IF

lFCount = 0
lFcntr = 0

ERASE sFile()

END SUB

SUB Gdirs(Count AS LONG, Path AS STRING, Dirs() AS STRING)

LOCAL sCurPath AS STRING
LOCAL sNewPath AS STRING
LOCAL sMask AS STRING
LOCAL sTemp AS STRING

LOCAL I AS LONG
LOCAL J AS LONG

sCurPath = CURDIR$
IF LEN(Path) = 2 THEN
  CHDIR Path
  sNewPath = CURDIR$
ELSE
  CHDIR Path
  sNewPath = CURDIR$
END IF

I = INSTR(-1, sNewPath, "\")
IF I = LEN(sNewPath) THEN
  sNewPath = LEFT$(sNewPath, I - 1)
END IF

sMask = sNewPath + "\*.*"

First_Dir: '

sTemp = DIR$(sMask, 23)
IF sTemp = "" THEN GOTO Next_Dir

Dir_Attrib: '

I = GETATTR(sNewPath + "\" + sTemp)
IF (I AND 16) = 16 THEN
  INCR Count
  REDIM PRESERVE Dirs(1 TO Count)
  Dirs(Count) = sNewPath + "\" + sTemp
END IF

sTemp = DIR$
IF sTemp <> "" THEN GOTO Dir_Attrib

Next_Dir: '

IF Count THEN
  INCR J
  IF J > Count THEN GOTO Set_Path
  sNewPath = Dirs(J)
  sMask = Dirs(J) + "\*.*"
  GOTO First_Dir
END IF

Set_Path: '

CHDRIVE LEFT$(sCurPath, 2)
CHDIR sCurPath
END SUB

SUB CngDrv(lpDrive AS STRING)

  IF LEN(lpDrive) = 1 THEN lpDrive = lpDrive + ":"
  CHDRIVE lpDrive

END SUB

SUB CngDir(lpDir AS STRING)

  CHDIR lpDir
END SUB

SUB DosSort(bSort AS BYTE, lCount AS LONG, Dirs() AS STRING)

LOCAL I AS LONG, J AS LONG

LOCAL sTag() AS STRING

DIM sTag(1 TO lCount)

IF (bSort = 1) OR (bSort = 2) THEN
  IF bSort = 1 THEN
    FOR I = 1 TO lCount
      J = INSTR(-1, Dirs(I), "\")
      sTag(I) = UCASE$(LEFT$(Dirs(I), J - 1))
    NEXT J
    ARRAY SORT sTag(), TAGARRAY Dirs()
  ELSE
    DIM sTag(lCount)
    FOR I = 1 TO lCount
      J = INSTR(-1, Dirs(I), "\")
      sTag(I) = UCASE$(MID$(Dirs(I), J + 1))
    NEXT I
    ARRAY SORT sTag(), TAGARRAY Dirs()
  END IF
  EXIT SUB
END IF

IF bSort = 3 THEN
  FOR I = 1 TO lCount
    J = INSTR(-1, Dirs(I), "\")
    sTag(I) = UCASE$(LEFT$(Dirs(I), J - 1))
  NEXT J
  ARRAY SORT sTag(), TAGARRAY Dirs(), DESCEND
ELSE
  DIM sTag(lCount)
  FOR I = 1 TO lCount
    J = INSTR(-1, Dirs(I), "\")
    sTag(I) = UCASE$(MID$(Dirs(I), J + 1))
  NEXT I
  ARRAY SORT sTag(), TAGARRAY Dirs(), DESCEND
END IF
END SUB