dir repertoires et fichiers

Ce programme permet de récupérer le répertoire et les fichiers choisies.

Code:

 Label Sub_Ferme_Dirlist,Rep_list,Sub_open_dialog,Sub_Choix_List
  Label  Sub_Peripheriques,Disque ,Suite01
 
  Dim  DirList%,List_Dirlist%,Edit_Dirlist% ,Butt_Dirlist% ,List_File_list%
  Dim a$ ,Test% ,chaine$,Repertoire_Courant$,Long_Chaine%,Sous_Chaine$ ,i%

  DirList%                      = 2001
  List_Dirlist%                = 2002
  Edit_Dirlist%                = 2003
  Butt_Dirlist%                = 2004
  List_File_list%              = 2005
' ******************************************************************************
'                                DirList
' ******************************************************************************
Form    DirList%
left    DirList%,650
top    DirList%,240
width  DirList%,565
height  DirList%,380
caption DirList%,"Répertoires"

Command_Target_is DirList%

list    List_Dirlist%
left    List_Dirlist%,10
top    List_Dirlist%,50
width  List_Dirlist%,260
height  List_Dirlist%,230

list    List_File_list%
left    List_File_list%,280
top    List_File_list%,50
width  List_File_list%,260
height  List_File_list%,230


edit    Edit_Dirlist%
left    Edit_Dirlist%,10
top    Edit_Dirlist%,20
width  Edit_Dirlist%,500

button  Butt_Dirlist%
Left    Butt_Dirlist%,210
top    Butt_Dirlist%,285
Caption Butt_Dirlist%,"Ok"
On_Click Butt_Dirlist%,Sub_Ferme_Dirlist

' hide  DirList%
 gosub Sub_open_dialog
end
 '  Ouverture du dialogue repertoire
Sub_open_dialog:

' Numero_bouton%=Number_click

show        dirList%
Text        Edit_dirList%, Dir_Current$
Item_add    List_DirList%,".."
gosub Rep_List

on_click    List_DirList%,Sub_Choix_List

' end
return
' Affichage de la liste des répertoire a gauche et des fichiers a droites
Rep_List:
clear List_DirList%
clear List_File_List%

 item_add  List_DirList%,".."
  a$ = file_find_first$
while a$<>"_"
      Test%=File_Exists(a$)
      if Test%=0 then item_add  List_DirList%,a$
      if test%>0 then item_add  List_File_List%,a$
    a$ = file_find_next$
end_while

file_find_close
 ' Recherche des periphiques disponibles
 gosub Sub_Peripheriques
return

'  Choisir un repertoire dans la liste
Sub_Choix_List:

test%= item_Index( List_DirList%)
chaine$=item_read$ ( List_DirList%,test%)
 if  Chaine$=":" then suite01
if Chaine$=".."
chaine$=Dir_Current$
Long_Chaine%=Len(Dir_Current$)

 for i%=1 to Long_Chaine% step 1

                chaine$=left$(chaine$,long_chaine%-i%)
                Sous_Chaine$=Right$(Chaine$,1)
        if    Sous_Chaine$="\" then exit_for
 next i%
end_if

Suite01:
dir_change chaine$
Text Edit_dirList%, Dir_Current$
Repertoire_Courant$=Dir_Current$
gosub Rep_list
return

Sub_Peripheriques:

a$="A":gosub disque
a$="B":gosub disque
a$="C":gosub disque
a$="D":gosub disque
a$="E":gosub disque
a$="F":gosub disque
a$="G":gosub disque
a$="H":gosub disque
a$="I":gosub disque

return

disque:
  if disk_exists(a$)=1
        item_add  List_DirList%,a$+":"
  end_if

Return

Sub_Ferme_Dirlist:
Hide Dirlist%
Return

Pas mal, mais j'ai toujours des problèmes avec le Disk_Exists si je monte une clé usb par exemple, sur les lettres intermédiaire il me sort une erreur:
'Il n'y a pas de disque dans le lecteur. Insérez un disque dans le lecteur \Device\>Harddisk2\DR2'
Je pense que c'est une erreur Windows, pas Panoramic.

JL35

je ne serais pas te répondre. Je n'ai pas les connaissances pour.

Par contre j'aimerais insérer ton programme "récupération des dimensions d'une image" dans mon programme d'éditeur de map. car j'ai besoin des dimensions des images pour créer la fenêtre présentoire .
Si tu n'y voit pas d'inconveniant.

Hallo 659_minifly

so hatte ich mir das vorgestellt. Bravo !!
Mit Dateien Copy wäre es perfekt.

Severin


Hello 659_minifly

I had imagined. Bravo!
Copy files with it would be perfect.

Severin


Bonjour 659_minifly

je l'avais imaginé. Bravo!
Copier des fichiers avec elle, ce serait parfait.

Severin

Danke Severin
Merci

Je suis en train de coder des fonctionnalités pour les fichiers:

FILE_COPY F1$,F2$ : recopie le fichier F1$ dans le fichier F2
FILE_MOVE F1$,F2$ : déplace le fichier F1$ vers le fichier F2$

FILE_DISK$(F$) : retourne le disque sur lequel se trouve le fichier F$
FILE_PATH$(F$) : retourne le chemin (disque et répertoire) du fichier F$
FILE_EXTENSION$(F$) : retourne l'extension du fichier F$
FILE_SIZE(F$) : retourne la taille du fichier F$

FILE_READ_ONLY F$ : positionne l'attribut "lecture seule" du fichier F$
FILE_HIDE F$ : positionne l'attribut "caché" du fichier F$
FILE_SYSTEM F$ : positionne l'attribut "système" du fichier F$
FILE_ARCHIVE F$ : positionne l'attribut "archive" du fichier F$
FILE_ANY F$ : retire les attributs "lecture seule", "caché", "système", "archive" du fichier F$

FILE_DATE_CREATION$(F$) : retourne la date de création du fichier F$
FILE_DATE_ACCESS$(F$) : retourne la date du dernier accès au fichier F$
FILE_DATE_ALTERATION(F$) : retourne la date de la dernière modification du fichier F$
FILE_TIME_CREATION$(F$) : retourne l'heure de création du fichier F$
FILE_TIME_ACCESS$(F$) : retourne l'heure du dernier accès au fichier F$
FILE_TIME_ALTERATION(F$) : retourne l'heure de la dernière modification du fichier F$

C'est très bien tout ça. Encore du pain sur la planche.

Hallo Jack,

sehr gute Befehle.

File_copy $ F1, F2 $: Kopieren Sie die Datei $ file F1 F2
FILE_COPY F1$,F2$ : recopie le fichier F1$ dans le fichier F2
-------------------------------------------------------------------------------------
Diese Variante besser ????
This version better??
Cette version de mieux?

File _ Copy $ F1 : lesen der Datei
File _ Einfügen $ F1 : schreiben der Datei

File Copy _ $ F1: Read the file
File Paste _$ F1: Paste: write the file

Copie de fichiers _ $ F1: Lire le dossier
Fichier $ _ Coller F1: écrire le fichier

Jack, entschuldige meine unqualifizierten Gedanken, du bist der Meister.
Jack sorry, my unqualified thoughts, you're the master.
Jack désolé, mes pensées sans qualification, vous êtes le maître.

Merci pour votre temps de lire ceci.

Severin

Super, plus rien n'arrète Jack dans son élan Génial, j'espère que tu es encore plein d'énergie et que tu vas pouvoir continuer à ce rythme de fou Jack En tout cas, tu as les félicitations du public...

Toutes ces fonctions fichiers seront bien utiles, merci Jack !

@minifly, je ne sais plus trop de quelle fonction tu parles (récupération des dimensions d'une image), mais évidemment tu peux l'utiliser, avec ma bénédiction, puisque je considère que tout ce que je mets ici tombe dans le domaine public.

Mais néanmoins, c'est sympa d'avoir demandé.

Merci jl35

JL35

J'ai rajouté les dimensions pour les fichiers de type *.PNG

Code:

DIM f$, w%, h%, o1%, o2%, o3%, o4%, v%(10), j%, offs%, ad, er$, s$
LABEL Dimimage, reter

f$ = "E:\Rpg-Maker\12.png": ' ************** A MODIFIER *************
GOSUB Dimimage

IF er$ <> ""
    PRINT "ERREUR: " + er$
ELSE
    PRINT " " +STR$(w%) + " x " + STR$(h%)
END_IF
END

Dimimage:
' Recherche des dimensions en pixels (largeur et hauteur) d'une image f$
' aux formats Jpg, Bmp, Gif ou Tga, rendues dans w% et h%
er$ = "": s$ = UPPER$(RIGHT$(f$, 4))
FILEBIN_OPEN_READ 1, f$
IF s$ = ".JPG"
    FILEBIN_READ 1, o1%: FILEBIN_READ 1, o2%: FILEBIN_READ 1, o3%
    IF o1%<>255 OR o2%<>216 OR o3%<>255 THEN er$ = "en-tête non FFD8FF": GOTO reter
    FILEBIN_READ 1, o1%: IF o1%<>224 AND o1%<>225 THEN er$ = "pas E0 ou E1": GOTO reter
    FILEBIN_READ 1, o1%: FILEBIN_READ 1, o2%: offs% = 256*o1% + o2%: ad = 4
    ' Recherche du marqueur 'FFC0' (séquence FF C0 00 11 08 xx xx yy yy)
    REPEAT
        FILEBIN_POSITION 1, ad + offs%
        FILEBIN_READ 1, o1%: FILEBIN_READ 1, o2%: ' marqueur 'FFxx'
        ad = FILEBIN_POS(1)
        FILEBIN_READ 1, o3%: FILEBIN_READ 1, o4%: offs% = 256*o3% + o4%
    UNTIL o2% = 192
    FOR j% = 1 TO 5: FILEBIN_READ 1, v%(j%): NEXT j%
    h% = 256*v%(2) + v%(3): w% = 256*v%(4) + v%(5)
ELSE
    IF s$ = ".BMP"
        FILEBIN_POSITION 1, 18
        FOR j% = 1 TO 8: FILEBIN_READ 1, v%(j%): NEXT j%
        w% = v%(1) + 256*v%(2) + 256*256*v%(3) + 256*256*256*v%(4)
        h% = v%(5) + 256*v%(6) + 256*256*v%(7) + 256*256*256*v%(8)
    ELSE
        IF s$ = ".GIF"
            FILEBIN_POSITION 1, 6
            FOR j% = 1 TO 4: FILEBIN_READ 1, v%(j%): NEXT j%
            w% = v%(1) + 256*v%(2): h% = v%(3) + 256*v%(4)
        ELSE
            IF s$ = ".TGA"
                FILEBIN_POSITION 1, 12
                FOR j% = 1 TO 4: FILEBIN_READ 1, v%(j%): NEXT j%
                w% = v%(1) + 256*v%(2): h% = v%(3) + 256*v%(4)
        Else
            If s$=".PNG"
            FILEBIN_POSITION 1, 16
                FOR j% = 1 TO 8: FILEBIN_READ 1, v%(j%): NEXT j%
                w% = 256*v%(1) + v%(2) + 256*v%(3) + v%(4)
                h% = 256*v%(5) + v%(6) + 256*v%(7) + v%(8)
                end_if
            END_IF
        END_IF
    END_IF
END_IF
reter:
FILEBIN_CLOSE 1
RETURN

Merci minifly, je vais rajouter ça dans me archives. Je ne manipule pas en principe ce genre d'images (plutôt pour les jeux ?), mais ça peut toujours servir. Et tu pourras mettre à jour le commentaire en tête de Dimimage.

Hallo 659 minifly,
ich hatte einen Traum und habe deinem Programm noch 2 Butten zugefügt.
Wenn Jack die neuen File Befehle erstellt hat, kann er wahr werden.

Gruß Severin

I had a dream and have your program added another 2 tubs.
If Jack has created the new file commands, it can be true.

Greeting Severin

Bonjour minifly 659,
J'ai eu un rêve et d'avoir votre programme ajouté un autre deux baignoires.
Si Jack a créé le nouveau fichier de commandes, il peut être vrai.

salutation Séverin

[/code]' *** Verzeichnisauswahl *******************************************************
' ******************************************************************************
'
' *** Label definieren *********************************************************
Label Sub_Ferme_Dirlist
Label Rep_list
Label Sub_open_dialog
Label Sub_Choix_List
Label Sub_Peripheriques
Label Disque
Label Suite01
'
' *** Variable definieren ******************************************************
Dim DirList%
Dim List_Dirlist%
Dim Edit_Dirlist%
Dim Butt01_Dirlist%
Dim Butt02_Dirlist%
Dim Butt03_Dirlist%
Dim List_File_list%
Dim a$
Dim Test%
Dim chaine$
Dim Repertoire_Courant$
Dim Long_Chaine%
Dim Sous_Chaine$
Dim i%
'
' *** Fill Variable ************************************************************
DirList% = 2010
List_Dirlist% = 2020
Edit_Dirlist% = 2030
List_File_list% = 2040
'
Butt01_Dirlist% = 2050
Butt02_Dirlist% = 2051
Butt03_Dirlist% = 2052
'
' ******************************************************************************
' DirList
' ******************************************************************************
Form DirList%
left DirList%,650
top DirList%,240
width DirList%,800
height DirList%,500
caption DirList%,"Verzeichnismanager" :' "Répertoires"
'
Command_Target_is DirList%
' *** Liste links **************************************************************
'
list List_Dirlist%
left List_Dirlist%,010
top List_Dirlist%,080
width List_Dirlist%,260
height List_Dirlist%,230
'
' *** Liste rechts *************************************************************
'
list List_File_list%
left List_File_list%,280
top List_File_list%,080
width List_File_list%,260
height List_File_list%,230
'
' *** Anzeige PFAD *************************************************************
'
edit Edit_Dirlist%
left Edit_Dirlist%,010
top Edit_Dirlist%,020
width Edit_Dirlist%,525
'
' *** BUTTON "Quit" ************************************************************
'
button Butt01_Dirlist%
Left Butt01_Dirlist%,600
top Butt01_Dirlist%,400
width Butt01_Dirlist%,100
height Butt01_Dirlist%,025
Caption Butt01_Dirlist%,"Quit"
On_Click Butt01_Dirlist%,Sub_Ferme_Dirlist
'
' *** BUTTON "Copy" dieses File ************************************************
'
button Butt02_Dirlist%
Left Butt02_Dirlist%,600
top Butt02_Dirlist%,100
width Butt02_Dirlist%,100
height Butt02_Dirlist%,025
Caption Butt02_Dirlist%,"File Copy"
'
' *** BUTTON "Save" dieses File ************************************************
'
button Butt03_Dirlist%
Left Butt03_Dirlist%,600
top Butt03_Dirlist%,150
width Butt03_Dirlist%,100
height Butt03_Dirlist%,025
Caption Butt03_Dirlist%,"File Save"
'
' hide DirList%
gosub Sub_open_dialog
end
' Ouverture du dialogue repertoire
'
Sub_open_dialog:
'
' Numero_bouton%=Number_click
'
show dirList%
Text Edit_dirList%, Dir_Current$
Item_add List_DirList%,".."
gosub Rep_List
'
on_click List_DirList%,Sub_Choix_List
'
' end
return
'
' Affichage de la liste des répertoire a gauche et des fichiers a droites
Rep_List:

clear List_DirList%
clear List_File_List%

item_add List_DirList%,".."
a$ = file_find_first$
while a$<>"_"
Test%=File_Exists(a$)
if Test%=0 then item_add List_DirList%,a$
if test%>0 then item_add List_File_List%,a$
a$ = file_find_next$
end_while
'
file_find_close
'
' *** Recherche des periphiques disponibles ************************************

gosub Sub_Peripheriques
return

' Choisir un repertoire dans la liste
'
Sub_Choix_List:
'
test%= item_Index( List_DirList%)
chaine$=item_read$ ( List_DirList%,test%)
if Chaine$=":" then suite01
if Chaine$=".."
chaine$=Dir_Current$
Long_Chaine%=Len(Dir_Current$)
'
for i%=1 to Long_Chaine% step 1
'
chaine$=left$(chaine$,long_chaine%-i%)
Sous_Chaine$=Right$(Chaine$,1)
'
if Sous_Chaine$="\" then exit_for
'
next i%
'
end_if
'
' ******************************************************************************
Suite01:
'
dir_change chaine$
Text Edit_dirList%, Dir_Current$
Repertoire_Courant$=Dir_Current$
'
gosub Rep_list
'
return
'
' ******************************************************************************
Sub_Peripheriques:

a$="A":gosub disque
a$="B":gosub disque
a$="C":gosub disque
a$="D":gosub disque
a$="E":gosub disque
a$="F":gosub disque
a$="G":gosub disque
a$="H":gosub disque
a$="I":gosub disque
a$="J":gosub disque
a$="K":gosub disque
a$="L":gosub disque
a$="M":gosub disque
a$="N":gosub disque
a$="O":gosub disque
a$="P":gosub disque
a$="Q":gosub disque
a$="R":gosub disque
a$="S":gosub disque
a$="T":gosub disque
a$="U":gosub disque
a$="V":gosub disque
a$="W":gosub disque
a$="X":gosub disque
a$="Y":gosub disque
a$="Z":gosub disque
'
return
'
' ******************************************************************************
disque:
'
if disk_exists(a$)=1
item_add List_DirList%,a$+":"
end_if

Return
'
' ******************************************************************************
Sub_Ferme_Dirlist:
'
Hide Dirlist%
'
Return[code]

Danke severin

A ce niveau, dans le Sub_Peripheriques, il me paraît plus simple d'écrire:

Code:

FOR i% = ASC("A") TO ASC("Z")
    a$ = CHR$(i%): GOSUB disque
NEXT i%

(j'aime bien quand c'est court)

@Severin
les balises pour encadrer le code sont [ code ] ... [ /code ]
et non comme tu as fait [ /code ] ... [ code ]

Cela dit, si je lance le programme de Severin, tout va bien, je trouve mes disques, mais si j'insère une clé usb et que je relance le programme, j'ai toujours cette même erreur:
ce n'est pas une erreur du programme, mais une erreur de la fonction Disk_Exists à mon avis (je suis sous Windows 7 64 bits)

Ce qui est tout de même curieux, c'est qu'il me sort cette erreur si je branche une clé, pas d'erreur sinon. Mais après, j'ai beau avoir ôté la clé, ça me sort toujours la même erreur !


Autre question (minifly und Severin), pourquoi avoir défini un Form DirList% particulier et ne pas avoir utilisé le Form 0, tout simplement ? j'ai essayé (DirList% = 0, au lieu de 2010), ça marche très bien, et ça évite de faire apparaître deux fenêtre à l'écran, dont le Form 0 qui ne sert à rien en arrière-plan ? et on est obligé de fermer les deux fenêtres pour quitter.
(avec cette modif, il faut remplacer le Hide DirList% du s/p Sub_Ferme_DirList par Terminate).

De même, je trouve que ça manque un peu de couleur, j'ai ajouté
Color DirList%,128,255,255
et
Color List_DirList%,255,255,128
les fenêtres et les boutons ressortent mieux... mais ce n'est que mon avis.

Hallo JL35,
das Programm ist von 659 minifly. Ich habe nur 2 Button zugefügt,
ohne Funktion, als Traum.
1, "Copy"
2. "Save"
diese können wir dann mit dem neuen Panoramic ausführen.
Dein Problem mit dem USB-Stick werde ich am Wochenende prüfen.
Ich bin auf Dienstreise und habe nur Win 32 Bit Laptop mit.
Zu Haus habe ich 2 verschiedene PC's mit Win 64 Bit.

Gruss Severin


JL35 Hello,
The program is of 659 minifly. I have added only 2 button
without function, as a dream.
1, "Copy"
2nd "Save"
this we can then run with the new Panoramic.
Your problem with the USB stick I'll check over the weekend.
I'm on a business trip and have only Win 32 bit laptop.
At home I have 2 different PCs with Win 64 bit.

Gruss Severin.


JL35 Bonjour,
Le programme est de 659 minifly. J'ai ajouté que 2 boutons
sans fonction, comme un rêve.
1, "Copier"
2ème "Enregistrer"
cela, nous pouvons alors exécuter avec les nouvelles panoramique.
Votre problème avec la clé USB, je vais vérifier ce week-end.
Je suis en voyage d'affaires et n'ont que Win 32 bits portable.
À la maison, j'ai deux ordinateurs différents avec 64 bits Win.

Gruss Séverin

Je garde toujours le form 0 pour debug pour moi c'est plus simple

et faire un hide 0 c'est pas compliqué.

J'ai aussi windows 7 et je n'ai pas d'erreur.

Hallo JL35,
Eventuell können wir alle gemeinsam ein Kopierprogramm oder Installationsprogramm erstellen ?
Severin

Natürlich fehlt Farbe und Form 0 währe gut. Aber wie gesagt das Programm gehört 659 minifly

JL35 Hello,
Maybe we can all work together to create a copy program or installation program?
Severin

Of course, color and shape 0 is missing would be good. But as I said the program is 659 minifly

JL35 Bonjour,
Peut-être que nous pouvons tous travailler ensemble pour créer un programme de copie ou le programme d'installation?
Severin

Bien sûr, la couleur et la forme 0 est manquant serait bien. Mais comme j'ai dit que le programme est 659 minifly

Merci Severin, pour les boutons Copy et Save j'avais vu qu'ils n'étaient pas fonctionnels.

Bizarre... c'est peut-être un problème matériel sur mes prises usb, mais je n'y crois pas trop, elles fonctionnent bien pour tout le reste (et pour mes autres utilitaires qui donnent la liste des volumes montés).
Personnellement je n'aime pas trop cacher le Form 0, s'il y a un problème il faut tuer la tâche et tout relancer pour pouvoir continuer.

On s'est croisés Severin, j'ai bien vu que le programme initial est de minifly, no problem, rendons à César ce qui est à César
C'est difficile de travailler à plusieurs sur le même programme, ça risque de partir dans tous les sens.
Il vaut mieux je pense donner des idées à minifly, qui lui les mettra en pratique (ou non).

de toutes façons lorsqu'il y a un prob il faut quand même tuer la tache avec ou sans form 0.

Pour ton probleme avec clé usb ce pourrait etre une question d'installation des périphériques.
Lorsque je lance windows 7 j'ai une petite fenêtre qui s'affiche comme quoi ma clé usb et la webcam sont bien installées.
j'ai 2 ports usb
1 souris sans fil ( c'est un portable)
1 clé usb.

Pour moi c'est comme pour toi une fois sur le fofo les gens font ce qu'ils veulent avec.

D'ailleurs je ne me prive pas de développer quelque chose de mon côté en partant de ton programme mais ce n'est pas pour le mettre ici (sauf sous la torture).

Je n'ai moi non plus aucun problème avec mes périphériques amovibles, ils sont tous bien reconnus quand je les branche, clés usb, cartes mémoire, HD externes ... sauf par panoramic...

Chacun fait comme il veut. ( même la torture de la chêvre ?)

Ce sont les mystères de la clé USB et autre .

Non, pas la chèvre !

Alors quel est ton projet ?