Generateur de dictionnaire

Soyez le premier à donner votre avis sur cette source.

Vue 4 815 fois - Téléchargée 339 fois

Description

permet de genere des dictionnaires un tout petit peu inteligent (evite d'ecrire des "aaaaa")avec un fichier par lettre
mais c'est long!

Source / Exemple :


Dim lf,faux,inx,indx,fso,dico,index,var,val,tab1(25),tab2(25),tab3(25),tab4(25),tab5(25),ligne
Dim tab6(25),tab7(25),tab8(25),tab9(25),tab10(25),tab11(25),tab12(25),tab13(25),tab14(25),tab15(25)
Dim tab(15), num, foi1, foi2,id1,id2,id3,id4,id5,id6,id7,id8,indextemp,clin,sorti,poslet,lettre
Dim comsone(19),cons,flag,doublon,exeption,sorflag
ReDim doublon(19, 19)

chaine=("ch,ph,sh,th,bl,cl,fl,gl,pl,sl,br,cr,dr,fr,gr,pr,tr,vr")
exeption=split(chaine,",",-1,1)

cons=0
flag=0

vari=98
comsone(0)=Chr(vari)
For inx = 1 To 26         'affectation des comsones
if (vari+inx)<>101 And (vari+inx)<>105 And (vari+inx)<>111 And (vari+inx)<>117 And (vari+inx)<>121 And cons<>19 then 
cons=cons+1
comsone(cons)=Chr(vari+inx)
end if
Next

inxd1=0
For each vard1 in comsone
 inxd2=0
  For each vard2 in comsone
    doublon(inxd1,inxd2)=vard1+vard2
    inxd2=inxd2+1
  Next
  inxd1=inxd1+1
Next

poslet=1
foi1=1
sorti=0
clin=1
foi2=1
ligne="a"
for nb=0 To 15
tab(nb)=nb
next

faux=1

Do until faux=4
index = InputBox("Entrez la taille des mots du dico","Cree dico by racattac13")

 If  index <>0 Or  index <>"" Or  index >8 Then
  
  faux=4
  Set fso = CreateObject("Scripting.FileSystemObject") 'creation d'un bjet fichier 
  
  If index>3 Then  
   Set fold = fso.CreateFolder("dico"&index)
   Set dico = fso.CreateTextFile("dico"&index&"\dico_a"&index&".dic")      'creation du fichier destin
   dico.Close                                         'fermeture du fichier destination
   set dico= fso.OpenTextFile("dico"&index&"\dico_a"&index&".dic",2)                 'reouverture en ajout de texte 
  else
   Set dico = fso.CreateTextFile("dico_abc"&index&".dic")      'creation du fichier destin
   dico.Close                                         'fermeture du fichier destination
   set dico= fso.OpenTextFile("dico_abc"&index&".dic",2)                 'reouverture en ajout de texte 
  End If

  Call init()
 
  Call boucle()
  
  Call ferme()
 Else
  conf="Confirme="&faux
  if faux=3 then
   conf="Ciao"
  end if
  msgbox "Enter 1 et 8! Gaga",0,conf
  faux=faux+1
 End If

loop
wscript.quit(1)
'--------------------------------------------------

Sub init()
 For indx=1 To (index) 
  Select Case indx
       Case "1" Call alpha(tab1)
       Case "2" Call alpha(tab2)
       Case "3" Call alpha(tab3)
       Case "4" Call alpha(tab4)
       Case "5" Call alpha(tab5)
       Case "6" Call alpha(tab6)
       Case "7" Call alpha(tab7)
       Case "8" Call alpha(tab8)
  End Select
 Next
End Sub
'-----------------------------------------------------------------------
Sub alpha(tab)

val=97
tab(0)=Chr(val)
For inx = 1 To 25         'affectation de l'alphabet
tab(inx)=Chr(val+inx)
Next

End Sub

'----------------------------------------------------------------------
Sub boucle()
indextemp=index
ligne=""

if index<=8 And sorti=0 then
 For each id8 in tab8
  ligne=ligne+id8
  index=7
  if index<=7 And sorti=0 then
   For each id7 in tab7
    ligne=ligne+id7
    index=6
    if index<=6 And sorti=0 then
     For each id6 in tab6
      ligne=ligne+id6
      index=5
      if index<=5 And sorti=0 then
       For each id5 in tab5
        ligne=ligne+id5
        index=4
        if index<=4 And sorti=0 then
         For each id4 in tab4
          ligne=ligne+id4
          index=3
          if index<=3 And sorti=0 then
           For each  id3 in tab3
            ligne=ligne+id3
            index=2
            if index<=2 And sorti=0 then
             For each id2 in tab2
              ligne=ligne+id2
              index=1
              if index=1 And sorti=0 then
               For each id1 in tab1
                ligne=ligne+id1
                Call ecrire()
                clin=clin+1 
                Call soustrait(1)   
               Next
              end if 
              Call soustrait(2)   
             Next
             
            end if 
            Call soustrait(3) 
           Next
          
          end if
          Call change(4)
          Call soustrait(4)      
         Next
         
        end if
        Call change(5)
        Call soustrait(5)     
       Next
      
      end if  
      Call change(6)      
      Call soustrait(6)     
     Next
     
    end if
    Call change(7)  
    Call soustrait(7)     
   Next

  end if  
  Call change(8) 
  Call soustrait(8) 
 Next
end if 

End Sub
'-----------------------------------------------------------------------------
Sub ecrire()

if indextemp=8 then
if id3<>id2 And id2<>id1 then
if id7<>id6 And id6<>id5 then
 if id8<>id7 then
  if id1<>id2 then 
   Call exist(id1,id2,id7,id8,id6)
  end if
 end if
end if
end if
end if

if indextemp=7 then
if id3<>id2 And id2<>id1 then
if id6<>id5 And id5<>id4 then
 if id7<>id6 then
  if id1<>id2 then 
   Call exist(id1,id2,id6,id7,id5)
  end if
 end if
end if
end if
end if

if indextemp=6 then
if id3<>id2 And id2<>id1 then
if id5<>id4 And id4<>id3 then
 if id6<>id5 then
  if id1<>id2 then 
   Call exist(id1,id2,id5,id6,id4)
  end if
 end if
 end if
end if
end if

if indextemp=5 then
if id3<>id2 And id2<>id1 then
if id4<>id3 And id3<>id2 then
 if id5<>id4 then
  if id1<>id2 then 
   Call exist(id1,id2,id4,id5,id3)
  end if
 end if
end if
end if
end if

if indextemp=4 then
if id3<>id2 And id2<>id1 then
if id4<>id3 And id3<>id2 then
 if id4<>id3 then
  if id1<>id2 then    
  Call exist(id1,id2,id3,id4,id2) 
  end if
 end if
end if
end if
end if

if indextemp=3 Or indextemp=2 Or indextemp=1 then
 dico.WriteLine(ligne)
end if

End Sub
  
'-----------------------------------------------------------------------------
Sub change(val)

 If (indextemp Eqv val)=True And poslet<>26 Then
    lettre=tab1(poslet)
    dico.close 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set dico = fso.CreateTextFile("dico"&indextemp&"\dico_"&lettre&indextemp&".dic") 
    dico.Close                                        
    set dico= fso.OpenTextFile("dico"&indextemp&"\dico_"&lettre&indextemp&".dic",2)
    poslet=poslet+1
 End if
end Sub         
'-----------------------------------------------------------------------------
Sub soustrait(val)
if (clin-1)<>(26^indextemp) then
 if (indextemp Eqv val)=True then
    ligne=""
  else 
    ligne=Left(ligne,indextemp-val)
 end if
else sorti=1
end if
end Sub
'-----------------------------------------------------------------------------
Sub exist(let1,let2,let3,let4,letp)
doubl_flag=0
sorflag=0
continu=0

For each doubl in doublon
 if ((let4+let3)=doubl) Then
    
    if let3="r" Or let3="l" Or let3="h" then
       
      for each trois in comsone
       if letp=trois then
        continu=1
        Exit for
       end if
      next 

       for each exep in exeption
         if (let4+let3)=exep then
          doubl_flag=0 
          sorflag=1  
          Exit for
         else
          doubl_flag=1  
         end if
        next    
     else
     doubl_flag=1
    End if
  
    if sorflag=1 then
    Exit for
    end if

 end if
next

For each doubl in doublon
 if (let2+let1)=doubl then
   doubl_flag=1
   exit for
 end if
next 

if doubl_flag=0  And continu=0 Then
  dico.WriteLine(ligne)
 End if
End Sub
'-----------------------------------------------------------------------------
Sub ferme()
dico.close
 If indextemp<=3 Then
  msgbox "Emplacement "&"dico_abc"&indextemp&".dic",0,"C'est fini"
 Else
  msgbox "Emplacement dans le repertoire dico"&indextemp,0,"C'est fini"
 End If
End Sub
'-----------------------------------------------

Conclusion :


faut pas etre presse

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
458
Date d'inscription
dimanche 22 décembre 2002
Statut
Membre
Dernière intervention
18 avril 2009

un zip serait le bien venu car là y'a du rouge dans le code source ;)
Messages postés
262
Date d'inscription
lundi 26 août 2002
Statut
Membre
Dernière intervention
24 août 2005

J'avoue je n'ai pas testé mais si tu pouvais comparer cette source a la mienne et me dire ce que tu en penses ce serait sympa c'est juste pour savoir ce que je vaut (la mienne laisse les aaaaa lol)
http://www.vbfrance.com/code.aspx?ID=24443
voili voila :Þ

Pingouin

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.