Un petit explorateur

LABEL Dir, Chv, Chr, Preced, Exec, Qt10, Volumes, Pathcourt, Dump, Dpa, Clkd
DIM f$, rep$, k%, nr, nf, fscr$, fvol$, fnct$, a$, b$, c$, d$, lv, lf, ld, rc$
DIM i%, ncourt$, nc$, fa$, sz, ptr, lp, hx$, ad, attr$, gil$, as$, srep$
fscr$ = "C:\Temp\Vol.vbs"
fvol$ = "C:\Temp\Volumes.txt"
fnct$ = "C:\Temp\Ncourt.vbs"
gil$ = CHR$(34)
as$ = CHR$(92)
DATA "VOLUMES": ' Script vbs pour recherche des volumes
DATA "Dim net, shell, computer, fso, WMISet,oWinnt"
DATA "Dim fst, fichier"
DATA "Set fst    = CreateObject("+gil$+"Scripting.FileSystemObject"+gil$+")"
DATA "Set fichier = fst.CreateTextFile("+gil$+fvol$+gil$+")"
DATA "Set net    = Wscript.CreateObject("+gil$+"WScript.Network"+gil$+")"
DATA "Set shell  = WScript.CreateObject("+gil$+"WScript.Shell"+gil$+")"
DATA "Set fso    = WScript.CreateObject("+gil$+"Scripting.FileSystemObject"+gil$+")"
DATA "computer = net.ComputerName"
DATA "set WMISet = GetObject("+gil$+"winmgmts:{impersonationLevel=impersonate}!//"+gil$+" & Computer).ExecQuery _"
DATA "("+gil$+"SELECT * FROM Win32_LogicalDisk"+gil$+")"
DATA "Message = "+gil$+""+gil$+" "
DATA "For each Disk in WMISet"
DATA "    Capa = Disk.Size"
DATA "    If Capa <> "+gil$+""+gil$+" Then"
DATA "        Name = Disk.VolumeName"
DATA "        If Message <> "+gil$+""+gil$+" Then Message = Message & VBCRLF"
DATA "        Message = Message & Disk.Name & "+gil$+" "+gil$+" & Name"
DATA "    End if"
DATA "Next"
DATA "fichier.WriteLine (Message)"
DATA "fichier.Close"
DATA "wscript.quit"
DATA "f"
DATA "NOMCOURT": ' Script vbs pour recherche du chemin court
DATA "IF wscript.Arguments.length > 0 Then"
DATA "  Dim stFichier 'Nom du path à convertir"
DATA "  Dim fst, fichier"
DATA "  Dim oFSO,oFl"
DATA "  Set oFSO = CreateObject("+gil$+"Scripting.FileSystemObject"+gil$+")"
DATA "  stFichier = wscript.Arguments(0)"
DATA "  If oFSO.FileExists(stFichier) Then"
DATA "    Set fst    = CreateObject("+gil$+"Scripting.FileSystemObject"+gil$+")"
DATA "    Set fichier = fst.CreateTextFile("+gil$+fvol$+gil$+")"
DATA "    Set oFl = oFSO.GetFile(stFichier)"
DATA "    fichier.WriteLine (oFl.ShortPath)"
DATA "    fichier.Close"
DATA "  End If"
DATA "End If"
DATA "wscript.quit"
DATA "f"
FILE_OPEN_WRITE 1, fscr$
READ a$: WHILE a$ <> "VOLUMES": READ a$: END_WHILE
READ a$: WHILE a$ <> "f": FILE_WRITELN 1, a$: READ a$: END_WHILE: FILE_CLOSE 1
FILE_OPEN_WRITE 1, fnct$
READ a$: WHILE a$ <> "NOMCOURT": READ a$: END_WHILE
READ a$: WHILE a$ <> "f": FILE_WRITELN 1, a$: READ a$: END_WHILE: FILE_CLOSE 1
rc$ = CHR$(13)+CHR$(10)
WIDTH 0,520: HEIGHT 0,900: COLOR 0,255,255,190
lv = 1: lf = 2: ld = 3
LIST lv: TOP lv,18: LEFT lv, 0: WIDTH lv,140: HEIGHT lv,840
FONT_NAME lv,"Lucida Console": FONT_SIZE lv,11: COLOR lv,255,255,180
ON_CLICK lv, Chv
LIST lf: TOP lf, 18: LEFT lf, WIDTH(lv):WIDTH lf,360: HEIGHT lf,HEIGHT(lv)
FONT_NAME lf,"Lucida Console": FONT_SIZE lf,11: COLOR lf,255,255,190
ON_CLICK lf, Chr
DLIST ld
BUTTON 5: TOP 5,2: LEFT 5,LEFT(lf)+4: HEIGHT 5,18: WIDTH 5,36: HIDE 5
CAPTION 5,CHR$(27): font_bold 5: font_size 5,28
ON_CLICK 5, Preced
ALPHA 6: TOP 6,0: LEFT 6,0: FONT_SIZE 6,12: FONT_BOLD 6: CAPTION 6, "    - Volumes: -"
ALPHA 7: TOP 7,2: LEFT 7, LEFT(5)+45: FONT_COLOR 7,0,0,255
' ========= FORM 'fichier' =====================================================
FORM 10: LEFT 10,LEFT(0)+30: TOP 10,TOP(0)+300: HEIGHT 10,190: WIDTH 10, 500
HIDE 10: FONT_BOLD 10: COLOR 10,200,255,200: BORDER_SMALL 10
ALPHA 11: PARENT 11,10: TOP 11,5: LEFT 11,5: FONT_NAME 11, "Lucida Console"
FONT_SIZE 11,10
BUTTON 12: PARENT 12,10: TOP 12, 80: LEFT 12,10: CAPTION 12,"Édition"
BUTTON 13: PARENT 13,10: TOP 13,TOP(12): LEFT 13,100: CAPTION 13,"Dump"
BUTTON 14: PARENT 14,10: TOP 14,TOP(12): LEFT 14,190: CAPTION 14,"Exécuter"
BUTTON 15: PARENT 15,10: TOP 15,TOP(12)+30: LEFT 15,10: CAPTION 15,"Copier"
BUTTON 16: PARENT 16,10: TOP 16,TOP(15): LEFT 16,100: CAPTION 16,"Renommer"
BUTTON 17: PARENT 17,10: TOP 17,TOP(15): LEFT 17,190: CAPTION 17,"Supprimer"
BUTTON 18: PARENT 18,10: TOP 18,TOP(12): LEFT 18,280: CAPTION 18,"Path->Clip"
BUTTON 19: PARENT 19,10: TOP 19,TOP(12)+15: LEFT 19,380: CAPTION 19,"Retour"
FOR i% = 12 TO 19: ON_CLICK i%, Qt10: NEXT i%
' ========= FORM 'Dump' ========================================================
FORM 20: WIDTH 20,610: HEIGHT 20,800: BORDER_SMALL 20: HIDE 20
COLOR 20,200,200,255
LIST 21: PARENT 21,20: TOP 21,20: WIDTH 21,WIDTH(20)-16: HEIGHT 21,HEIGHT(20)-55
FONT_NAME 21,"Lucida Console": FONT_SIZE 21,10
BUTTON 22: PARENT 22,20: LEFT 22,5: WIDTH 22,58: HEIGHT 22,20: CAPTION 22,"Début"
BUTTON 23: PARENT 23,20: LEFT 23,65: WIDTH 23,58: HEIGHT 23,20: CAPTION 23,"PgPréc."
BUTTON 24: PARENT 24,20: LEFT 24,125: WIDTH 24,58: HEIGHT 24,20: CAPTION 24,"PgSuiv."
BUTTON 25: PARENT 25,20: LEFT 25,185: WIDTH 25,58: HEIGHT 25,20: CAPTION 25,"Fin"
BUTTON 26: PARENT 26,20: WIDTH 26,60: LEFT 26,WIDTH(20)-80: HEIGHT 26,20: CAPTION 26,"Quitter"
FOR i% = 22 TO 26: ON_CLICK i%, Clkd: FONT_BOLD i%: NEXT i%

GOSUB Volumes
rep$ = "C:"+as$: GOSUB Dir

END
' ==============================================================================
Dir:
' Contenu du répertoire rep$
DIR_CHANGE rep$
CLEAR ld: CLEAR lf
IF LEN(rep$) > 4
    SHOW 5
ELSE
    HIDE 5
END_IF
f$ = FILE_FIND_FIRST$: nr = 0: nf = 0
WHILE f$ <> "_"
    IF FILE_EXISTS(f$) = 0
        ITEM_ADD ld, "D " + f$
    ELSE
        ITEM_ADD ld, "  " + f$
    END_IF
    f$ = FILE_FIND_NEXT$
END_WHILE
IF COUNT(ld) > 0
    FOR k% = 1 TO COUNT(ld)
        f$ = ITEM_READ$(ld, k%)
        IF LEFT$(f$, 2) = "D " THEN ITEM_ADD lf, f$: nr = nr + 1
    NEXT k%
    FOR k% = 1 TO COUNT(ld)
        f$ = ITEM_READ$(ld, k%)
        IF LEFT$(f$, 2) = "  " THEN ITEM_ADD lf, f$: nf = nf + 1
    NEXT k%
END_IF
CAPTION 0, rep$ + " - (" + STR$(nr) + " Répertoires, " + STR$(nf) + " Fichiers)"
CAPTION 7, rep$
RETURN
' ------------------------------------------------------------------------------
Chr:
f$ = ITEM_INDEX$(lf)
IF LEFT$(f$, 2) <> "D " THEN GOTO Exec: ' clic sur un fichier
' clic un répertoire
srep$ = rep$
IF LEN(rep$) < 4
    rep$ = rep$ + MID$(f$, 3, 100)
ELSE
    rep$ = rep$ + as$ + MID$(f$, 3, 100)
END_IF
EXECUTE_WAIT "Cmd.exe /c DIR " + rep$ + " >"+fvol$
sz = 10
IF FILE_EXISTS(fvol$)=1
    FILEBIN_OPEN_READ 1,fvol$: sz = FILEBIN_SIZE(1): FILEBIN_CLOSE 1
END_IF
IF FILE_EXISTS(fvol$) = 0 OR sz = 0
    MESSAGE "Répertoire: " + CHR$(10)+rep$+CHR$(10) + " -> accès non autorisé !"
    rep$ = srep$
    RETURN
END_IF
GOTO Dir
' ------------------------------------------------------------------------------
Preced:
' Répertoire parent (précédent)
FOR k% = LEN(rep$) TO 1 STEP -1
    IF MID$(rep$, k%, 1) = as$ THEN EXIT_FOR
NEXT k%
rep$ = LEFT$(rep$, k%-1): IF LEN(rep$)<3 THEN rep$ = rep$ + as$
GOTO Dir
RETURN
' ------------------------------------------------------------------------------
Chv:
' Nouveau volume
IF ITEM_INDEX(lv)< 2 THEN RETURN
rep$ = LEFT$(ITEM_INDEX$(lv), 2) + as$
GOTO Dir
' ------------------------------------------------------------------------------
Exec:
fa$ = TRIM$(ITEM_INDEX$(lf)): nc$ = fa$: ' fichier cliqué
a$ = "Fichier:  " + fa$ + rc$
IF RIGHT$(rep$,1) = as$
    f$ = rep$ + fa$
ELSE
    f$ = rep$ + as$ + fa$
END_IF
GOSUB Pathcourt: ' path court -> ncourt$
EXECUTE_WAIT "Cmd.exe /c DIR " +gil$+ f$ + gil$+" /A /X >" + fvol$
IF FILE_EXISTS(fvol$) = 0 THEN MESSAGE "Accès à " + f$ + " refusé !": RETURN
FILE_OPEN_READ 1, fvol$
FILE_READLN 1, b$: WHILE b$ = "" OR LEFT$(b$, 1) = " ": FILE_READLN 1, b$: END_WHILE
FILE_CLOSE 1: FILE_DELETE fvol$
c$ = LTRIM$(MID$(b$,18,18))
FOR i% = 1 TO LEN(c$)
    IF ASC(MID$(c$,i%,1))>57 THEN c$ = LEFT$(c$,i%-1)+" "+MID$(c$,i%+1,100)
NEXT i%
a$ = a$ + "Taille =  " + c$ + " octets." + rc$
a$ = a$ + "Date  =  " + LEFT$(b$, 10) + MID$(b$, 12, 6) + rc$
EXECUTE_WAIT "Cmd.exe /c ATTRIB " +gil$+ f$ + gil$+ " >" + fvol$
FILE_OPEN_READ 1, fvol$
FILE_READLN 1, b$: WHILE b$ = "" OR LEFT$(b$, 1) = " ": FILE_READLN 1, b$: END_WHILE
FILE_CLOSE 1: FILE_DELETE fvol$
attr$ = LEFT$(b$, 12)
a$ = a$ + "Attributs: " + attr$ + rc$
IF ncourt$ <> f$
    a$ = a$ + "Path court: " + ncourt$
END_IF
CAPTION 11, a$
CAPTION 10, rep$
TO_FOREGROUND 10: SHOW 10
RETURN
' ------------------------------------------------------------------------------
Qt10:
FOR i% = 12 TO 19
    IF CLICKED(i%) = 1 THEN EXIT_FOR
NEXT i%
IF i% <> 19 AND INSTR(attr$,"SH") > 0
    ' MESSAGE "Ceci est un fichier système !": HIDE 10: RETURN
END_IF
SELECT i%
    CASE 12: EXECUTE_WAIT "Notepad.exe " + gil$ + f$ + gil$
    CASE 13: GOSUB Dump
    CASE 14: EXECUTE_WAIT gil$ + f$ + gil$
    CASE 15: c$ = MESSAGE_INPUT$("COPIE (sans suppression)","Copier "+fa$+" vers:","_"): ' copier
            IF c$ <> "" AND c$ <> "_"
                ' Copie dans un répertoire, même nom, ou chemin complet
                IF DIR_EXISTS(c$) = 1: ' c'est un répertoire
                    IF RIGHT$(c$,1) = as$ THEN c$ = LEFT$(c$, LEN(c$)-1)
                    c$ = c$ + as$ + fa$
                END_IF
                FILE_COPY f$,c$
            END_IF
    CASE 16: c$ = MESSAGE_INPUT$("RENOMMER","Renommer "+fa$+" en:","_"): ' renommer
            IF c$ <> "" AND c$ <> "_" THEN FILE_RENAME f$,c$: GOSUB Dir
    CASE 17: c$ = "Voulez-vous supprimer définitivement " + fa$ + " ?"
            i% = MESSAGE_CONFIRMATION_YES_NO(c$): ' supprimer
            IF i% = 1 THEN FILE_DELETE f$: GOSUB Dir
    CASE 18: CLIPBOARD_STRING_COPY ncourt$: ' path court -> clipboard
    CASE 19: ' retour
END_SELECT
HIDE 10
RETURN
' ------------------------------------------------------------------------------
Volumes:
' Script vbs: Liste des volumes montés, avec leur nom
EXECUTE_WAIT "Wscript.exe " + fscr$: ' -> C:\Temp\Volumes.txt
CLEAR lv
ITEM_ADD lv, ""
FILE_OPEN_READ 1, fvol$
WHILE FILE_EOF(1) = 0
  FILE_READLN 1, a$: ITEM_ADD lv, a$
END_WHILE
FILE_CLOSE 1: FILE_DELETE fvol$
RETURN
' ------------------------------------------------------------------------------
Pathcourt:
' Script vbs: Récupération du chemin court d'un fichier (norme 8.3)
EXECUTE_WAIT "Wscript.exe " + fnct$ + " " + gil$ + f$ + gil$
IF FILE_EXISTS(fvol$) = 0
    ncourt$ = "(Erreur)"
ELSE
    FILE_OPEN_READ 1, fvol$: FILE_READLN 1, ncourt$: FILE_CLOSE 1
    FILE_DELETE fvol$
END_IF
RETURN
' ------------------------------------------------------------------------------
Dump:
' Dump fichier en hexadécimal
lp = 896: ptr = 0
FILEBIN_OPEN_READ 1, f$: sz = FILEBIN_SIZE(1)
CAPTION 20, f$+"  ( "+STR$(sz)+" octets = & "+HEX$(sz)+" )"
GOSUB Dpa
SHOW 20
RETURN
' ------------------------------------------------------------------------------
Dpa:
' Dump d'une page écran
IF ptr < 0 THEN ptr = 0
IF ptr > (sz-lp) THEN ptr = sz-lp
IF MOD(ptr,16) > 0 THEN ptr = ptr + 16
ptr = 16*INT(ptr/16)
FILEBIN_POSITION 1, ptr: FILEBIN_HEXA_READ 1, lp, hx$
CLEAR 21
FOR i% = 0 TO lp-1 STEP 16
    ad = ptr+i%: IF ad >= sz THEN EXIT_FOR
    a$ = RIGHT$("00000"+HEX$(ad), 6) + ": ": c$ = ""
    FOR k% = i% TO i%+15
        IF (ptr+k%) >= sz
            b$ = "__": c$ = c$ + " "
        ELSE
            b$ = MID$(hx$, k%*2+1, 2): d$ = CHR$(HEX(b$))
            IF ASC(d$) < 32
                c$ = c$ + "."
            ELSE
                c$ = c$ + d$
            END_IF
        END_IF
        a$ = a$ + b$ + " "
    NEXT k%
    ITEM_ADD 21, a$ + " " + c$
NEXT i%
RETURN
' ------------------------------------------------------------------------------
Clkd:
FOR i% = 22 TO 26
    IF CLICKED(i%) = 1 THEN EXIT_FOR
NEXT i%
FOR k% = 1 TO 1
    SELECT i%
        CASE 22: ptr = 0
        CASE 23: ptr = ptr - lp
        CASE 24: ptr = ptr + lp
        CASE 25: ptr = sz-lp
        CASE 26: FILEBIN_CLOSE 1: HIDE 20: EXIT_FOR: ' Quitter
    END_SELECT
    GOSUB Dpa
NEXT k%
RETURN
' ------------------------------------------------------------------------------