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
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.