Petit explorateur

' Explodir: choix d'un répertoire (ou d'un fichier)
LABEL Chv,Chrf,Cnco,Preced,Direp,Ncourt,Dirvol,Usage,Qform,Vpath,Vfich
LABEL Copfich,Colfich,Supfich,Qpath
DIM a$,i%,v$,asl$,r$,f$,ftm$,rtmp$,rtmc$,fcp$,asup%
asl$ = CHR$(92): ' antislash '\'
rtmp$ = "C:\TEMP"+asl$: ' répertoire de travail (fichiers temporaires)
IF DIR_EXISTS(rtmp$)=0 THEN DIR_MAKE rtmp$

i% = 800: IF i%>(SCREEN_Y-30) THEN i%=SCREEN_Y-30
WIDTH 0,320: HEIGHT 0,i%
BORDER_SMALL 0: FONT_NAME 0,"Arial": FONT_SIZE 0,7
COLOR 0,180,255,255
ALPHA 9: TOP 9,2: LEFT 9,20: FONT_SIZE 9,10: CAPTION 9," Volumes "
COLOR 9,255,255,0
LIST 10: TOP 10,20: WIDTH 10,100: HEIGHT 10,150: ON_CLICK 10,Chv
COLOR 10,255,255,190
BUTTON 8: TOP 8,TOP(10)+HEIGHT(10)-10: LEFT 8,10: HEIGHT 8,20: CAPTION 8,"Rafraîchir"
ON_CLICK 8,Dirvol
LIST 11: TOP 11,TOP(10): LEFT 11,LEFT(10)+WIDTH(10): WIDTH 11,200: HEIGHT 11,HEIGHT(0)-86
ON_CLICK 11,Chrf: COLOR 11,255,255,190
BUTTON 12: LEFT 12,LEFT(11): HEIGHT 12,20: FONT_NAME 12,"Wingdings": FONT_SIZE 12,10
WIDTH 12,30: CAPTION 12,CHR$(235): ON_CLICK 12,Preced: HIDE 12
ALPHA 13: TOP 13,2: LEFT 13,LEFT(10)+WIDTH(10)+30: FONT_SIZE 13,10
CAPTION 13," Répertoires ": COLOR 13,255,255,0
CHECK 15: TOP 15,2: LEFT 15,LEFT(10)+WIDTH(10)+130: WIDTH 15,70: FONT_SIZE 15,9
CAPTION 15,"+ Fichiers": COLOR 15,255,255,0: ON_CLICK 15,Direp
ALPHA 20: TOP 20,HEIGHT(0)-250: LEFT 20,1: FONT_SIZE 20,9
COLOR 20,255,255,0
a$ = "  Cliquez sur un"+CHR$(10)+"  nom d'élément"+CHR$(10)+"  pour copier son"+CHR$(10)
a$=a$+"  chemin dans le"+CHR$(10)+" presse-papier et"+CHR$(10)+"afficher ses sous-"+CHR$(10)
a$=a$+"    répertoires"+CHR$(10)+"      éventuels."
CAPTION 20,a$

ALPHA 24: TOP 24,HEIGHT(0)-100: LEFT 24,5: CAPTION 24," Copié -> clipb:  ": FONT_SIZE 24,10
COLOR 24,255,180,180
CHECK 23: TOP 23,TOP(24)+15: LEFT 23,3: CAPTION 23,"Convertir en court"
COLOR 23,255,180,180: ON_CLICK 23,Cnco

MEMO 25: TOP 25,TOP(11)+HEIGHT(11): WIDTH 25,WIDTH(0)-20: HEIGHT 25,30
COLOR 25,255,180,180

BUTTON 30: TOP 30,TOP(8)+50: LEFT 30,LEFT(8): CAPTION 30,"Usage"
ON_CLICK 30,Usage
BUTTON 32: TOP 32,TOP(30)+30: LEFT 32,LEFT(30): CAPTION 32,"Voir le chemin"
ON_CLICK 32,Vpath
CONTAINER 33: TOP 33,TOP(32)+30: WIDTH 33,WIDTH(10): HEIGHT 33,200: HIDE 33
COLOR 33,0,255,0
LIST 34: PARENT 34,33: TOP 34,4: WIDTH 34,WIDTH(33): HEIGHT 34,HEIGHT(33)-60
font_bold 34: color 34,210,255,210
BUTTON 35: PARENT 35,33: TOP 35,TOP(34)+HEIGHT(34)+1: LEFT 35,5: WIDTH 35,WIDTH(34)-10
HEIGHT 35,18: CAPTION 35,"Voir/Exec le fichier": ON_CLICK 35,Vfich
BUTTON 36: PARENT 36,33: TOP 36,TOP(35)+18: LEFT 36,LEFT(35): WIDTH 36,WIDTH(35)
HEIGHT 36,18: CAPTION 36,"Copier le fichier": ON_CLICK 36,Copfich
BUTTON 37: PARENT 37,33: TOP 37,TOP(36)+18: LEFT 37,LEFT(36): WIDTH 37,WIDTH(36)
HEIGHT 37,18: CAPTION 37,"Supprimer le fichier": ON_CLICK 37,Supfich
LIST 38: TOP 38,TOP(33): WIDTH 38,WIDTH(33): HEIGHT 38,35: HIDE 38
COLOR 38,255,200,200: FONT_SIZE 38,8: ON_CLICK 38,Colfich

FORM 40: HIDE 40: TOP 40,TOP(30)+50: LEFT 40,LEFT(30): WIDTH 40,300: HEIGHT 40,285
BORDER_HIDE 40: COLOR 40,255,0,0
FONT_NAME 40,"Calibri": FONT_SIZE 40,10: FONT_BOLD 40
CONTAINER 41: PARENT 41,40: FULL_SPACE 41
LIST 42: PARENT 42,41: LEFT 42,5: TOP 42,10: WIDTH 42,WIDTH(40)-10
HEIGHT 42,HEIGHT(40)-40: COLOR 42,255,255,0
ITEM_ADD 42,"Affichage : Répertoires seuls (<R>) ,"
ITEM_ADD 42,"                    ou répertoires + fichiers (option cochée)."
ITEM_ADD 42,"-----------------------------------------------------------------------"
ITEM_ADD 42,"      Sélection d'un élément : cliquer cet élément."
ITEM_ADD 42,"- Répertoire : affichage du contenu, + copie du"
ITEM_ADD 42,"                        chemin (path) dans le presse-papier."
ITEM_ADD 42,"- Fichier :      affichage des caractéristiques (à gauche)"
ITEM_ADD 42,"                      copie du chemin dans le presse-papier."
ITEM_ADD 42,"                      Possibilité d'affichage ou exécution du"
ITEM_ADD 42,"                      fichier, le copier, le supprimer."
ITEM_ADD 42,"-----------------------------------------------------------------------"
ITEM_ADD 42," ->  en sortie du programme,  le presse-papier"
ITEM_ADD 42,"    contient  le  chemin  complet  du  dernier"
ITEM_ADD 42,"    élément sélectionné (chemin 'court' sans espace"
ITEM_ADD 42,"    si  l'option  'Convertir en court'  est cochée)."
ITEM_ADD 42,"-----------------------------------------------------------------------"
BUTTON 43: PARENT 43,41: TOP 43,HEIGHT(41)-28: LEFT 43,WIDTH(40)/2-40
CAPTION 43,"OK": ON_CLICK 43,Qform

FORM 45: HIDE 45: TOP 45,TOP(32)+50: LEFT 45,LEFT(0): WIDTH 45,300: HEIGHT 45,40
BORDER_HIDE 45
LIST 46: PARENT 46,45: FULL_SPACE 46: ON_CLICK 46,Qpath: COLOR 46,255,255,0
FONT_NAME 46,"Consolas": FONT_SIZE 46,12: FONT_BOLD 46
BUTTON 47: PARENT 47,45: TOP 47,23: LEFT 47,150: WIDTH 47,40: HEIGHT 47,18
CAPTION 47,"OK": ON_CLICK 47,Qpath

MEMO 100: WIDTH 100,500: HIDE 100
GOSUB Dirvol
MARK_ON 15
r$ = "C:"+asl$: GOSUB Direp
END
' ==============================================================================
Chv:
r$ = LEFT$(ITEM_INDEX$(10),2)+asl$: GOSUB Direp
RETURN
' ==============================================================================
Chrf:
' Clic sur un répertoire ou fichier
HIDE 33: HIDE 40: HIDE 45
IF ITEM_READ$(11,1)="" THEN RETURN
a$ = ITEM_INDEX$(11)
IF LEFT$(a$,4) = "<R> "
    IF RIGHT$(r$,1)<>asl$ THEN r$ = r$ + asl$
    r$ = r$ + RIGHT_POS$(a$,5): GOSUB Direp
    IF fcp$ <> "" THEN SHOW 38
ELSE
    f$ = r$ + a$: TEXT 25,f$: CLIPBOARD_STRING_COPY f$
    IF CHECKED(23) = 1
        a$ = f$: GOSUB Ncourt
        TEXT 25,a$: CLIPBOARD_STRING_COPY a$
    END_IF
    CLEAR 34: ITEM_ADD 34,"Fichier :":ITEM_ADD 34,FILE_EXTRACT_NAME$(f$)
    ftm$ = rtmp$+"Infos.txt"
    FileInfos(f$,ftm$)
    FILE_OPEN_READ 1,ftm$
    WHILE FILE_EOF(1)=0
        FILE_READLN 1,a$
        IF LEFT$(a$,3)="Ext"
            ITEM_ADD 34,"Extension :": ITEM_ADD 34,"  "+RIGHT_POS$(a$,24)
        END_IF
        IF LEFT$(a$,5)="Nom e"
            ITEM_ADD 34,"Format 8.3 :": ITEM_ADD 34,"  "+RIGHT_POS$(a$,24)
        END_IF
        IF LEFT$(a$,3)="Att"
            a$ = RIGHT_POS$(a$,24)
            FOR i% = LEN(a$) TO 1 STEP -1
                IF MID$(a$,i%,1)="-" THEN a$=LEFT$(a$,i%-1)+RIGHT_POS$(a$,i%+1)
            NEXT i%
            ITEM_ADD 34,"Attribut(s) :": ITEM_ADD 34,"  "+UPPER$(a$)
        END_IF
        IF LEFT$(a$,3)="Tai"
            a$ = TRIM$(RIGHT_POS$(a$,24))
            IF LEN(a$)>3
                FOR i% = LEN(a$)-2 TO 1 STEP -3
                    a$ = LEFT$(a$,i%-1)+" "+RIGHT_POS$(a$,i%)
                NEXT i%
                a$ = TRIM$(a$)
            END_IF
            ITEM_ADD 34,"Taille (octets) :": ITEM_ADD 34,"  "+a$
        END_IF
        IF LEFT$(a$,3)="Der"
            ITEM_ADD 34,"Date dern. modif : ": ITEM_ADD 34,"  "+RIGHT_POS$(a$,24)
        END_IF
    END_WHILE
    FILE_CLOSE 1: '
    FILE_DELETE ftm$
    SHOW 33: HIDE 38
END_IF
RETURN
' ==============================================================================
Cnco:
IF CLICKED(23) = 1
    a$ = TEXT$(25)
    IF LEN(a$) > 5
        GOSUB Ncourt
        TEXT 25,a$: CLIPBOARD_STRING_COPY a$
    END_IF
END_IF
RETURN
' ==============================================================================
Preced:
' Répertoire précédent
FOR i% = LEN(r$)-1 TO 1 STEP -1
    IF MID$(r$,i%,1)=asl$ THEN EXIT_FOR
NEXT i%
r$ = LEFT$(r$,i%): GOSUB Direp
RETURN
' ==============================================================================
Direp:
HIDE 33
IF RIGHT$(r$,1)<>asl$ THEN r$ = r$ + asl$
SHOW 12: IF LEN(r$)<4 THEN HIDE 12
Dirf(r$,"*")
CLEAR 11: CLEAR 100: CLIPBOARD_PASTE 100
IF COUNT(100) > 0
    FOR i% = 1 TO COUNT(100)
        ITEM_ADD 11,ITEM_READ$(100,i%)
    NEXT i%
END_IF
CAPTION 0, r$: TEXT 25,r$: CLIPBOARD_STRING_COPY r$
IF CHECKED(23) = 1: ' conversion en chemin court
    a$ = r$: GOSUB Ncourt
    TEXT 25,a$: CLIPBOARD_STRING_COPY a$
END_IF
IF fcp$<>"" THEN SHOW 38
RETURN
' ==============================================================================
Ncourt:
ftm$ = rtmp$+"nc.bat"
FILE_OPEN_WRITE 9, ftm$
    FILE_WRITELN 9, "@echo off"
    FILE_WRITELN 9, "for %%A in ("+CHR$(34)+a$+CHR$(34)+") do echo.%%~sfA | clip"
FILE_CLOSE 9
EXECUTE_WAIT ftm$: FILE_DELETE ftm$
' suppression du espace, 0D, 0A de fin
a$=CLIPBOARD_STRING_PASTE$: a$=LEFT$(a$,LEN(a$)-3)
RETURN
' ==============================================================================
Dirvol:
Lecteurs()
CLEAR 100: CLEAR 10: CLIPBOARD_PASTE 100
FOR i% = 1 TO COUNT(100)
  v$ =ITEM_READ$(100,i%)
  ' EXECUTE_WAIT "CMD.exe /C VOL "+v$+" | clip"
  Exprog("CMD.exe /C VOL "+v$+" | clip")
  a$ = CLIPBOARD_STRING_PASTE$
  IF LEN(a$)>40
      a$ = MID$(CLIPBOARD_STRING_PASTE$,40,100)
      a$=LEFT$(a$, INSTR(a$,CHR$(13))-1)
      ITEM_ADD 10,v$+" "+a$
  END_IF
NEXT i%
IF fcp$<>"" THEN SHOW 38
RETURN
' ==============================================================================
Usage:
SHOW 40: TO_FOREGROUND 40
RETURN
' ==============================================================================
Qform:
HIDE 40
RETURN
' ==============================================================================
VPath:
a$ = CLIPBOARD_STRING_PASTE$: i% = 2*TEXT_WIDTH(a$,46): IF i%<WIDTH(0) THEN i% = WIDTH(0)
WIDTH 45,i%
CLEAR 46: ITEM_ADD 46,a$
SHOW 45: TO_FOREGROUND 45
RETURN
' ==============================================================================
Vfich:
a$ = TEXT$(25): GOSUB Ncourt
EXECUTE_WAIT CHR$(34)+a$+CHR$(34)
RETURN
' ==============================================================================
Copfich:
fcp$ = f$: ' fichier à copier
CLEAR 38
ITEM_ADD 38,"Coller le fichier :"
ITEM_ADD 38,FILE_EXTRACT_NAME$(fcp$)
RETURN
' ==============================================================================
Colfich:
IF FILE_EXISTS(fcp$)=0 THEN MESSAGE "Fichier "+fcp$+" non trouvé !": RETURN
f$ = FILE_EXTRACT_NAME$(fcp$)
IF FILE_EXISTS(r$+f$)=1 THEN FILE_DELETE r$+f$
FILE_COPY fcp$,r$+f$
IF asup% = 1
    FILE_DELETE fcp$: DIR_REMOVE rtmc$
    asup% = 0
END_IF
GOSUB Direp
HIDE 38: fcp$ = ""
RETURN
' ==============================================================================
Supfich:
i% = MESSAGE_CONFIRMATION_YES_NO("Suppression définitive de "+f$+" ?")
IF i%<>1 THEN RETURN
asup% = 0
IF f$ = fcp$
    rtmc$ = rtmp$+"U"+asl$: DIR_MAKE rtmc$
    fcp$ = rtmc$+FILE_EXTRACT_NAME$(f$): asup% = 1
    FILE_COPY f$,fcp$: ' copie provisoire
END_IF
FILE_DELETE f$
GOSUB Direp
HIDE 33
RETURN
' ==============================================================================
Qpath:
HIDE 45
RETURN
' ==============================================================================
SUB Lecteurs()
' liste des volumes actifs -> clipboard
DIM_LOCAL ret%,lect%,drv$
DLL_ON "kernel32.dll": ret% = DLL_CALL0("GetLogicalDrives")
drv$ = ""
FOR lect% = 0 TO 25
    IF BIN_AND(ret%,POWER(2,lect%))>0 THEN drv$=drv$+CHR$(65+lect%)+":"+CHR$(13)+CHR$(10)
NEXT lect%
DLL_OFF
CLIPBOARD_STRING_COPY LEFT$(drv$,LEN(drv$)-2)
END_SUB
' ==============================================================================
SUB FileInfos(f$,fr$)
' Données du fichier f$ -> fr$
DIM_LOCAL a$,fb$: fb$ = rtmp$+"Carfich.bat"
FILE_OPEN_WRITE 9,fb$
    FILE_WRITELN 9,"@echo off"
    FILE_WRITELN 9,"FOR %%? IN ("+CHR$(34)+f$+CHR$(34)+") DO ("
    FILE_WRITELN 9,"   ECHO Nom de fichier      : %%~n? >"+fr$
    FILE_WRITELN 9,"   ECHO Extension            : %%~x? >>"+fr$
    FILE_WRITELN 9,"   ECHO Nom en format 8.3    : %%~sn? >>"+fr$
    FILE_WRITELN 9,"   ECHO Attributs            : %%~a? >>"+fr$
    FILE_WRITELN 9,"   ECHO Drive                : %%~d? >>"+fr$
    FILE_WRITELN 9,"   ECHO Taille fichier      : %%~z? >>"+fr$
    FILE_WRITELN 9,"   ECHO Dernière modification: %%~t? >>"+fr$
    FILE_WRITELN 9,"   ECHO Dossier parent      : %%~dp? >>"+fr$
    FILE_WRITELN 9,"   ECHO Chemin complet      : %%~f? >>"+fr$
    FILE_WRITELN 9,"   ECHO Chemin en format 8.3 : %%~sf? >>"+fr$
    FILE_WRITELN 9,"   ECHO Emplacement dans PATH: %%~dp$PATH:? >>"+fr$
    FILE_WRITELN 9,")"
FILE_CLOSE 9
EXECUTE_WAIT fb$: FILE_DELETE fb$
END_SUB
' ==============================================================================
SUB Dirf(rep$,ext$)
' Liste des fichiers de rep$, d'extension ext$ (si ext$= "*", tous les fichiers)
' Résultat: chaîne dans le clipboard, fichiers triés, sous-répertoires en tête
' (NB: rep$ accepte les noms de répertoires contenant des espaces).
DIM_LOCAL svr$, a$, f$, ndl%, i%, nt%
ndl% = 5000: WHILE OBJECT_EXISTS(ndl%)=1: ndl%=ndl%+1000: END_WHILE
DLIST ndl%
svr$ = DIR_CURRENT$: DIR_CHANGE rep$
IF ext$<>"*" AND LEFT$(ext$,1)<>"." THEN ext$="."+ext$
ext$ = UPPER$(ext$)
nt% = 0
f$=FILE_FIND_FIRST$: WHILE f$="." OR f$="..": f$=FILE_FIND_NEXT$: END_WHILE
IF f$ = "_" THEN nt% = 1: ' répertoire vide
WHILE f$ <> "_"
    IF ext$ = "*" OR UPPER$(FILE_EXTRACT_EXTENSION$(f$)) = ext$
        IF FILE_EXISTS(f$) = 0 THEN f$ = " "+f$
        ITEM_ADD ndl%,f$
    END_IF
    f$ = FILE_FIND_NEXT$
END_WHILE
FILE_FIND_CLOSE
DIR_CHANGE svr$: ' restore le répertoire d'origine
IF nt% = 1
    ' répertoire vide
    a$ = ""
ELSE
    SORT ndl%: a$ = ""
    FOR i% = 1 TO COUNT(ndl%)
        f$ = ITEM_READ$(ndl%,i%): IF LEFT$(f$,1)=" " THEN f$="<R> "+MID$(f$,2,100)
        a$=a$+f$+CHR$(13)+CHR$(10)
    NEXT i%
    a$ = LEFT$(a$,LEN(a$)-2)
END_IF
DELETE ndl%
CLIPBOARD_STRING_COPY a$
END_SUB
' ==============================================================================
SUB Exprog(pr$)
' Exécution d'un programme externe sans la fenêtre noire Ms-DOS
' - exemple:  Exprog("Cmd.exe /c DIR C:\UTIL >C:\TEMP\Dir.txt")
DIM_LOCAL scr$, qu$: scr$ = "C:\TEMP\Vbscript.vbs": qu$ = CHR$(34)
FILE_OPEN_WRITE 9, scr$: ' ===== Création du script .vbs =====
    FILE_WRITELN 9, "CreateObject("+qu$+"Wscript.Shell"+qu$+").Run "+qu$+pr$+qu$+",0,True"
FILE_CLOSE 9
EXECUTE_WAIT "WSCRIPT.exe "+scr$: ' ===== Exécution du script =====
FILE_DELETE scr$
END_SUB
' ==============================================================================