Gestionnaire d'une librairie de fichiers

Sujet: Gestionnaire d'une librairie de fichiers Mar 26 Jan 2016 - 19:43

Je me suis amusé à réaliser un gestionnaire de librairies de fichiers. L'idée était de créer et gérer un fichier binaire dans lequel on puisse ranger tout type de fichiers, afin de pouvoir distribuer un lot entier de fichiers mais sous forme d'un seul fichier physique.

Vous me demanderez à quoi ça sert, étant donné qu'on a maintenant les commandes ARCHIVE_xxx dans Panoramic ? Pour deux raisons:
1. relever le défi technique, pour le plaisir
2. offrir autre chose que la gestion ARCHIVE de Panoramic

Le point (1) - ça ne se discute pas - c'est vraiment pour mon plaisir.

Le point (2) est plus intéressant. En effet, les commandes ARCHIVE travaillent sur un dossier entier, soit en archivage, soit en restauration. Pas question de faire du sélectif, même (et surtout !) et extraction. Et ce sont des fichiers ZIP, certes gérés partout par l'outil ZIP ou similaire, mais justement pas manipulable en profondeur par Panoramic. C'est très bien que ça existe, ça résout pas mal de problèmes, mais je voulais quelque chose de plus souple.

J'ai donc conçu un format "propriétaire" très simple, adapté à mon propos. En gros, il s'agit d'un fichier binaire dont les 3 premiers mots constituent une mini-entête ("identifiant", et un nombre de segments dans le fichier), suivi d'un "segment" par fichier mémorisé. Chaque segment est lui-même constitué d'une entête contenant un identifiant, la longueur totale du segment, la longueur du nom du fichier et le nom du fichier (terminé par un octet 0), suivi des données du fichier réel.

Toute une série d'opérations sont réalisées sur ce type de fichier librairie. Elles sont réparties en deux groupes, correspondant à des titres de menu: "Fichier" et "Segment". Je vous laisse découvrir ces différentes fonctions. La documentation complète est dans le source.

Juste un dernier mot: cette librairie peut contenir n'importe quoi: du texte, des images, des exécutables... Ce sont simplement des fichiers.

Voici le source:

Code:: ' FileLibrary.bas

' Ce programme gère une librarie de fichiers qui a la structure suivante:
' #KGF
' FLIB
' ntot (nombre total de fichiers)
' seg 1
' ...
' seg ntot
' Chaque segment a la structure:
' #SEG ou #DEL
' nseg
' lseg (longueur totale du segment sauf les deux premiers mots)
' snom (longeur du nom)
' nom (nom en ascii, terminé par un 0)
' données du segment (de longueur lseg-snom-4)
'
' Opérations:
' création librairie vide ok
' ouvrir une librairie existante ok
' fermer la librairie en cours ok
' enregistrer la librairie sous un autre nom ok
' ajouter un segnement en fin de librarie ok
' supprimer d'un segment ok
' localiser le segment numéro n ok
' localiser le segment de nom x ok
' extraire le segment localisé ok
' restaurer un segment supprimé ok
' donner la liste des segments de la librairie ok
' purger la liste des segments supprimés ok
'
' Les opérations se font sur un fichier temporaire.
' L'opération Enregistrer retourne au nom de fichier initial.
'
' La suppression d'un segment se fait en remplaçant simplement
' le marqueur du segment par #DEL. Ainsi, le contenu peut
' être récupéré.

  constantes()
  variables()
  labels()

  form0()
  menus()

  dll()

  invisibles()

  initialisations()

  end

sortir:
  if FlagModification%=1
   if message_confirmation_yes_no("Modification en cours. Sortir quand-même ?")<>1 then return
  end_if
  res% = dll_call1("KillProcessByHandle",handle(0))
  ' fini ici...

nouveau:
  nouveau()
  return

fermer:
  fermer()
  return

ouvrir:
  ouvrir()
  return

enregistrer:
  enregistrer()
  return

enregistrersous:
  enregistrersous()
  return

ajouter:
  ajouter()
  return

supprimer:
  supprimer()
  return

restaurer:
  restaurer()
  return

extraire:
  extraire()
  return

purger:
  purger()
  return

sub form0()
  caption 0,titre$
  list 101 : full_space 101 : ' width 101,200 : height 101,400
end_sub

sub constantes()
  dim kgf$ : kgf$ = "KGF.dll"
  dim NomDeTravail$ : NomDeTravail$ = dir_current$ + "\KgfFilLib_temp.kfl"
  dim titre$ : titre$ = "Librairie de fichiers"
end_sub

sub variables()
  dim res%
  dim NomDeLibrairie$, NomDeSegment$
  dim NombreDeSegments%, SegmentActuel%, AdresseActuelle%, LongueurSegment%
  dim FlagModification%, FlagOpen%
end_sub

sub dll()
  dll_on kgf$
end_sub

sub labels()
  label sortir, nouveau, fermer, ouvrir, enregistrer, enregistrersous
  label ajouter, supprimer, extraire, restaurer, purger
end_sub

sub menus()
  main_menu 1

  sub_menu 2 : parent 2,1 : caption 2,"Fichier"
   sub_menu 21 : parent 21,2 : caption 21,"Nouveau" : on_click 21,nouveau
   sub_menu 22 : parent 22,2 : caption 22,"Ouvrir..." : on_click 22,ouvrir
   sub_menu 23 : parent 23,2 : caption 23,"Fermer" : on_click 23,fermer
   sub_menu 24 : parent 24,2 : caption 24,"Enregistrer" : on_click 24,enregistrer
   sub_menu 25 : parent 25,2 : caption 25,"Enregistrer sous..." : on_click 25,enregistrersous
   sub_menu 26 : parent 26,2 : caption 26,"-"
   sub_menu 27 : parent 27,2 : caption 27,"Sortir" : on_click 27,sortir

  sub_menu 3 : parent 3,1 : caption 3,"Segment"
   sub_menu 31 : parent 31,3 : caption 31,"Ajouter" : on_click 31,ajouter
   sub_menu 32 : parent 32,3 : caption 32,"Supprimer" : on_click 32,supprimer
   sub_menu 33 : parent 33,3 : caption 33,"Extraire" : on_click 33,extraire
   sub_menu 34 : parent 34,3 : caption 34,"Restaurer" : on_click 34,restaurer
   sub_menu 35 : parent 35,3 : caption 35,"-"
   sub_menu 36 : parent 36,3 : caption 36,"Purger" : on_click 36,purger

end_sub

sub invisibles()
  open_dialog 1000
  save_dialog 1001
  dlist 1101 : ' liste des adresses des segments
  dlist 1102 : ' liste des longueurs des segments
  dlist 1103 : ' liste des adresses des données des segments
  dlist 1104 : ' liste des longueurs des données des segments
end_sub

sub initialisations()
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
end_sub

sub nouveau()
  dim_local buf$, n%
  if FlagModification%=1
   if message_confirmation_yes_no("Une modification est en cours. Créer quand-même ?")<>1 then exit_sub
  end_if
  res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
  res% = dll_call1("CreateBinaryFile",adr(NomDeTravail$))
  buf$ = "#KGFFLIB"
  res% = dll_call2("WriteStringToBinaryFile",adr(NomDeTravail$),adr(buf$))
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  n% = 0
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,9,0)
  FlagModification% = 1
  NomDeLibrairie$ = ""
  FlagOpen% = 1
  caption 0,"<nouveau> - "+titre$
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104
  NombreDeSegments% = 0
end_sub

sub fermer()
  dim_local nom$
  if FlagModification%=1
   if message_confirmation_yes_no("Modification en cours. Enregistrer ?")<>1 then exit_sub
   if NomDeLibrairie$=""
   filter 1001,"Librairie de fichiers (*.kfl)|*.kfl"
   nom$ = file_name$(1001)
   if nom$="_" then exit_sub
   if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
   if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier existe déjà. Remplacer ?")<>1 then exit_sub
   end_if
   NomDeLibrairie$ = nom$
   end_if
   res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
   if file_exists(NomDeLibrairie$)=1 then file_delete NomDeLibrairie$
   file_rename NomDeTravail$,NomDeLibrairie$
   FlagOpen% = 0
   NomDeLibrairie$ = ""
   caption 0,titre$
   FlagModification% = 0
   FlagOpen% = 0
   clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104
   NombreDeSegments% = 0
   exit_sub
  end_if
  if FlagOpen%=1 then res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  NomDeLibrairie$ = ""
  caption 0,titre$
  FlagModification% = 0
  FlagOpen% = 0
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104
  NombreDeSegments% = 0
end_sub

sub ouvrir()
  dim_local nom$, buf$, i%
  if FlagModification%=1
   message "Une modification est en cours. Veuillez fermer le fichier."
   exit_sub
  end_if
  if FlagOpen%=1 then res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  FlagOpen% = 0
  caption 0,titre$
  filter 1000,"Librairie de fichiers (*.kfl)|*.kfl"
  nom$ = file_name$(1000)
  if nom$="_" then exit_sub
  if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
  if file_exists(nom$)=0
   message "Fichier non trouvé."
   exit_sub
  end_if
  res% = dll_call1("OpenBinaryFile",adr(nom$))
  buf$ = string$(8," ")
  res% = dll_call4("ReadBlockFromBinaryFileToString",adr(nom$),8,1,adr(buf$))
  res% = dll_call1("CloseBinaryFile",adr(nom$))
  if buf$<>"#KGFFLIB"
   message "Pas une librairie valide."
   exit_sub
  end_if
  NomDeLibrairie$ = nom$
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
  file_copy NomDeLibrairie$,NomDeTravail$
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  FlagOpen% = 1
  FlagModification% = 0
  caption 0,file_extract_name$(NomDeLibrairie$)+" - "+titre$
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104
  NombreDeSegments% = 0
  ' ici, charger la liste des segments !
  ChercherPremierSegment()
  if NombreDeSegments%>1
   for i%=2 to NombreDeSegments%
   ChercherSegmentSuivant()
   next i%
  end_if
end_sub

sub enregistrer()

end_sub

sub enregistrersous()
  dim_local nom$
  filter 1001,"Librairie de fichiers (*.kfl)|*.kfl"
  nom$ = file_name$(1001)
  if nom$="_" then exit_sub
  if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
  if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier existe déjà. Remplacer ?")<>1 then exit_sub
   file_delete nom$
  end_if
  NomDeLibrairie$ = nom$
  FlagOpen% = 1
  FlagModification% = 1
  caption 0,file_extract_name$(NomDeLibrairie$)+" - "+titre$
  file_copy NomDeTravail$,NomDeLibrairie$
end_sub

sub ChercherPremierSegment()
  dim_local n%, a%, nom$, lnom%, prefix$
  prefix$ = ""
  res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,9)
  NombreDeSegments% = n%
  SegmentActuel% = 0
  if NombreDeSegments%>0
   SegmentActuel% = 1
   AdresseActuelle% = 13 : ' dépasser les 3 mots d'entête
   a% = AdresseActuelle%
   nom$ = "abcd"
   ' lire le marqueur "#SEG"
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),4,a%,adr(nom$))
   if (nom$<>"#SEG") and (nom$<>"#DEL")
   message "Librairie invalide - identifiant du premier segment"
   exit_sub
   end_if
   a% = a% + 4
   ' lire le numéro du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,a%)
   if n%<>1
   message "Librairie invalide - numéro du premier segment"
   exit_sub
   end_if
   a% = a% + 4
   ' prendre la longueur du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(LongueurSegment%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du segment
   if nom$="#DEL" then prefix$ = "<supprimé>"
   ' prendre la longueur du nom
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(lnom%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du nom
   nom$ = string$(lnom%-1," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lnom%-1,a%,adr(nom$))
   item_add 101,prefix$+" "+file_extract_name$(nom$)
   item_add 1101,str$(AdresseActuelle%)
   item_add 1102,str$(LongueurSegment%)
   item_add 1103,str$(a%+lnom%)
   item_add 1104,str$(LongueurSegment%-lnom%-4-4-1)
  end_if
end_sub

' #SEG
' nseg
' lseg (longueur totale du segment sauf les deux premiers mots)
' snom (longeur du nom)
' nom (nom en ascii, terminé par un 0)
' données du segment (de longueur lseg-snom-4)
sub ChercherSegmentSuivant()
  dim_local n%, a%, nom$, lnom%, prefix$
  prefix$ = ""
  if SegmentActuel%=NombreDeSegments% then exit_sub
  AdresseActuelle% = AdresseActuelle% + 8 + LongueurSegment%
  SegmentActuel% = SegmentActuel% + 1
   a% = AdresseActuelle%
   nom$ = "abcd"
   ' lire le marqueur "#SEG"
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),4,a%,adr(nom$))
   if (nom$<>"#SEG") and (nom$<>"#DEL")
   message "Librairie invalide - identifiant du segment "+str$(SegmentActuel%)
   exit_sub
   end_if
   a% = a% + 4
   ' lire le numéro du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,a%)
   if n%<>SegmentActuel%
   message "Librairie invalide - numéro du segment "+str$(SegmentActuel%)
   exit_sub
   end_if
   a% = a% + 4
   ' prendre la longueur du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(LongueurSegment%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du segment
   if nom$="#DEL" then prefix$ ="<supprimé>"
   ' prendre la longueur du nom
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(lnom%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du nom
   nom$ = string$(lnom%-1," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lnom%-1,a%,adr(nom$))
   item_add 101,prefix$+" "+file_extract_name$(nom$)
   item_add 1101,str$(AdresseActuelle%)
   item_add 1102,str$(LongueurSegment%)
   item_add 1103,str$(a%+lnom%)
   item_add 1104,str$(LongueurSegment%-lnom%-4-4-1)
end_sub

sub ajouter()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  filter 1000,"Textes |*.txt|Images|*.bmp;*.jpg;*.png|Tous|*.*"
  nom$ = file_name$(1000)
  if nom$="_" then exit_sub
  if file_exists(nom$)=0
   message "Fichier introuvable"
   exit_sub
  end_if
  nom1$ = file_extract_name$(nom$)
  if count(101)>0
   for i%=1 to count(101)
   if nom1$=item_read$(101,i%)
   message "Fichier déjà présent dans la librairie"
   exit_sub
   end_if
   next i%
  end_if
  res% = dll_call1("OpenBinaryFile",adr(nom$))
  siz0% = dll_call1("GetBinaryFileSize",adr(NomDeTravail$))
  siz1% = dll_call1("GetBinaryFileSize",adr(nom$))
  NombreDeSegments% = NombreDeSegments% + 1
  SegmentActuel% = NombreDeSegments%
  ' installer le marqueur "#SEG"
  AdresseActuelle% = siz0% + 1
  item_add 101,nom1$
  item_add 1101,str$(AdresseActuelle%)
  s$ = "#SEG"
' message "Ajout #SEG"
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "c"
  ' installer le numéro du nouveau segment
  a% = AdresseActuelle% + 4
  n% = SegmentActuel%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
' message "d"
  ' installer la longueur du segment
  a% = a% + 4
  n% = 4 + 4 + len(nom1$)+1 + siz1%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
   item_add 1102,str$(n%)
   item_add 1104,str$(siz1%)
' message "e"
  ' installer la longueur du nom
  a% = a% + 4
  n% = len(nom1$) + 1
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
' message "f"
  ' installer le nom du segment
  a% = a% + 4
  s$ = nom1$ + chr$(0)
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "g"
  ' installer les données du segment
  a% = a% + len(nom1$) + 1
  s$ = string$(siz1%," ")
  item_add 1103,str$(a%)
  res% = dll_call2("ReadBinaryFileToString",adr(nom$),adr(s$))
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "h"
  ' mettre le nombre total de segments à jour
  a% = 9
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(NombreDeSegments%),4,a%,0)
  FlagModification% = 1
' message "i"
  res% = dll_call1("CloseBinaryFile",adr(nom$))
end_sub

sub supprimer()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  if instr(nom$,"<supprimé>")=1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment supprimer le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  v% = asc("#")+asc("D")*256+asc("E")*256*256+asc("L")*256*256*256
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(v%),4,AdresseActuelle%,0)
  item_delete 101,ind%
  item_insert 101,ind%,"<supprimé>"
  FlagModification% = 1
end_sub

sub extraire()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, buf$, lseg%, aseg%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  if instr(nom$,"<supprimé>")=1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment extraire le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  LongueurSegment% = val(item_read$(1102,ind%))
  aseg% = val(item_read$(1103,ind%))
  lseg% = val(item_read$(1104,ind%))
  buf$ = string$(LongueurSegment%," ")
  res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lseg%,aseg%,adr(buf$))
  filter 1001,""
  nom$ = file_name$(1001)
  if nom$="_" then exit_sub
  if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier déjà existant. Remplacer ?")<>1 then exit_sub
   file_delete nom$
  end_if
  res% = dll_call2("WriteStringToBinaryFile",adr(nom$),adr(buf$))
end_sub

sub restaurer()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  if instr(nom$,"<supprimé>")<>1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment restaurer le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  v% = asc("#")+asc("S")*256+asc("E")*256*256+asc("G")*256*256*256
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(v%),4,AdresseActuelle%,0)
  item_delete 101,ind%
  item_insert 101,ind%,mid$(nom$,11,len(nom$))
  FlagModification% = 1
end_sub

sub purger()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, fil$, buf$, aout%, seg$, ns%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  n% = 0
  for i%=1 to count(101)
   nom$ = item_read$(101,i%)
   if instr(nom$,"<supprimé>")=1 then n% = n% + 1
  next i%
  if n%=0
   message "Rien à purger"
   exit_sub
  end_if
  fil$ = file_extract_path$(NomDeTravail$)+"temp_"+file_extract_name$(NomDeTravail$)
  res% = dll_call1("CreateBinaryFile",adr(fil$))
  ' installer l'identifiant
  buf$ = "#KGFFLIB"
  res% = dll_call2("WriteStringToBinaryFile",adr(fil$),adr(buf$))
  res% = dll_call1("OpenBinaryFile",adr(fil$))
  ' installer le nombre restant de segments
  n% = NombreDeSegments%-n%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(fil$),adr(n%),4,9,0)
  aout% = 13 : ' premier octet libre après l'entête
  ns% = 0
  for i%=1 to NombreDeSegments%
   if left$(item_read$(101,i%),1)<>"<"
   ' copier le segment i%
   a% = val(item_read$(1101,i%)) : ' prendre l'adresse de début du segment
   ' installer le marqueur "#SEG"
   s$ = "#SEG"
   res% = dll_call2("AppendStringToBinaryFile",adr(fil$),adr(s$))
   ' compter et installer le nouveau numéro du segment
   ns% = ns% + 1
   aout% = aout% + 4 : ' dépasser le marqueur
   res% = dll_call5("ReplaceBlockInBinaryFile",adr(fil$),adr(ns%),4,aout%,0)
   aout% = aout% + 4 : ' dépasser le numéro de segment
   a% = a% + 8 : ' dépasser le marqueur et la longueur du segment

   ' lire le segment avec son nom et ses données
   n% = val(item_read$(1102,i%))
   buf$ = string$(n%," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),n%,a%,adr(buf$))

   ' copier tout ça dans la sortie
   res% = dll_call2("AppendStringToBinaryFile",adr(fil$),adr(buf$))
   aout% = aout% + n% : ' dépasser les données copiées
   end_if
  next i%
  ' fermer tous les fichiers
  res% = dll_call1("CloseBinaryFile",adr(fil$))
  res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  ' remplacer l'ancien fichier par le nouveau
  file_delete NomDeTravail$
  file_rename fil$,NomDeTravail$
  ' recharger les tables
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104
  NombreDeSegments% = 0
  ' ici, charger la liste des segments !
  ChercherPremierSegment()
  if NombreDeSegments%>1
   for i%=2 to NombreDeSegments%
   ChercherSegmentSuivant()
   next i%
  end_if
  FlagModification% = 1
end_sub

PS

J'oubliais... prenez bien soin de charger la dernière version V5.83 du 26/01/2016 de KGF.dll...

Sujet: Re: Gestionnaire d'une librairie de fichiers Mer 27 Jan 2016 - 14:10

Je ne programme pas du tout pour le moment mais c'est super pour un jeu par exemple qui contient plein de ressources (images etc et si en plus il y avait moyen de le crypter "à chaud" se serait parfait pour rendre les données plus difficilement modifiable.

Par exemple si on stock la fiche de(s) personnage(s) dans une librairie de ce genre, les données serait trop facilement éditables (modifiables), mais ça pourrait s'appliquer à d'autres choses (chapitres d'une aventure dont vous êtes le héros), images, etc ...

C'est peut être déjà possible, je donne juste ma réaction à chaud à la lecture de cette nouveauté.

Sujet: Re: Gestionnaire d'une librairie de fichiers Mer 27 Jan 2016 - 14:17

Merci de ton appréciation, Jicehel.

Les données peuvent être rendues "confidentielles" par cryptage avant la mise en bibliothèque, et décryptés après extraction. Ce sont des fonctions disponibles dans KGF.dll (cryptage propriétaire, par double mot de passe). Le résultat est un fichier binaire qui peut être archivé comme n'importe quel fichier.

Sujet: Re: Gestionnaire d'une librairie de fichiers Mer 27 Jan 2016 - 16:51

oui tu as raison. C'est à gérer par le programme appelant comme pour toute donnée. La fonction existe donc déjà en effet.

Sujet: re Dim 31 Jan 2016 - 13:50

Si j' ai bien compris :

Tu fais la "concaténation" de fichiers sous forme de segments binaire en ajoutant un tag de début avec les infos du fichier et un tag de fin.

Question :

Lorsque tu veux supprimer un segment de ton fichier résultat, tu dois faire un fichier (ou copier dans un dlist ) avec les données de 0 à l' octet de fin du fichier précédent, et un fichier (ou copier dans un dlist ) les données placées après ce segment pour ensuite recréer un fichier de remplacement.

la manip n' est elle pas un peu longue en temps si ton fichier devient volumineux ?...

Sujet: Re: Gestionnaire d'une librairie de fichiers Dim 31 Jan 2016 - 14:01

Citation :: Tu fais la "concaténation" de fichiers sous forme de segments binaire en ajoutant un tag de début avec les infos du fichier et un tag de fin.

Presque... Il n'y a pas de tag de fin.

Code:: Lorsque tu veux supprimer un segment de ton fichier résultat, tu dois faire un fichier (ou copier dans un dlist ) avec les données de 0 à l' octet de fin du fichier précédent, et un fichier (ou copier dans un dlist ) les données placées après ce segment pour ensuite recréer un fichier de remplacement.

J'aurais pu... mais j'ai choisi un autre procédé. Pour supprimer un segment, je remplace simplement le tag "#SEG" par "#DEL". Ceci signale que le segment est supprimé. Physiquement, il reste toujours dans le fichier, et il y a une opération de restauration qui permet de revenir en arrière, sans perte d'information, sur une telle suppression. Même après une suppression, l'espace occupé par le segment en apparence supprimé reste donc occupé, et il faut une opération de purge pour produire un fichier épuré et compacté. Et cette opération s'effectue à grande vitesse, en copiant, dans l'ordre, les segments non supprimés dans un nouveau fichier, avec une seule opération d'écriture binaire par segment quelque soit sa taille. A la fin, l'ancien fichier sera supprimé et le nouveau renommé vers le nom de l'ancien.

Ainsi, les opérations sons vraiment rapides, et réversibles tant qu'on n'a pas fait l'opération de purge.

Sujet: re Dim 31 Jan 2016 - 14:15

Ok, j' ai pigé le truc.
Merci de ces précisions Klaus.

En ce moment, j' ai l' esprit occupé par l' archivage sur une clé USB.
Je scanne tous mes documents en *.pdf format qui a de multiples avantages et qui est aussi
le format dans lequel nous pouvons récupérer nos documents administratifs sur le web.
Donc 1 seul format à gérer et lisible à peu près sur toutes les machines par tout le monde.
Mais tout le monde signifie aussi des indésirables... Laughing

Ton mode d' archivage, même sans cryptage, complique déjà la tâche du curieux lambda qui
voudrait lire un document.
Wink

Sujet: Re: Gestionnaire d'une librairie de fichiers Dim 31 Jan 2016 - 14:24

Oui, bien vu, Ygeronimi !

Sujet: re Dim 31 Jan 2016 - 14:36

Je vais essayer de développer une appli (avec mot de passe et tout ce qui va avec ) en partant de ton principe pour
stocker et visualiser des documents *.pdf le reste ( impression et autres ) étant déjà géré par le visualiseur, celà simplifie
la tâche.

Suite au prochain épisode.... Laughing

Sujet: Re: Gestionnaire d'une librairie de fichiers Dim 31 Jan 2016 - 15:47

A tout hasard, voici une version de l'outil de gestion de librairie avec cryptage. Cette option est activée en cochant la ligne "Crypter" dans le menu "Segments". Elle s'applique, tant qu'elle est cochée, sur toutes les opérations "Ajout". Tous ces fichiers seront donc ajoutés en étant cryptés. Pour extraire, supprimer, restaurer ou purger, peu importe l'état de l'option "Crypter" - les segments seront traités selon leur état, décryptés automatiquement lors de l'extraction, et maintenus cryptés sinon. Le programme demandera automatiquement le mot de passe pour le cryptage. Un minimum de 6 caractères est requis, mais on peut faire une phrase complète, ajouter des chiffres, des caractères de ponctuation - plus c'est long et compliqué, mieux c'est.

Mais attention: une fois cryptés, il n'y a aucun moyen de récupérer les segments si l'on a perdu le mot de passe !

Voici cette version:

Code:: ' FileLibrary.bas

' Ce programme gère une librarie de fichiers qui a la structure suivante:
' #KGF
' FLIB
' ntot (nombre total de fichiers)
' seg 1
' ...
' seg ntot
' Chaque segment a la structure:
' #SEG ou #DEL
' nseg
' lseg (longueur totale du segment sauf les deux premiers mots)
' snom (longeur du nom)
' nom (nom en ascii, terminé par un 0)
' données du segment (de longueur lseg-snom-4)
'
' Opérations:
' création librairie vide ok
' ouvrir une librairie existante ok
' fermer la librairie en cours ok
' enregistrer la librairie sous un autre nom ok
' ajouter un segnement en fin de librarie ok
' supprimer d'un segment ok
' localiser le segment numéro n ok
' localiser le segment de nom x ok
' extraire le segment localisé ok
' restaurer un segment supprimé ok
' donner la liste des segments de la librairie ok
' purger la liste des segments supprimés ok
'
' Les opérations se font sur un fichier temporaire.
' L'opération Enregistrer retourne au nom de fichier initial.
'
' La suppression d'un segment se fait en remplaçant simplement
' le marqueur du segment par #DEL. Ainsi, le contenu peut
' être récupéré.
'
' Deux autres marqueurs de segments sont définis:
' #SEC - segment crypté
' #DEC - segment crypté et supprimé

  constantes()
  variables()
  labels()

  form0()
  menus()

  dll()

  invisibles()

  initialisations()

  end

sortir:
  if FlagModification%=1
   if message_confirmation_yes_no("Modification en cours. Sortir quand-même ?")<>1 then return
  end_if
  res% = dll_call1("KillProcessByHandle",handle(0))
  ' fini ici...

nouveau:
  nouveau()
  return

fermer:
  fermer()
  return

ouvrir:
  ouvrir()
  return

enregistrer:
  enregistrer()
  return

enregistrersous:
  enregistrersous()
  return

ajouter:
  ajouter()
  return

supprimer:
  supprimer()
  return

restaurer:
  restaurer()
  return

extraire:
  extraire()
  return

crypter:
  crypter()
  return

purger:
  purger()
  return

sub form0()
  caption 0,titre$
  list 101 : full_space 101 : ' width 101,200 : height 101,400
end_sub

sub constantes()
  dim kgf$ : kgf$ = "KGF.dll"
  dim NomDeTravail$ : NomDeTravail$ = dir_current$ + "\KgfFilLib_temp.kfl"
  dim titre$ : titre$ = "Librairie de fichiers"
  data 19,60,103,32,38,20,41,55,86,99,35,34,83,95,80,0
end_sub

sub variables()
  dim res%
  dim NomDeLibrairie$, NomDeSegment$
  dim NombreDeSegments%, SegmentActuel%, AdresseActuelle%, LongueurSegment%
  dim FlagModification%, FlagOpen%, FlagCrypter%
  dim pwd1$, pwd2$
end_sub

sub dll()
  dll_on kgf$
end_sub

sub labels()
  label sortir, nouveau, fermer, ouvrir, enregistrer, enregistrersous
  label ajouter, supprimer, extraire, restaurer, crypter, purger
end_sub

sub menus()
  main_menu 1

  sub_menu 2 : parent 2,1 : caption 2,"Fichier"
   sub_menu 21 : parent 21,2 : caption 21,"Nouveau" : on_click 21,nouveau
   sub_menu 22 : parent 22,2 : caption 22,"Ouvrir..." : on_click 22,ouvrir
   sub_menu 23 : parent 23,2 : caption 23,"Fermer" : on_click 23,fermer
   sub_menu 24 : parent 24,2 : caption 24,"Enregistrer" : on_click 24,enregistrer
   sub_menu 25 : parent 25,2 : caption 25,"Enregistrer sous..." : on_click 25,enregistrersous
   sub_menu 26 : parent 26,2 : caption 26,"-"
   sub_menu 27 : parent 27,2 : caption 27,"Sortir" : on_click 27,sortir

  sub_menu 3 : parent 3,1 : caption 3,"Segment"
   sub_menu 31 : parent 31,3 : caption 31,"Ajouter" : on_click 31,ajouter
   sub_menu 32 : parent 32,3 : caption 32,"Supprimer" : on_click 32,supprimer
   sub_menu 33 : parent 33,3 : caption 33,"Extraire" : on_click 33,extraire
   sub_menu 34 : parent 34,3 : caption 34,"Restaurer" : on_click 34,restaurer
   sub_menu 35 : parent 35,3 : caption 35,"-"
   sub_menu 36 : parent 36,3 : caption 36,"Crypter" : on_click 36,crypter
   sub_menu 37 : parent 37,3 : caption 37,"-"
   sub_menu 38 : parent 38,3 : caption 38,"Purger" : on_click 38,purger

end_sub

sub invisibles()
  open_dialog 1000
  save_dialog 1001
  dlist 1101 : ' liste des adresses des segments
  dlist 1102 : ' liste des longueurs des segments
  dlist 1103 : ' liste des adresses des données des segments
  dlist 1104 : ' liste des longueurs des données des segments
  dlist 1105 : ' liste des marques "crypté" pour les segments
end_sub

sub initialisations()
  dim_local i%, c%
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
  pwd1$ = ""
  i% = 1
  repeat
   read c%
   if c%<>0 then pwd1$ = pwd1$ + chr$(c%+17)
  until c%=0
end_sub

sub nouveau()
  dim_local buf$, n%
  if FlagModification%=1
   if message_confirmation_yes_no("Une modification est en cours. Créer quand-même ?")<>1 then exit_sub
  end_if
  res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
  res% = dll_call1("CreateBinaryFile",adr(NomDeTravail$))
  buf$ = "#KGFFLIB"
  res% = dll_call2("WriteStringToBinaryFile",adr(NomDeTravail$),adr(buf$))
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  n% = 0
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,9,0)
  FlagModification% = 1
  NomDeLibrairie$ = ""
  FlagOpen% = 1
  caption 0,"<nouveau> - "+titre$
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
  NombreDeSegments% = 0
end_sub

sub fermer()
  dim_local nom$
  if FlagModification%=1
   if message_confirmation_yes_no("Modification en cours. Enregistrer ?")<>1 then exit_sub
   if NomDeLibrairie$=""
   filter 1001,"Librairie de fichiers (*.kfl)|*.kfl"
   nom$ = file_name$(1001)
   if nom$="_" then exit_sub
   if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
   if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier existe déjà. Remplacer ?")<>1 then exit_sub
   end_if
   NomDeLibrairie$ = nom$
   end_if
   res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
   if file_exists(NomDeLibrairie$)=1 then file_delete NomDeLibrairie$
   file_rename NomDeTravail$,NomDeLibrairie$
   FlagOpen% = 0
   NomDeLibrairie$ = ""
   caption 0,titre$
   FlagModification% = 0
   FlagOpen% = 0
   clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
   NombreDeSegments% = 0
   exit_sub
  end_if
  if FlagOpen%=1 then res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  NomDeLibrairie$ = ""
  caption 0,titre$
  FlagModification% = 0
  FlagOpen% = 0
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
  NombreDeSegments% = 0
end_sub

sub ouvrir()
  dim_local nom$, buf$, i%
  if FlagModification%=1
   message "Une modification est en cours. Veuillez fermer le fichier."
   exit_sub
  end_if
  if FlagOpen%=1 then res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  FlagOpen% = 0
  caption 0,titre$
  filter 1000,"Librairie de fichiers (*.kfl)|*.kfl"
  nom$ = file_name$(1000)
  if nom$="_" then exit_sub
  if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
  if file_exists(nom$)=0
   message "Fichier non trouvé."
   exit_sub
  end_if
  res% = dll_call1("OpenBinaryFile",adr(nom$))
  buf$ = string$(8," ")
  res% = dll_call4("ReadBlockFromBinaryFileToString",adr(nom$),8,1,adr(buf$))
  res% = dll_call1("CloseBinaryFile",adr(nom$))
  if buf$<>"#KGFFLIB"
   message "Pas une librairie valide."
   exit_sub
  end_if
  NomDeLibrairie$ = nom$
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
  file_copy NomDeLibrairie$,NomDeTravail$
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  FlagOpen% = 1
  FlagModification% = 0
  caption 0,file_extract_name$(NomDeLibrairie$)+" - "+titre$
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
  NombreDeSegments% = 0
  ' ici, charger la liste des segments !
  ChercherPremierSegment()
  if NombreDeSegments%>1
   for i%=2 to NombreDeSegments%
   ChercherSegmentSuivant()
   next i%
  end_if
end_sub

sub enregistrer()

end_sub

sub enregistrersous()
  dim_local nom$
  filter 1001,"Librairie de fichiers (*.kfl)|*.kfl"
  nom$ = file_name$(1001)
  if nom$="_" then exit_sub
  if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
  if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier existe déjà. Remplacer ?")<>1 then exit_sub
   file_delete nom$
  end_if
  NomDeLibrairie$ = nom$
  FlagOpen% = 1
  FlagModification% = 1
  caption 0,file_extract_name$(NomDeLibrairie$)+" - "+titre$
  file_copy NomDeTravail$,NomDeLibrairie$
end_sub

sub ChercherPremierSegment()
  dim_local n%, a%, nom$, lnom%, prefix$, crypte%
  prefix$ = ""
  res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,9)
  NombreDeSegments% = n%
  SegmentActuel% = 0
  if NombreDeSegments%>0
   SegmentActuel% = 1
   AdresseActuelle% = 13 : ' dépasser les 3 mots d'entête
   a% = AdresseActuelle%
   nom$ = "abcd"
   ' lire le marqueur "#SEG"
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),4,a%,adr(nom$))
   if (nom$<>"#SEG") and (nom$<>"#DEL") and (nom$<>"#SEC") and (nom$<>"#DEC")
   message "Librairie invalide - identifiant du premier segment"
   exit_sub
   end_if
   crypte% = 0
   if (nom$="#SEC") or (nom$<>"#DEC") then crypte% = 1
   a% = a% + 4
   ' lire le numéro du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,a%)
   if n%<>1
   message "Librairie invalide - numéro du premier segment"
   exit_sub
   end_if
   a% = a% + 4
   ' prendre la longueur du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(LongueurSegment%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du segment
   if (nom$="#DEL") or (nom$="#DEC") then prefix$ = "<supprimé>"
   ' prendre la longueur du nom
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(lnom%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du nom
   nom$ = string$(lnom%-1," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lnom%-1,a%,adr(nom$))
   item_add 101,prefix$+" "+file_extract_name$(nom$)
   item_add 1101,str$(AdresseActuelle%)
   item_add 1102,str$(LongueurSegment%)
   item_add 1103,str$(a%+lnom%)
   item_add 1104,str$(LongueurSegment%-lnom%-4-4-1)
   item_add 1105,str$(crypte%)
  end_if
end_sub

' #SEG
' nseg
' lseg (longueur totale du segment sauf les deux premiers mots)
' snom (longeur du nom)
' nom (nom en ascii, terminé par un 0)
' données du segment (de longueur lseg-snom-4)
sub ChercherSegmentSuivant()
  dim_local n%, a%, nom$, lnom%, prefix$, crypte%
  prefix$ = ""
  if SegmentActuel%=NombreDeSegments% then exit_sub
  AdresseActuelle% = AdresseActuelle% + 8 + LongueurSegment%
  SegmentActuel% = SegmentActuel% + 1
   a% = AdresseActuelle%
   nom$ = "abcd"
   ' lire le marqueur "#SEG"
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),4,a%,adr(nom$))
   if (nom$<>"#SEG") and (nom$<>"#DEL") and (nom$<>"#SEC") and (nom$<>"#DEC")
   message "Librairie invalide - identifiant du segment "+str$(SegmentActuel%)
   exit_sub
   end_if
   crypte% = 0
   if (nom$="#SEC") or (nom$<>"#DEC") then crypte% = 1
   a% = a% + 4
   ' lire le numéro du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,a%)
   if n%<>SegmentActuel%
   message "Librairie invalide - numéro du segment "+str$(SegmentActuel%)
   exit_sub
   end_if
   a% = a% + 4
   ' prendre la longueur du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(LongueurSegment%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du segment
   if (nom$="#DEL") or (nom$="#DEC") then prefix$ ="<supprimé>"
   ' prendre la longueur du nom
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(lnom%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du nom
   nom$ = string$(lnom%-1," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lnom%-1,a%,adr(nom$))
   item_add 101,prefix$+" "+file_extract_name$(nom$)
   item_add 1101,str$(AdresseActuelle%)
   item_add 1102,str$(LongueurSegment%)
   item_add 1103,str$(a%+lnom%)
   item_add 1104,str$(LongueurSegment%-lnom%-4-4-1)
   item_add 1105,str$(crypte%)
end_sub

sub ajouter()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  filter 1000,"Textes |*.txt|Images|*.bmp;*.jpg;*.png|Tous|*.*"
  nom$ = file_name$(1000)
  if nom$="_" then exit_sub
  if file_exists(nom$)=0
   message "Fichier introuvable"
   exit_sub
  end_if
  nom1$ = file_extract_name$(nom$)
  if count(101)>0
   for i%=1 to count(101)
   if nom1$=item_read$(101,i%)
   message "Fichier déjà présent dans la librairie"
   exit_sub
   end_if
   next i%
  end_if
  if FlagCrypter%=1
   pwd2$ = message_input$("Mot de passe pour le cryptage","Mot de passe:","")
   if pwd2$="" then exit_sub
   if len(pwd2$)<6
   message "Mot de passe trop court (6 caractères minimum)"
   exit_sub
   end_if
  end_if
  res% = dll_call1("OpenBinaryFile",adr(nom$))
  siz0% = dll_call1("GetBinaryFileSize",adr(NomDeTravail$))
  siz1% = dll_call1("GetBinaryFileSize",adr(nom$))
  NombreDeSegments% = NombreDeSegments% + 1
  SegmentActuel% = NombreDeSegments%
  ' installer le marqueur "#SEG"
  AdresseActuelle% = siz0% + 1
  item_add 101,nom1$
  item_add 1101,str$(AdresseActuelle%)
  if FlagCrypter%=1
   s$ = "#SEC"
  else
   s$ = "#SEG"
  end_if
' message "Ajout #SEG"
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "c"
  ' installer le numéro du nouveau segment
  a% = AdresseActuelle% + 4
  n% = SegmentActuel%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
' message "d"
  ' installer la longueur du segment
  a% = a% + 4
  n% = 4 + 4 + len(nom1$)+1 + siz1%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
   item_add 1102,str$(n%)
   item_add 1104,str$(siz1%)
   item_add 1105,str$(FlagCrypter%)

' message "e"
  ' installer la longueur du nom
  a% = a% + 4
  n% = len(nom1$) + 1
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
' message "f"
  ' installer le nom du segment
  a% = a% + 4
  s$ = nom1$ + chr$(0)
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "g"
  ' installer les données du segment
  a% = a% + len(nom1$) + 1
  s$ = string$(siz1%," ")
  item_add 1103,str$(a%)
  if FlagCrypter%=1
   res% = dll_call1("CloseBinaryFile",adr(nom$))
   res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
   res% = dll_call1("OpenBinaryFile",adr(nom$))
  end_if
  res% = dll_call2("ReadBinaryFileToString",adr(nom$),adr(s$))
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "h"
  ' mettre le nombre total de segments à jour
  a% = 9
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(NombreDeSegments%),4,a%,0)
  FlagModification% = 1
' message "i"
  res% = dll_call1("CloseBinaryFile",adr(nom$))
  if FlagCrypter%=1
   res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
  end_if
end_sub

sub supprimer()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  if instr(nom$,"<supprimé>")=1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment supprimer le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  v% = asc("#")+asc("D")*256+asc("E")*256*256+asc("L")*256*256*256
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(v%),4,AdresseActuelle%,0)
  item_delete 101,ind%
  item_insert 101,ind%,"<supprimé>"
  FlagModification% = 1
end_sub

sub extraire()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, buf$, lseg%, aseg%
  dim_local crypte%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  if instr(nom$,"<supprimé>")=1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment extraire le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  crypte% = val(item_read$(1105,ind%))
  nom$ = file_name$(1001)
  if nom$="_" then exit_sub
  if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier déjà existant. Remplacer ?")<>1 then exit_sub
   file_delete nom$
  end_if
  pwd2$ = ""
  if crypte%=1
   pwd2$ = message_input$("Mot de passe pour le décryptage","Mot de passe:","")
   if pwd2$="" then exit_sub
   if len(pwd2$)<6
   message "Mot de passe trop court (6 caractères minimum)"
   exit_sub
   end_if
  end_if
  LongueurSegment% = val(item_read$(1102,ind%))
  aseg% = val(item_read$(1103,ind%))
  lseg% = val(item_read$(1104,ind%))
  buf$ = string$(LongueurSegment%," ")
  res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lseg%,aseg%,adr(buf$))
  filter 1001,""
  res% = dll_call2("WriteStringToBinaryFile",adr(nom$),adr(buf$))
  if Crypte%=1
   res% = dll_call1("CloseBinaryFile",adr(nom$))
   res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
   res% = dll_call1("OpenBinaryFile",adr(nom$))
  end_if
end_sub

sub restaurer()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, crypte%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  crypte% = val(item_read$(1105,ind%))
  if instr(nom$,"<supprimé>")<>1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment restaurer le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  if crypte%=1
   v% = asc("#")+asc("S")*256+asc("E")*256*256+asc("C")*256*256*256
  else
   v% = asc("#")+asc("S")*256+asc("E")*256*256+asc("G")*256*256*256
  end_if
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(v%),4,AdresseActuelle%,0)
  item_delete 101,ind%
  item_insert 101,ind%,mid$(nom$,11,len(nom$))
  FlagModification% = 1
end_sub

sub crypter()
  if FlagCrypter%=1
   FlagCrypter% = 0
   mark_off 36
  else
   FlagCrypter% = 1
   mark_on 36
  end_if
end_sub

sub purger()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, fil$, buf$, aout%, seg$, ns%, crypte%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  n% = 0
  for i%=1 to count(101)
   nom$ = item_read$(101,i%)
   if instr(nom$,"<supprimé>")=1 then n% = n% + 1
  next i%
  if n%=0
   message "Rien à purger"
   exit_sub
  end_if
  fil$ = file_extract_path$(NomDeTravail$)+"temp_"+file_extract_name$(NomDeTravail$)
  res% = dll_call1("CreateBinaryFile",adr(fil$))
  ' installer l'identifiant
  buf$ = "#KGFFLIB"
  res% = dll_call2("WriteStringToBinaryFile",adr(fil$),adr(buf$))
  res% = dll_call1("OpenBinaryFile",adr(fil$))
  ' installer le nombre restant de segments
  n% = NombreDeSegments%-n%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(fil$),adr(n%),4,9,0)
  aout% = 13 : ' premier octet libre après l'entête
  ns% = 0
  for i%=1 to NombreDeSegments%
   if left$(item_read$(101,i%),1)<>"<"
   ' copier le segment i%
   a% = val(item_read$(1101,i%)) : ' prendre l'adresse de début du segment
   crypte% = val(item_read$(1105,i%))
   ' installer le marqueur "#SEG"
   if crypt%=1
   s$ = "#SEC"
   else
   s$ = "#SEG"
   end_if
   res% = dll_call2("AppendStringToBinaryFile",adr(fil$),adr(s$))
   ' compter et installer le nouveau numéro du segment
   ns% = ns% + 1
   aout% = aout% + 4 : ' dépasser le marqueur
   res% = dll_call5("ReplaceBlockInBinaryFile",adr(fil$),adr(ns%),4,aout%,0)
   aout% = aout% + 4 : ' dépasser le numéro de segment
   a% = a% + 8 : ' dépasser le marqueur et la longueur du segment

   ' lire le segment avec son nom et ses données
   n% = val(item_read$(1102,i%))
   buf$ = string$(n%," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),n%,a%,adr(buf$))

   ' copier tout ça dans la sortie
   res% = dll_call2("AppendStringToBinaryFile",adr(fil$),adr(buf$))
   aout% = aout% + n% : ' dépasser les données copiées
   end_if
  next i%
  ' fermer tous les fichiers
  res% = dll_call1("CloseBinaryFile",adr(fil$))
  res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  ' remplacer l'ancien fichier par le nouveau
  file_delete NomDeTravail$
  file_rename fil$,NomDeTravail$
  ' recharger les tables
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104
  NombreDeSegments% = 0
  ' ici, charger la liste des segments !
  ChercherPremierSegment()
  if NombreDeSegments%>1
   for i%=2 to NombreDeSegments%
   ChercherSegmentSuivant()
   next i%
  end_if
  FlagModification% = 1
end_sub

EDIT

Pour information:
Le cryptage est effectué par la fonction crypter de KGF.dll. Elle utilise un double mot de passe. Le premier est codé en dur dans le programme, mais sous forme de data cryptés également, afin qu'il ne sois pas visible facilement. Le second doit être saisi pour chaque opération d'ajout en mode crypté, et pour chaque extraction.

Attention:
Le programme n'effectue aucun test sur le mot de passe. et en particulier, lors de l'extraction, le segment visé sera décrypté avec le mote de passe fourni lors du décryptage. Si ce mot de passe est différent du mot de passe utilisé lors du cryptage, il n'y aura aucun message d'erreur, puisque le programme n'a aucun moyen de connaître le bon mot de passe. Simplement, le contenu décrypté sera inutilisable.

Sujet: re Dim 31 Jan 2016 - 17:06

Merci Klaus.
Je vais voir pour qu' il y ait un "Disclaimer" à l' ouverture de l' application.
un mot de passe sera demandé.
le mot de passe sera stocké dans un fichier param.inf crypté que seul l' appli pourra crypté ou décrypté
Si le mot de pass est correct, l' appli décryptera le ou les fichiers
A la fermeture, l' appli recryptera automatiquement les fichiers

A la création, une adresse mail sera demandé et en cas d' oubli, le mot de passe pourra être envoyé sur cette adresse.
le tout étant que le mail envoyé soit invisible à l' écran scratch

Vois tu mon idée ?.... Laughing

Sujet: Re: Gestionnaire d'une librairie de fichiers Dim 31 Jan 2016 - 17:31

Ton idée est bonne. C'est une façon comme une autre de faire - tu seul connais le contexte de ton application. Mais oui, c'est jouable !

Voici une version légèrement corrigée et améliorée. Elle élimine un petit bug et affiche la mention "(crypté)" à côté du nom des fichiers.

Code:: ' FileLibrary.bas

' Ce programme gère une librarie de fichiers qui a la structure suivante:
' #KGF
' FLIB
' ntot (nombre total de fichiers)
' seg 1
' ...
' seg ntot
' Chaque segment a la structure:
' #SEG ou #DEL
' nseg
' lseg (longueur totale du segment sauf les deux premiers mots)
' snom (longeur du nom)
' nom (nom en ascii, terminé par un 0)
' données du segment (de longueur lseg-snom-4)
'
' Opérations:
' création librairie vide ok
' ouvrir une librairie existante ok
' fermer la librairie en cours ok
' enregistrer la librairie sous un autre nom ok
' ajouter un segnement en fin de librarie ok
' supprimer d'un segment ok
' localiser le segment numéro n ok
' localiser le segment de nom x ok
' extraire le segment localisé ok
' restaurer un segment supprimé ok
' donner la liste des segments de la librairie ok
' purger la liste des segments supprimés ok
'
' Les opérations se font sur un fichier temporaire.
' L'opération Enregistrer retourne au nom de fichier initial.
'
' La suppression d'un segment se fait en remplaçant simplement
' le marqueur du segment par #DEL. Ainsi, le contenu peut
' être récupéré.
'
' Deux autres marqueurs de segments sont définis:
' #SEC - segment crypté
' #DEC - segment crypté et supprimé

constantes()
variables()
labels()

form0()
menus()

dll()

invisibles()

initialisations()

end

sortir:
if FlagModification%=1
if message_confirmation_yes_no("Modification en cours. Sortir quand-même ?")<>1 then return
end_if
res% = dll_call1("KillProcessByHandle",handle(0))
' fini ici...

nouveau:
nouveau()
return

fermer:
fermer()
return

ouvrir:
ouvrir()
return

enregistrer:
enregistrer()
return

enregistrersous:
enregistrersous()
return

ajouter:
ajouter()
return

supprimer:
supprimer()
return

restaurer:
restaurer()
return

extraire:
extraire()
return

crypter:
crypter()
return

purger:
purger()
return

sub form0()
caption 0,titre$
list 101 : full_space 101 : ' width 101,200 : height 101,400
end_sub

sub constantes()
dim kgf$ : kgf$ = "KGF.dll"
dim NomDeTravail$ : NomDeTravail$ = dir_current$ + "\KgfFilLib_temp.kfl"
dim titre$ : titre$ = "Librairie de fichiers"
data 19,60,103,32,38,20,41,55,86,99,35,34,83,95,80,0
end_sub

sub variables()
dim res%
dim NomDeLibrairie$, NomDeSegment$
dim NombreDeSegments%, SegmentActuel%, AdresseActuelle%, LongueurSegment%
dim FlagModification%, FlagOpen%, FlagCrypter%
dim pwd1$, pwd2$
end_sub

sub dll()
dll_on kgf$
end_sub

sub labels()
label sortir, nouveau, fermer, ouvrir, enregistrer, enregistrersous
label ajouter, supprimer, extraire, restaurer, crypter, purger
end_sub

sub menus()
main_menu 1

sub_menu 2 : parent 2,1 : caption 2,"Fichier"
sub_menu 21 : parent 21,2 : caption 21,"Nouveau" : on_click 21,nouveau
sub_menu 22 : parent 22,2 : caption 22,"Ouvrir..." : on_click 22,ouvrir
sub_menu 23 : parent 23,2 : caption 23,"Fermer" : on_click 23,fermer
sub_menu 24 : parent 24,2 : caption 24,"Enregistrer" : on_click 24,enregistrer
sub_menu 25 : parent 25,2 : caption 25,"Enregistrer sous..." : on_click 25,enregistrersous
sub_menu 26 : parent 26,2 : caption 26,"-"
sub_menu 27 : parent 27,2 : caption 27,"Sortir" : on_click 27,sortir

sub_menu 3 : parent 3,1 : caption 3,"Segment"
sub_menu 31 : parent 31,3 : caption 31,"Ajouter" : on_click 31,ajouter
sub_menu 32 : parent 32,3 : caption 32,"Supprimer" : on_click 32,supprimer
sub_menu 33 : parent 33,3 : caption 33,"Extraire" : on_click 33,extraire
sub_menu 34 : parent 34,3 : caption 34,"Restaurer" : on_click 34,restaurer
sub_menu 35 : parent 35,3 : caption 35,"-"
sub_menu 36 : parent 36,3 : caption 36,"Crypter" : on_click 36,crypter
sub_menu 37 : parent 37,3 : caption 37,"-"
sub_menu 38 : parent 38,3 : caption 38,"Purger" : on_click 38,purger

end_sub

sub invisibles()
open_dialog 1000
save_dialog 1001
dlist 1101 : ' liste des adresses des segments
dlist 1102 : ' liste des longueurs des segments
dlist 1103 : ' liste des adresses des données des segments
dlist 1104 : ' liste des longueurs des données des segments
dlist 1105 : ' liste des marques "crypté" pour les segments
end_sub

sub initialisations()
dim_local i%, c%
if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
pwd1$ = ""
i% = 1
repeat
read c%
if c%<>0 then pwd1$ = pwd1$ + chr$(c%+17)
until c%=0
end_sub

sub nouveau()
dim_local buf$, n%
if FlagModification%=1
if message_confirmation_yes_no("Une modification est en cours. Créer quand-même ?")<>1 then exit_sub
end_if
res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
res% = dll_call1("CreateBinaryFile",adr(NomDeTravail$))
buf$ = "#KGFFLIB"
res% = dll_call2("WriteStringToBinaryFile",adr(NomDeTravail$),adr(buf$))
res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
n% = 0
res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,9,0)
FlagModification% = 1
NomDeLibrairie$ = ""
FlagOpen% = 1
caption 0,"<nouveau> - "+titre$
clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
NombreDeSegments% = 0
end_sub

sub fermer()
dim_local nom$
if FlagModification%=1
if message_confirmation_yes_no("Modification en cours. Enregistrer ?")<>1 then exit_sub
if NomDeLibrairie$=""
filter 1001,"Librairie de fichiers (*.kfl)|*.kfl"
nom$ = file_name$(1001)
if nom$="_" then exit_sub
if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
if file_exists(nom$)=1
if message_confirmation_yes_no("Fichier existe déjà. Remplacer ?")<>1 then exit_sub
end_if
NomDeLibrairie$ = nom$
end_if
res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
if file_exists(NomDeLibrairie$)=1 then file_delete NomDeLibrairie$
file_rename NomDeTravail$,NomDeLibrairie$
FlagOpen% = 0
NomDeLibrairie$ = ""
caption 0,titre$
FlagModification% = 0
FlagOpen% = 0
clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
NombreDeSegments% = 0
exit_sub
end_if
if FlagOpen%=1 then res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
NomDeLibrairie$ = ""
caption 0,titre$
FlagModification% = 0
FlagOpen% = 0
clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
NombreDeSegments% = 0
end_sub

sub ouvrir()
dim_local nom$, buf$, i%
if FlagModification%=1
message "Une modification est en cours. Veuillez fermer le fichier."
exit_sub
end_if
if FlagOpen%=1 then res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
FlagOpen% = 0
caption 0,titre$
filter 1000,"Librairie de fichiers (*.kfl)|*.kfl"
nom$ = file_name$(1000)
if nom$="_" then exit_sub
if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
if file_exists(nom$)=0
message "Fichier non trouvé."
exit_sub
end_if
res% = dll_call1("OpenBinaryFile",adr(nom$))
buf$ = string$(8," ")
res% = dll_call4("ReadBlockFromBinaryFileToString",adr(nom$),8,1,adr(buf$))
res% = dll_call1("CloseBinaryFile",adr(nom$))
if buf$<>"#KGFFLIB"
message "Pas une librairie valide."
exit_sub
end_if
NomDeLibrairie$ = nom$
if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
file_copy NomDeLibrairie$,NomDeTravail$
res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
FlagOpen% = 1
FlagModification% = 0
caption 0,file_extract_name$(NomDeLibrairie$)+" - "+titre$
clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
NombreDeSegments% = 0
' ici, charger la liste des segments !
ChercherPremierSegment()
if NombreDeSegments%>1
for i%=2 to NombreDeSegments%
ChercherSegmentSuivant()
next i%
end_if
end_sub

sub enregistrer()

end_sub

sub enregistrersous()
dim_local nom$
filter 1001,"Librairie de fichiers (*.kfl)|*.kfl"
nom$ = file_name$(1001)
if nom$="_" then exit_sub
if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
if file_exists(nom$)=1
if message_confirmation_yes_no("Fichier existe déjà. Remplacer ?")<>1 then exit_sub
file_delete nom$
end_if
NomDeLibrairie$ = nom$
FlagOpen% = 1
FlagModification% = 1
caption 0,file_extract_name$(NomDeLibrairie$)+" - "+titre$
file_copy NomDeTravail$,NomDeLibrairie$
end_sub

sub ChercherPremierSegment()
dim_local n%, a%, nom$, lnom%, prefix$, crypte%
prefix$ = ""
res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,9)
NombreDeSegments% = n%
SegmentActuel% = 0
if NombreDeSegments%>0
SegmentActuel% = 1
AdresseActuelle% = 13 : ' dépasser les 3 mots d'entête
a% = AdresseActuelle%
nom$ = "abcd"
' lire le marqueur "#SEG"
res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),4,a%,adr(nom$))
if (nom$<>"#SEG") and (nom$<>"#DEL") and (nom$<>"#SEC") and (nom$<>"#DEC")
message "Librairie invalide - identifiant du premier segment"
exit_sub
end_if
crypte% = 0
if (nom$="#SEC") or (nom$="#DEC") then crypte% = 1
a% = a% + 4
' lire le numéro du segment
res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,a%)
if n%<>1
message "Librairie invalide - numéro du premier segment"
exit_sub
end_if
a% = a% + 4
' prendre la longueur du segment
res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(LongueurSegment%),4,a%)
a% = a% + 4 : ' dépasser la longueur du segment
if (nom$="#DEL") or (nom$="#DEC") then prefix$ = "<supprimé>"
' prendre la longueur du nom
res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(lnom%),4,a%)
a% = a% + 4 : ' dépasser la longueur du nom
nom$ = string$(lnom%-1," ")
res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lnom%-1,a%,adr(nom$))
if crypte%=1
item_add 101,prefix$+" "+file_extract_name$(nom$)+" (crypté)"
else
item_add 101,prefix$+" "+file_extract_name$(nom$)
end_if
item_add 1101,str$(AdresseActuelle%)
item_add 1102,str$(LongueurSegment%)
item_add 1103,str$(a%+lnom%)
item_add 1104,str$(LongueurSegment%-lnom%-4-4-1)
item_add 1105,str$(crypte%)
end_if
end_sub

' #SEG
' nseg
' lseg (longueur totale du segment sauf les deux premiers mots)
' snom (longeur du nom)
' nom (nom en ascii, terminé par un 0)
' données du segment (de longueur lseg-snom-4)
sub ChercherSegmentSuivant()
dim_local n%, a%, nom$, lnom%, prefix$, crypte%
prefix$ = ""
if SegmentActuel%=NombreDeSegments% then exit_sub
AdresseActuelle% = AdresseActuelle% + 8 + LongueurSegment%
SegmentActuel% = SegmentActuel% + 1
a% = AdresseActuelle%
nom$ = "abcd"
' lire le marqueur "#SEG"
res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),4,a%,adr(nom$))
if (nom$<>"#SEG") and (nom$<>"#DEL") and (nom$<>"#SEC") and (nom$<>"#DEC")
message "Librairie invalide - identifiant du segment "+str$(SegmentActuel%)
exit_sub
end_if
crypte% = 0
if (nom$="#SEC") or (nom$="#DEC") then crypte% = 1
a% = a% + 4
' lire le numéro du segment
res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,a%)
if n%<>SegmentActuel%
message "Librairie invalide - numéro du segment "+str$(SegmentActuel%)
exit_sub
end_if
a% = a% + 4
' prendre la longueur du segment
res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(LongueurSegment%),4,a%)
a% = a% + 4 : ' dépasser la longueur du segment
if (nom$="#DEL") or (nom$="#DEC") then prefix$ ="<supprimé>"
' prendre la longueur du nom
res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(lnom%),4,a%)
a% = a% + 4 : ' dépasser la longueur du nom
nom$ = string$(lnom%-1," ")
res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lnom%-1,a%,adr(nom$))
if crypte%=1
item_add 101,prefix$+" "+file_extract_name$(nom$)+" (crypté)"
else
item_add 101,prefix$+" "+file_extract_name$(nom$)
end_if
item_add 1101,str$(AdresseActuelle%)
item_add 1102,str$(LongueurSegment%)
item_add 1103,str$(a%+lnom%)
item_add 1104,str$(LongueurSegment%-lnom%-4-4-1)
item_add 1105,str$(crypte%)
end_sub

sub ajouter()
dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, nomc$
if FlagOpen%=0
message "Aucune librairie ouverte"
exit_sub
end_if
filter 1000,"Textes |*.txt|Images|*.bmp;*.jpg;*.png|Tous|*.*"
nom$ = file_name$(1000)
if nom$="_" then exit_sub
if file_exists(nom$)=0
message "Fichier introuvable"
exit_sub
end_if
nom1$ = file_extract_name$(nom$)
if count(101)>0
for i%=1 to count(101)
nomc$=item_read$(101,i%)
if right$(nomc$,9)=" (crypté)" then nomc$ = left$(nomc$,len(nomc$) - 9)
if nom1$=nomc$
message "Fichier déjà présent dans la librairie"
exit_sub
end_if
next i%
end_if
if FlagCrypter%=1
pwd2$ = message_input$("Mot de passe pour le cryptage","Mot de passe:","")
if pwd2$="" then exit_sub
if len(pwd2$)<6
message "Mot de passe trop court (6 caractères minimum)"
exit_sub
end_if
end_if
res% = dll_call1("OpenBinaryFile",adr(nom$))
siz0% = dll_call1("GetBinaryFileSize",adr(NomDeTravail$))
siz1% = dll_call1("GetBinaryFileSize",adr(nom$))
NombreDeSegments% = NombreDeSegments% + 1
SegmentActuel% = NombreDeSegments%
' installer le marqueur "#SEG"
AdresseActuelle% = siz0% + 1
if FlagCrypter%=1
s$ = "#SEC"
item_add 101,nom1$+" (crypté)"
else
s$ = "#SEG"
item_add 101,nom1$
end_if
item_add 1101,str$(AdresseActuelle%)
' message "Ajout #SEG"
res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "c"
' installer le numéro du nouveau segment
a% = AdresseActuelle% + 4
n% = SegmentActuel%
res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
' message "d"
' installer la longueur du segment
a% = a% + 4
n% = 4 + 4 + len(nom1$)+1 + siz1%
res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
item_add 1102,str$(n%)
item_add 1104,str$(siz1%)
item_add 1105,str$(FlagCrypter%)

' message "e"
' installer la longueur du nom
a% = a% + 4
n% = len(nom1$) + 1
res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
' message "f"
' installer le nom du segment
a% = a% + 4
s$ = nom1$ + chr$(0)
res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "g"
' installer les données du segment
a% = a% + len(nom1$) + 1
s$ = string$(siz1%," ")
item_add 1103,str$(a%)
if FlagCrypter%=1
res% = dll_call1("CloseBinaryFile",adr(nom$))
res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
res% = dll_call1("OpenBinaryFile",adr(nom$))
end_if
res% = dll_call2("ReadBinaryFileToString",adr(nom$),adr(s$))
res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "h"
' mettre le nombre total de segments à jour
a% = 9
res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(NombreDeSegments%),4,a%,0)
FlagModification% = 1
' message "i"
res% = dll_call1("CloseBinaryFile",adr(nom$))
if FlagCrypter%=1
res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
end_if
end_sub

sub supprimer()
dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, crypte%
if FlagOpen%=0
message "Aucune librairie ouverte"
exit_sub
end_if
if NombreDeSegments%=0 then exit_sub
ind% = item_index(101)
if ind%<1 then exit_sub
nom$ = item_read$(101,ind%)
if instr(nom$,"<supprimé>")=1 then exit_sub
if message_confirmation_yes_no("Voulez-vous vraiment supprimer le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
SegmentActuel% = ind%
AdresseActuelle% = val(item_read$(1101,ind%))
crypte% = val(item_read$(1105,ind%))
if crypte%=1
v% = asc("#")+asc("D")*256+asc("E")*256*256+asc("C")*256*256*256
else
v% = asc("#")+asc("D")*256+asc("E")*256*256+asc("L")*256*256*256
end_if
res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(v%),4,AdresseActuelle%,0)
item_delete 101,ind%
item_insert 101,ind%,"<supprimé>"
FlagModification% = 1
end_sub

sub extraire()
dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, buf$, lseg%, aseg%
dim_local crypte%
if FlagOpen%=0
message "Aucune librairie ouverte"
exit_sub
end_if
if NombreDeSegments%=0 then exit_sub
ind% = item_index(101)
if ind%<1 then exit_sub
nom$ = item_read$(101,ind%)
if instr(nom$,"<supprimé>")=1 then exit_sub
if message_confirmation_yes_no("Voulez-vous vraiment extraire le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
SegmentActuel% = ind%
AdresseActuelle% = val(item_read$(1101,ind%))
crypte% = val(item_read$(1105,ind%))
nom$ = file_name$(1001)
if nom$="_" then exit_sub
if file_exists(nom$)=1
if message_confirmation_yes_no("Fichier déjà existant. Remplacer ?")<>1 then exit_sub
file_delete nom$
end_if
pwd2$ = ""
if crypte%=1
pwd2$ = message_input$("Mot de passe pour le décryptage","Mot de passe:","")
if pwd2$="" then exit_sub
if len(pwd2$)<6
message "Mot de passe trop court (6 caractères minimum)"
exit_sub
end_if
end_if
LongueurSegment% = val(item_read$(1102,ind%))
aseg% = val(item_read$(1103,ind%))
lseg% = val(item_read$(1104,ind%))
buf$ = string$(LongueurSegment%," ")
res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lseg%,aseg%,adr(buf$))
filter 1001,""
res% = dll_call2("WriteStringToBinaryFile",adr(nom$),adr(buf$))
if Crypte%=1
res% = dll_call1("CloseBinaryFile",adr(nom$))
res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
res% = dll_call1("OpenBinaryFile",adr(nom$))
end_if
end_sub

sub restaurer()
dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, crypte%
if FlagOpen%=0
message "Aucune librairie ouverte"
exit_sub
end_if
if NombreDeSegments%=0 then exit_sub
ind% = item_index(101)
if ind%<1 then exit_sub
nom$ = item_read$(101,ind%)
crypte% = val(item_read$(1105,ind%))
if instr(nom$,"<supprimé>")<>1 then exit_sub
if message_confirmation_yes_no("Voulez-vous vraiment restaurer le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
SegmentActuel% = ind%
AdresseActuelle% = val(item_read$(1101,ind%))
if crypte%=1
v% = asc("#")+asc("S")*256+asc("E")*256*256+asc("C")*256*256*256
else
v% = asc("#")+asc("S")*256+asc("E")*256*256+asc("G")*256*256*256
end_if
res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(v%),4,AdresseActuelle%,0)
item_delete 101,ind%
item_insert 101,ind%,mid$(nom$,11,len(nom$))
FlagModification% = 1
end_sub

sub crypter()
if FlagCrypter%=1
FlagCrypter% = 0
mark_off 36
else
FlagCrypter% = 1
mark_on 36
end_if
end_sub

sub purger()
dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, fil$, buf$, aout%, seg$, ns%, crypte%
if FlagOpen%=0
message "Aucune librairie ouverte"
exit_sub
end_if
if NombreDeSegments%=0 then exit_sub
n% = 0
for i%=1 to count(101)
nom$ = item_read$(101,i%)
if instr(nom$,"<supprimé>")=1 then n% = n% + 1
next i%
if n%=0
message "Rien à purger"
exit_sub
end_if
fil$ = file_extract_path$(NomDeTravail$)+"temp_"+file_extract_name$(NomDeTravail$)
res% = dll_call1("CreateBinaryFile",adr(fil$))
' installer l'identifiant
buf$ = "#KGFFLIB"
res% = dll_call2("WriteStringToBinaryFile",adr(fil$),adr(buf$))
res% = dll_call1("OpenBinaryFile",adr(fil$))
' installer le nombre restant de segments
n% = NombreDeSegments%-n%
res% = dll_call5("ReplaceBlockInBinaryFile",adr(fil$),adr(n%),4,9,0)
aout% = 13 : ' premier octet libre après l'entête
ns% = 0
for i%=1 to NombreDeSegments%
if left$(item_read$(101,i%),1)<>"<"
' copier le segment i%
a% = val(item_read$(1101,i%)) : ' prendre l'adresse de début du segment
crypte% = val(item_read$(1105,i%))
' installer le marqueur "#SEG"
if crypt%=1
s$ = "#SEC"
else
s$ = "#SEG"
end_if
res% = dll_call2("AppendStringToBinaryFile",adr(fil$),adr(s$))
' compter et installer le nouveau numéro du segment
ns% = ns% + 1
aout% = aout% + 4 : ' dépasser le marqueur
res% = dll_call5("ReplaceBlockInBinaryFile",adr(fil$),adr(ns%),4,aout%,0)
aout% = aout% + 4 : ' dépasser le numéro de segment
a% = a% + 8 : ' dépasser le marqueur et la longueur du segment

' lire le segment avec son nom et ses données
n% = val(item_read$(1102,i%))
buf$ = string$(n%," ")
res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),n%,a%,adr(buf$))

' copier tout ça dans la sortie
res% = dll_call2("AppendStringToBinaryFile",adr(fil$),adr(buf$))
aout% = aout% + n% : ' dépasser les données copiées
end_if
next i%
' fermer tous les fichiers
res% = dll_call1("CloseBinaryFile",adr(fil$))
res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
' remplacer l'ancien fichier par le nouveau
file_delete NomDeTravail$
file_rename fil$,NomDeTravail$
' recharger les tables
res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104
NombreDeSegments% = 0
' ici, charger la liste des segments !
ChercherPremierSegment()
if NombreDeSegments%>1
for i%=2 to NombreDeSegments%
ChercherSegmentSuivant()
next i%
end_if
FlagModification% = 1
end_sub

Sujet: re Dim 31 Jan 2016 - 17:59

Il y a un souci avec le cryptage :

Gestionnaire d'une librairie de fichiers Captur14

il est dit dans la doc :

Citation :: Cette routine applique les deux mots de passe au fichier. Le contenu du fichier sera remplacé par le contenu crypté. Si le fichier était en clair, le résultat de l'opération est un fichier crypté. Si le fichier était crypté, le résultat de l'opération est le fichier d'origine en clair.

Sujet: Re: Gestionnaire d'une librairie de fichiers Dim 31 Jan 2016 - 18:17

Eh bien, il faut lire la doc, mon vieux ! La fonction crypter travaille sur un fichier, pas sur une chaîne de caractères ! Voici la capture de la doc en ligne:
Gestionnaire d'une librairie de fichiers Aa146

Gestionnaire d'une librairie de fichiers Aa146

D'ailleurs, je te déconseille de mettre une chaîne de caractères en clair dans pwd1$. Ceci peut être lu en décodant le source de l'EXE. La variable pwd1$ du programme est déjà préchargée par un mot de passe complexe - tu as juste à fournir pwd2$.

Sujet: re Dim 31 Jan 2016 - 19:03

Param$ est un fichier *.inf qui contient une ligne qui est le mot de passe
Je le crée
Je récupère la ligne sans cryptage du fichier qui est : "Admin" (histoire d' être sûr de ce que j' ai dans mon fichier d' origine )
je crypte le fichier
je récupère la ligne du fichier qui n' est plus Admin mais quelques hiéroglyphes ( normal le fichier est crypté )
je repasse mon fichier à la moulinette de la fonction de cryptage ( ce qui devrait me remettre le texte du fichier en clair )
je récupère la ligne du fichier et là je ne retrouve pas "Admin" mais d' autres hiéroglyphes. scratch

En fait la fonction crypte et re-crypte mais ne décrypte pas...

Edit : pour les clés de cryptage, c' est pour l' exemple, je ne me servirai pas de celles là pour l' appli.

Sujet: Re: Gestionnaire d'une librairie de fichiers Dim 31 Jan 2016 - 19:14

Ok, j'ai survolé ton code trop vite. Autant pour moi.

Essaie avec 0 dans le dernier paramètre. J'ai déjà eu des problèmes avec 1. Je n'ai pas essayé car j'ai la flemme de retaper le code, mais dans le programme de librairie, ça fonctionne comme ça, même avec des fichiers images.

EDIT

Tu as bien sur intérêt à choisir des mots de passe le plus longs possible, avec des lettres en majuscules et en minuscules, des chiffres et pleins de signes spéciaux. Et surtout, éviter des portions communes entre les deux mots de passe !

Sujet: re Dim 31 Jan 2016 - 19:30

Cela fonctionne très bien avec 0
Very Happy

le problème apparait avec 1

Edit:

Bon, aller, c' est l' heure du casse-croute... Laughing

Sujet: Re: Gestionnaire d'une librairie de fichiers Dim 31 Jan 2016 - 19:31

Ok. Il faudra que je voie ça un jour ou l'autre. Pour le moment, reste avec 1, comme moi.

Nouvelle version de FileLibrary:
- correction d'une anomalie en affichage du nom de segment après suppression ou restauration
- ajour d'un menu contextuel, activé en cliquant sur une des lignes de la liste des segments

Code:: ' FileLibrary.bas

' Ce programme gère une librarie de fichiers qui a la structure suivante:
' #KGF
' FLIB
' ntot (nombre total de fichiers)
' seg 1
' ...
' seg ntot
' Chaque segment a la structure:
' #SEG ou #DEL
' nseg
' lseg (longueur totale du segment sauf les deux premiers mots)
' snom (longeur du nom)
' nom (nom en ascii, terminé par un 0)
' données du segment (de longueur lseg-snom-4)
'
' Opérations:
' création librairie vide ok
' ouvrir une librairie existante ok
' fermer la librairie en cours ok
' enregistrer la librairie sous un autre nom ok
' ajouter un segnement en fin de librarie ok
' supprimer un segment ok
' localiser le segment numéro n ok
' localiser le segment de nom x ok
' extraire le segment localisé ok
' restaurer un segment supprimé ok
' donner la liste des segments de la librairie ok
' purger la liste des segments supprimés ok
' crypter optionnellement des segments ok
'
' Les opérations se font sur un fichier temporaire.
' L'opération Enregistrer retourne au nom de fichier initial.
'
' La suppression d'un segment se fait en remplaçant simplement
' le marqueur du segment par #DEL. Ainsi, le contenu peut
' être récupéré.
'
' Deux autres marqueurs de segments sont définis:
' #SEC - segment crypté
' #DEC - segment crypté et supprimé

  constantes()
  variables()
  labels()

  form0()
  menus()
  contextmenu()

  dll()

  invisibles()

  initialisations()

  end

sortir:
  if FlagModification%=1
   if message_confirmation_yes_no("Modification en cours. Sortir quand-même ?")<>1 then return
  end_if
  res% = dll_call1("KillProcessByHandle",handle(0))
  ' fini ici...

nouveau:
  nouveau()
  return

fermer:
  fermer()
  return

ouvrir:
  ouvrir()
  return

enregistrer:
  enregistrer()
  return

enregistrersous:
  enregistrersous()
  return

ajouter:
  ajouter()
  return

supprimer:
  supprimer()
  close300()
  return

restaurer:
  restaurer()
  close300()
  return

extraire:
  extraire()
  close300()
  return

crypter:
  crypter()
  return

purger:
  purger()
  return

context:
  context()
  return

close300:
  close300()
  return

sub form0()
  caption 0,titre$
  list 101 : full_space 101 : ' width 101,200 : height 101,400
   on_click 101,context
end_sub

sub constantes()
  dim kgf$ : kgf$ = "KGF.dll"
  dim NomDeTravail$ : NomDeTravail$ = dir_current$ + "\KgfFilLib_temp.kfl"
  dim titre$ : titre$ = "Librairie de fichiers"
  data 19,60,103,32,38,20,41,55,86,99,35,34,83,95,80,0
end_sub

sub variables()
  dim res%
  dim NomDeLibrairie$, NomDeSegment$
  dim NombreDeSegments%, SegmentActuel%, AdresseActuelle%, LongueurSegment%
  dim FlagModification%, FlagOpen%, FlagCrypter%
  dim pwd1$, pwd2$
end_sub

sub dll()
  dll_on kgf$
end_sub

sub labels()
  label sortir, nouveau, fermer, ouvrir, enregistrer, enregistrersous
  label ajouter, supprimer, extraire, restaurer, crypter, purger, context
  label close300
end_sub

sub menus()
  main_menu 1

  sub_menu 2 : parent 2,1 : caption 2,"Fichier"
   sub_menu 21 : parent 21,2 : caption 21,"Nouveau" : on_click 21,nouveau
   sub_menu 22 : parent 22,2 : caption 22,"Ouvrir..." : on_click 22,ouvrir
   sub_menu 23 : parent 23,2 : caption 23,"Fermer" : on_click 23,fermer
   sub_menu 24 : parent 24,2 : caption 24,"Enregistrer" : on_click 24,enregistrer
   sub_menu 25 : parent 25,2 : caption 25,"Enregistrer sous..." : on_click 25,enregistrersous
   sub_menu 26 : parent 26,2 : caption 26,"-"
   sub_menu 27 : parent 27,2 : caption 27,"Sortir" : on_click 27,sortir

  sub_menu 3 : parent 3,1 : caption 3,"Segment"
   sub_menu 31 : parent 31,3 : caption 31,"Ajouter" : on_click 31,ajouter
   sub_menu 32 : parent 32,3 : caption 32,"Supprimer" : on_click 32,supprimer
   sub_menu 33 : parent 33,3 : caption 33,"Extraire" : on_click 33,extraire
   sub_menu 34 : parent 34,3 : caption 34,"Restaurer" : on_click 34,restaurer
   sub_menu 35 : parent 35,3 : caption 35,"-"
   sub_menu 36 : parent 36,3 : caption 36,"Crypter" : on_click 36,crypter
   sub_menu 37 : parent 37,3 : caption 37,"-"
   sub_menu 38 : parent 38,3 : caption 38,"Purger" : on_click 38,purger
end_sub

sub contextmenu()
form 300 : hide 300 : command_target_is 300 : on_close 300,close300
caption 300,"Menu contextuel" : border_small 300 : width 300,170 : height 300,120
alpha 301 : left 301,10 : top 301,10 : caption 301,"Supprimer" : on_click 301,supprimer
alpha 302 : left 302,10 : top 302,30 : caption 302,"Extraire" : on_click 302,extraire
alpha 303 : left 303,10 : top 303,50 : caption 303,"Restaurer" : on_click 303,restaurer
command_target_is 0
end_sub

sub invisibles()
  open_dialog 1000
  save_dialog 1001
  dlist 1101 : ' liste des adresses des segments
  dlist 1102 : ' liste des longueurs des segments
  dlist 1103 : ' liste des adresses des données des segments
  dlist 1104 : ' liste des longueurs des données des segments
  dlist 1105 : ' liste des marques "crypté" pour les segments
end_sub

sub initialisations()
  dim_local i%, c%
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
  pwd1$ = ""
  i% = 1
  repeat
   read c%
   if c%<>0 then pwd1$ = pwd1$ + chr$(c%+17)
  until c%=0
end_sub

sub nouveau()
  dim_local buf$, n%
  if FlagModification%=1
   if message_confirmation_yes_no("Une modification est en cours. Créer quand-même ?")<>1 then exit_sub
  end_if
  res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
  res% = dll_call1("CreateBinaryFile",adr(NomDeTravail$))
  buf$ = "#KGFFLIB"
  res% = dll_call2("WriteStringToBinaryFile",adr(NomDeTravail$),adr(buf$))
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  n% = 0
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,9,0)
  FlagModification% = 1
  NomDeLibrairie$ = ""
  FlagOpen% = 1
  caption 0,"<nouveau> - "+titre$
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
  NombreDeSegments% = 0
end_sub

sub fermer()
  dim_local nom$
  if FlagModification%=1
   if message_confirmation_yes_no("Modification en cours. Enregistrer ?")<>1 then exit_sub
   if NomDeLibrairie$=""
   filter 1001,"Librairie de fichiers (*.kfl)|*.kfl"
   nom$ = file_name$(1001)
   if nom$="_" then exit_sub
   if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
   if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier existe déjà. Remplacer ?")<>1 then exit_sub
   end_if
   NomDeLibrairie$ = nom$
   end_if
   res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
   if file_exists(NomDeLibrairie$)=1 then file_delete NomDeLibrairie$
   file_rename NomDeTravail$,NomDeLibrairie$
   FlagOpen% = 0
   NomDeLibrairie$ = ""
   caption 0,titre$
   FlagModification% = 0
   FlagOpen% = 0
   clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
   NombreDeSegments% = 0
   exit_sub
  end_if
  if FlagOpen%=1 then res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  NomDeLibrairie$ = ""
  caption 0,titre$
  FlagModification% = 0
  FlagOpen% = 0
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
  NombreDeSegments% = 0
end_sub

sub ouvrir()
  dim_local nom$, buf$, i%
  if FlagModification%=1
   message "Une modification est en cours. Veuillez fermer le fichier."
   exit_sub
  end_if
  if FlagOpen%=1 then res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  FlagOpen% = 0
  caption 0,titre$
  filter 1000,"Librairie de fichiers (*.kfl)|*.kfl"
  nom$ = file_name$(1000)
  if nom$="_" then exit_sub
  if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
  if file_exists(nom$)=0
   message "Fichier non trouvé."
   exit_sub
  end_if
  res% = dll_call1("OpenBinaryFile",adr(nom$))
  buf$ = string$(8," ")
  res% = dll_call4("ReadBlockFromBinaryFileToString",adr(nom$),8,1,adr(buf$))
  res% = dll_call1("CloseBinaryFile",adr(nom$))
  if buf$<>"#KGFFLIB"
   message "Pas une librairie valide."
   exit_sub
  end_if
  NomDeLibrairie$ = nom$
  if file_exists(NomDeTravail$)=1 then file_delete NomDeTravail$
  file_copy NomDeLibrairie$,NomDeTravail$
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  FlagOpen% = 1
  FlagModification% = 0
  caption 0,file_extract_name$(NomDeLibrairie$)+" - "+titre$
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104 : clear 1105
  NombreDeSegments% = 0
  ' ici, charger la liste des segments !
  ChercherPremierSegment()
  if NombreDeSegments%>1
   for i%=2 to NombreDeSegments%
   ChercherSegmentSuivant()
   next i%
  end_if
end_sub

sub enregistrer()

end_sub

sub enregistrersous()
  dim_local nom$
  filter 1001,"Librairie de fichiers (*.kfl)|*.kfl"
  nom$ = file_name$(1001)
  if nom$="_" then exit_sub
  if lower$(right$(nom$,4))<>".kfl" then nom$ = nom$ + ".kfl"
  if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier existe déjà. Remplacer ?")<>1 then exit_sub
   file_delete nom$
  end_if
  NomDeLibrairie$ = nom$
  FlagOpen% = 1
  FlagModification% = 1
  caption 0,file_extract_name$(NomDeLibrairie$)+" - "+titre$
  file_copy NomDeTravail$,NomDeLibrairie$
end_sub

sub ChercherPremierSegment()
  dim_local n%, a%, nom$, lnom%, prefix$, crypte%
  prefix$ = ""
  res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,9)
  NombreDeSegments% = n%
  SegmentActuel% = 0
  if NombreDeSegments%>0
   SegmentActuel% = 1
   AdresseActuelle% = 13 : ' dépasser les 3 mots d'entête
   a% = AdresseActuelle%
   nom$ = "abcd"
   ' lire le marqueur "#SEG"
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),4,a%,adr(nom$))
   if (nom$<>"#SEG") and (nom$<>"#DEL") and (nom$<>"#SEC") and (nom$<>"#DEC")
   message "Librairie invalide - identifiant du premier segment"
   exit_sub
   end_if
   crypte% = 0
   if (nom$="#SEC") or (nom$="#DEC") then crypte% = 1
   a% = a% + 4
   ' lire le numéro du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,a%)
   if n%<>1
   message "Librairie invalide - numéro du premier segment"
   exit_sub
   end_if
   a% = a% + 4
   ' prendre la longueur du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(LongueurSegment%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du segment
   if (nom$="#DEL") or (nom$="#DEC") then prefix$ = "<supprimé>"
   ' prendre la longueur du nom
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(lnom%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du nom
   nom$ = string$(lnom%-1," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lnom%-1,a%,adr(nom$))
   if crypte%=1
   item_add 101,prefix$+" "+file_extract_name$(nom$)+" (crypté)"
   else
   item_add 101,prefix$+" "+file_extract_name$(nom$)
   end_if
   item_add 1101,str$(AdresseActuelle%)
   item_add 1102,str$(LongueurSegment%)
   item_add 1103,str$(a%+lnom%)
   item_add 1104,str$(LongueurSegment%-lnom%-4-4-1)
   item_add 1105,str$(crypte%)
  end_if
end_sub

' #SEG
' nseg
' lseg (longueur totale du segment sauf les deux premiers mots)
' snom (longeur du nom)
' nom (nom en ascii, terminé par un 0)
' données du segment (de longueur lseg-snom-4)
sub ChercherSegmentSuivant()
  dim_local n%, a%, nom$, lnom%, prefix$, crypte%
  prefix$ = ""
  if SegmentActuel%=NombreDeSegments% then exit_sub
  AdresseActuelle% = AdresseActuelle% + 8 + LongueurSegment%
  SegmentActuel% = SegmentActuel% + 1
   a% = AdresseActuelle%
   nom$ = "abcd"
   ' lire le marqueur "#SEG"
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),4,a%,adr(nom$))
   if (nom$<>"#SEG") and (nom$<>"#DEL") and (nom$<>"#SEC") and (nom$<>"#DEC")
   message "Librairie invalide - identifiant du segment "+str$(SegmentActuel%)
   exit_sub
   end_if
   crypte% = 0
   if (nom$="#SEC") or (nom$="#DEC") then crypte% = 1
   a% = a% + 4
   ' lire le numéro du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(n%),4,a%)
   if n%<>SegmentActuel%
   message "Librairie invalide - numéro du segment "+str$(SegmentActuel%)
   exit_sub
   end_if
   a% = a% + 4
   ' prendre la longueur du segment
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(LongueurSegment%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du segment
   if (nom$="#DEL") or (nom$="#DEC") then prefix$ ="<supprimé>"
   ' prendre la longueur du nom
   res% = dll_call4("ReadBlockFromBinaryFile",adr(NomDeTravail$),adr(lnom%),4,a%)
   a% = a% + 4 : ' dépasser la longueur du nom
   nom$ = string$(lnom%-1," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lnom%-1,a%,adr(nom$))
   if crypte%=1
   item_add 101,prefix$+" "+file_extract_name$(nom$)+" (crypté)"
   else
   item_add 101,prefix$+" "+file_extract_name$(nom$)
   end_if
   item_add 1101,str$(AdresseActuelle%)
   item_add 1102,str$(LongueurSegment%)
   item_add 1103,str$(a%+lnom%)
   item_add 1104,str$(LongueurSegment%-lnom%-4-4-1)
   item_add 1105,str$(crypte%)
end_sub

sub ajouter()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, nomc$
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  filter 1000,"Textes |*.txt|Images|*.bmp;*.jpg;*.png|Tous|*.*"
  nom$ = file_name$(1000)
  if nom$="_" then exit_sub
  if file_exists(nom$)=0
   message "Fichier introuvable"
   exit_sub
  end_if
  nom1$ = file_extract_name$(nom$)
  if count(101)>0
   for i%=1 to count(101)
   nomc$=item_read$(101,i%)
   if right$(nomc$,9)=" (crypté)" then nomc$ = left$(nomc$,len(nomc$) - 9)
   if nom1$=nomc$
   message "Fichier déjà présent dans la librairie"
   exit_sub
   end_if
   next i%
  end_if
  if FlagCrypter%=1
   pwd2$ = message_input$("Mot de passe pour le cryptage","Mot de passe:","")
   if pwd2$="" then exit_sub
   if len(pwd2$)<6
   message "Mot de passe trop court (6 caractères minimum)"
   exit_sub
   end_if
  end_if
  res% = dll_call1("OpenBinaryFile",adr(nom$))
  siz0% = dll_call1("GetBinaryFileSize",adr(NomDeTravail$))
  siz1% = dll_call1("GetBinaryFileSize",adr(nom$))
  NombreDeSegments% = NombreDeSegments% + 1
  SegmentActuel% = NombreDeSegments%
  ' installer le marqueur "#SEG"
  AdresseActuelle% = siz0% + 1
  if FlagCrypter%=1
   s$ = "#SEC"
   item_add 101,nom1$+" (crypté)"
  else
   s$ = "#SEG"
   item_add 101,nom1$
  end_if
  item_add 1101,str$(AdresseActuelle%)
' message "Ajout #SEG"
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "c"
  ' installer le numéro du nouveau segment
  a% = AdresseActuelle% + 4
  n% = SegmentActuel%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
' message "d"
  ' installer la longueur du segment
  a% = a% + 4
  n% = 4 + 4 + len(nom1$)+1 + siz1%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
   item_add 1102,str$(n%)
   item_add 1104,str$(siz1%)
   item_add 1105,str$(FlagCrypter%)

' message "e"
  ' installer la longueur du nom
  a% = a% + 4
  n% = len(nom1$) + 1
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(n%),4,a%,0)
' message "f"
  ' installer le nom du segment
  a% = a% + 4
  s$ = nom1$ + chr$(0)
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "g"
  ' installer les données du segment
  a% = a% + len(nom1$) + 1
  s$ = string$(siz1%," ")
  item_add 1103,str$(a%)
  if FlagCrypter%=1
   res% = dll_call1("CloseBinaryFile",adr(nom$))
   res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
   res% = dll_call1("OpenBinaryFile",adr(nom$))
  end_if
  res% = dll_call2("ReadBinaryFileToString",adr(nom$),adr(s$))
  res% = dll_call2("AppendStringToBinaryFile",adr(NomDeTravail$),adr(s$))
' message "h"
  ' mettre le nombre total de segments à jour
  a% = 9
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(NombreDeSegments%),4,a%,0)
  FlagModification% = 1
' message "i"
  res% = dll_call1("CloseBinaryFile",adr(nom$))
  if FlagCrypter%=1
   res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
  end_if
end_sub

sub supprimer()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, crypte%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  if instr(nom$,"<supprimé>")=1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment supprimer le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  crypte% = val(item_read$(1105,ind%))
  if crypte%=1
   v% = asc("#")+asc("D")*256+asc("E")*256*256+asc("C")*256*256*256
  else
   v% = asc("#")+asc("D")*256+asc("E")*256*256+asc("L")*256*256*256
  end_if
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(v%),4,AdresseActuelle%,0)
  item_delete 101,ind%
  item_insert 101,ind%,"<supprimé> "+nom$
  FlagModification% = 1
end_sub

sub extraire()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, buf$, lseg%, aseg%
  dim_local crypte%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  if instr(nom$,"<supprimé>")=1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment extraire le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  crypte% = val(item_read$(1105,ind%))
  nom$ = file_name$(1001)
  if nom$="_" then exit_sub
  if file_exists(nom$)=1
   if message_confirmation_yes_no("Fichier déjà existant. Remplacer ?")<>1 then exit_sub
   file_delete nom$
  end_if
  pwd2$ = ""
  if crypte%=1
   pwd2$ = message_input$("Mot de passe pour le décryptage","Mot de passe:","")
   if pwd2$="" then exit_sub
   if len(pwd2$)<6
   message "Mot de passe trop court (6 caractères minimum)"
   exit_sub
   end_if
  end_if
  LongueurSegment% = val(item_read$(1102,ind%))
  aseg% = val(item_read$(1103,ind%))
  lseg% = val(item_read$(1104,ind%))
  buf$ = string$(LongueurSegment%," ")
  res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),lseg%,aseg%,adr(buf$))
  filter 1001,""
  res% = dll_call2("WriteStringToBinaryFile",adr(nom$),adr(buf$))
  if Crypte%=1
   res% = dll_call1("CloseBinaryFile",adr(nom$))
   res% = dll_call4("crypter",adr(pwd1$),adr(pwd2$),adr(nom$),0)
   res% = dll_call1("OpenBinaryFile",adr(nom$))
  end_if
end_sub

sub restaurer()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, crypte%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  ind% = item_index(101)
  if ind%<1 then exit_sub
  nom$ = item_read$(101,ind%)
  crypte% = val(item_read$(1105,ind%))
  if instr(nom$,"<supprimé>")<>1 then exit_sub
  if message_confirmation_yes_no("Voulez-vous vraiment restaurer le segment:"+chr$(13)+chr$(10)+nom$)<>1 then exit_sub
  SegmentActuel% = ind%
  AdresseActuelle% = val(item_read$(1101,ind%))
  if crypte%=1
   v% = asc("#")+asc("S")*256+asc("E")*256*256+asc("C")*256*256*256
  else
   v% = asc("#")+asc("S")*256+asc("E")*256*256+asc("G")*256*256*256
  end_if
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(NomDeTravail$),adr(v%),4,AdresseActuelle%,0)
  item_delete 101,ind%
  item_insert 101,ind%,mid$(nom$,12,len(nom$))
  FlagModification% = 1
end_sub

sub crypter()
  if FlagCrypter%=1
   FlagCrypter% = 0
   mark_off 36
  else
   FlagCrypter% = 1
   mark_on 36
  end_if
end_sub

sub purger()
  dim_local nom$, nom1$, i%,siz0%, siz1%, s$, n%, a%, ind%, v%, fil$, buf$, aout%, seg$, ns%, crypte%
  if FlagOpen%=0
   message "Aucune librairie ouverte"
   exit_sub
  end_if
  if NombreDeSegments%=0 then exit_sub
  n% = 0
  for i%=1 to count(101)
   nom$ = item_read$(101,i%)
   if instr(nom$,"<supprimé>")=1 then n% = n% + 1
  next i%
  if n%=0
   message "Rien à purger"
   exit_sub
  end_if
  fil$ = file_extract_path$(NomDeTravail$)+"temp_"+file_extract_name$(NomDeTravail$)
  res% = dll_call1("CreateBinaryFile",adr(fil$))
  ' installer l'identifiant
  buf$ = "#KGFFLIB"
  res% = dll_call2("WriteStringToBinaryFile",adr(fil$),adr(buf$))
  res% = dll_call1("OpenBinaryFile",adr(fil$))
  ' installer le nombre restant de segments
  n% = NombreDeSegments%-n%
  res% = dll_call5("ReplaceBlockInBinaryFile",adr(fil$),adr(n%),4,9,0)
  aout% = 13 : ' premier octet libre après l'entête
  ns% = 0
  for i%=1 to NombreDeSegments%
   if left$(item_read$(101,i%),1)<>"<"
   ' copier le segment i%
   a% = val(item_read$(1101,i%)) : ' prendre l'adresse de début du segment
   crypte% = val(item_read$(1105,i%))
   ' installer le marqueur "#SEG"
   if crypt%=1
   s$ = "#SEC"
   else
   s$ = "#SEG"
   end_if
   res% = dll_call2("AppendStringToBinaryFile",adr(fil$),adr(s$))
   ' compter et installer le nouveau numéro du segment
   ns% = ns% + 1
   aout% = aout% + 4 : ' dépasser le marqueur
   res% = dll_call5("ReplaceBlockInBinaryFile",adr(fil$),adr(ns%),4,aout%,0)
   aout% = aout% + 4 : ' dépasser le numéro de segment
   a% = a% + 8 : ' dépasser le marqueur et la longueur du segment

   ' lire le segment avec son nom et ses données
   n% = val(item_read$(1102,i%))
   buf$ = string$(n%," ")
   res% = dll_call4("ReadBlockFromBinaryFileToString",adr(NomDeTravail$),n%,a%,adr(buf$))

   ' copier tout ça dans la sortie
   res% = dll_call2("AppendStringToBinaryFile",adr(fil$),adr(buf$))
   aout% = aout% + n% : ' dépasser les données copiées
   end_if
  next i%
  ' fermer tous les fichiers
  res% = dll_call1("CloseBinaryFile",adr(fil$))
  res% = dll_call1("CloseBinaryFile",adr(NomDeTravail$))
  ' remplacer l'ancien fichier par le nouveau
  file_delete NomDeTravail$
  file_rename fil$,NomDeTravail$
  ' recharger les tables
  res% = dll_call1("OpenBinaryFile",adr(NomDeTravail$))
  clear 101 : clear 1101 : clear 1102 : clear 1103 : clear 1104
  NombreDeSegments% = 0
  ' ici, charger la liste des segments !
  ChercherPremierSegment()
  if NombreDeSegments%>1
   for i%=2 to NombreDeSegments%
   ChercherSegmentSuivant()
   next i%
  end_if
  FlagModification% = 1
end_sub

sub context()
  if count(101)=0 then exit_sub
  dim_local caretx%,carety%,selstart%,selend%,line%,col%,x%,y%,w%,h%
  res% = dll_call6("GetCaretAndCoordinates",adr(caretx%),adr(carety%),adr(selstart%),adr(selend%),adr(line%),adr(col%))
  res% = dll_call5("GetFormClientMetrics",handle(101),adr(x%),adr(y%),adr(w%),adr(h%))
  caretx% = mouse_x_left_down(101) : carety% = mouse_y_left_down(101)
  inactive 0
  top 300,carety%+y%+5 : left 300,caretx%+x%+5 : show 300
end_sub

sub close300()
  hide 300
  active 0 : to_foreground 0 : set_focus 101
end_sub

» Un gestionnaire de contacts avec SQLite3 (KGF.dll)
» Librairie sfml
» un gestionnaire banquaire
» Gestionnaire perso de plantes (ou d'autres types d'objets)
» Astuce : les barres du gestionnaire des tâches