Soyez le premier à donner votre avis sur cette source.
Snippet vu 8 659 fois - Téléchargée 24 fois
Sub tri_TXT(sInput,sOutput) Dim inputfile,outpufile Dim FdInput,dfich_source Dim tmp inputfile=sInput outpufile=sOutput 'ouverture des 2 fichiers texte Set FdInput = CreateObject("Scripting.FileSystemObject") Set dfich_source = FdInput.OpenTextFile(inputfile, 1, False) Dim imax,Cible,Valeur,j imax = 0 Do While not dfich_source.atEndOfStream imax = imax + 1 tmp = dfich_source.readLine ReDim Preserve Tableau(1, imax) Tableau(1, imax) = tmp Valeur=0 j=imax - 1 Do while ((Valeur=0) and (j > 0)) If Tableau(1, j) > Tableau(1, j + 1) Then Cible = Tableau(1, j) Tableau(1, j) = Tableau(1, j + 1) Tableau(1, j + 1) = Cible Else Valeur=1 End If j=j-1 Loop Loop Dim FdOutput,dnouv_fich Set FdOutput = CreateObject("Scripting.FileSystemObject") Set dnouv_fich = FdOutput.CreateTextFile(outpufile) dnouv_fich.Close Set dnouv_fich = FdOutput.OpenTextFile(outpufile, 2, true) Dim r For r = 1 To imax dnouv_fich.writeLine Tableau(1, r) Next dnouv_fich.Close dfich_source.Close Set dnouv_fich=nothing Set dfich_source=nothing Set FdOutput=nothing Set FdInput=nothing End sub Sub doubl_TXT(sInput,sOutput) Dim inputfile,outpufile Dim FdInput,dfich_source Dim tmp inputfile=sInput outpufile=sOutput 'ouverture des 2 fichiers texte Set FdInput = CreateObject("Scripting.FileSystemObject") Set dfich_source = FdInput.OpenTextFile(inputfile, 1, False) Dim imax,Cible,Valeur,j imax = 0 '1er elt inserer sans verification if not dfich_source.atEndOfStream then imax = imax + 1 tmp = dfich_source.readLine ReDim Preserve Tableau(1, imax) Tableau(1, imax) = tmp end if Do While not dfich_source.atEndOfStream 'ne fonctionne que si le fichier est trié tmp = dfich_source.readLine If (Tableau(1, imax) <> tmp) then imax = imax + 1 ReDim Preserve Tableau(1, imax) Tableau(1, imax) = tmp End if Loop Dim FdOutput,dnouv_fich Set FdOutput = CreateObject("Scripting.FileSystemObject") Set dnouv_fich = FdOutput.CreateTextFile(outpufile) dnouv_fich.Close Set dnouv_fich = FdOutput.OpenTextFile(outpufile, 2, true) Dim r For r = 1 To imax dnouv_fich.writeLine Tableau(1, r) Next dnouv_fich.Close dfich_source.Close Set dnouv_fich=nothing Set dfich_source=nothing Set FdOutput=nothing Set FdInput=nothing End sub Sub recup_ligne_TXT(sChaine,ileft,iright,sInput,sOutput) '/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// Dim text Dim tmp Dim nbre_ligne_fichier,iPos Dim gauche,droite,reste,somme Dim FSys,FInput,fich_source,nouv_fich Dim filein Dim fileout 'Dim fileout As String filein=sInput fileout=sOutput 'CREATION FICHIER TEMPORAIRE Set FSys = CreateObject("Scripting.FileSystemObject") Set nouv_fich = FSys.CreateTextFile(fileout) 'FERMETURE FICHIER TEMPORAIRE nouv_fich.Close 'ouverture des 2 fichiers texte ' Open filein For Input As 1# ' Open fileout For Output As 2# Set FInput = CreateObject("Scripting.FileSystemObject") Set fich_source = FInput.OpenTextFile(filein, 1, False) Set nouv_fich = FSys.OpenTextFile(fileout, 2, true) 'wscript.echo "Debug Debut lecture" & ileft & iright Do While not fich_source.atEndOfStream 'compteur = compteur + 1 tmp = fich_source.readLine 'wscript.echo "Debug read " & tmp iPos = InStr(1, tmp, sChaine) 'wscript.echo "Debug if iPos " 'Do While not fich_source.atEndOfStream if iPos <> 0 then 'wscript.echo "Debug """ & ileft & iright If iright = -1 then 'on prend tout à droite de la chaine somme = Len(tmp) - iPos - Len(sChaine) + 1 'wscript.echo "Debug ipos """ & iPos 'wscript.echo "Debug """ & somme droite = right(tmp,somme) nouv_fich.writeLine droite end if If ileft = -1 then 'on prend tout à gauche de la chaine 'wscript.echo "Debug ipos """ & iPos 'wscript.echo "Debug """ & somme gauche = left(tmp,iPos) nouv_fich.writeLine gauche end if 'on prend tout à iright carateres à droite et ileft à gauche de la chaine If iright =0 and ileft>=0 then reste=tmp 'wscript.echo "Debug left " & somme Do while (iPos <>0 ) 'wscript.echo "Debug iPos """ & iPos 'wscript.echo "Debug """ & ileft somme = Len(reste) - iPos - Len(sChaine) + 1 if ileft > iPos then gauche = left(reste,iPos-1) reste = right(reste,somme) 'wscript.echo "Debug left1" & gauche 'wscript.echo "Debug left1" & reste else gauche = right(left(reste,iPos-1),ileft) reste = right(reste,somme) 'wscript.echo "Debug left2 " & gauche 'wscript.echo "Debug left2" & reste End if 'wscript.echo "Debug " & gauche & droite tmp = Trim(gauche) nouv_fich.writeLine tmp iPos = InStr(1, reste, sChaine) Loop end if If iright >=0 and ileft=0 then reste=tmp 'wscript.echo "Debug right """ & somme Do while (iPos <>0 ) somme = Len(reste) - iPos - Len(sChaine) + 1 'wscript.echo "Debug somme """ & somme 'wscript.echo "Debug """ & iright if iright > somme then droite = right(reste,somme) 'wscript.echo "Debug right1" & droite else droite = left(right(reste,somme),iright) somme = Len(reste) - iPos - Len(sChaine) + 1 - Len(droite) reste = right(right(reste,somme),somme) 'wscript.echo "Debug right2" & droite 'wscript.echo "Debug right2" & reste end if 'wscript.echo "Debug " & droite tmp = Trim(droite) nouv_fich.writeLine tmp iPos = InStr(1, reste, sChaine) Loop end if end if Loop 'fermeture des 2 fichiers texte 'Close #1 'Close #2 nouv_fich.close fich_source.close Set nouv_fich=nothing Set fich_source=nothing Set FSys=nothing Set FInput=nothing 'Supprmime le fichier SOURCE 'Kill filein 'Renomme le fichier TEMP(et donc remplace le fichier SOURCE) 'Name fileout As filein 'If N°ligne > nbre_ligne_fichier Or N°ligne < 1 Then MsgBox "Procédure exécutée avec succès, mais sans effet!", vbInformation, "Message" 'wscript.echo "Debug fin recupligne " End Sub Sub bloc_TXT(sChainedeb,sChainefin,tInput,tOutput) '/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 'recuperation des elements du fichiers compris entre la ligne contenant sChainedeb et la ligne sChainefin Dim tmp Dim iPos Dim FOut,FIn,fich_source,nouv_fich Dim filein Dim fileout 'Dim fileout As String filein=tInput fileout=tOutput 'wscript.echo "Debug bloc_TXT input1 " & filein 'wscript.echo "Debug bloc_TXT input2 " & fileout 'CREATION FICHIER TEMPORAIRE Set FOut = CreateObject("Scripting.FileSystemObject") Set nouv_fich = FOut.CreateTextFile(fileout) nouv_fich.Close 'ouverture des 2 fichiers texte ' Open filein For Input As 1# ' Open fileout For Output As 2# Set FIn = CreateObject("Scripting.FileSystemObject") Set fich_source = FIn.OpenTextFile(filein, 1, False) Set nouv_fich = FOut.OpenTextFile(fileout, 2, true) iPos =0 'wscript.echo "Debug Debut lecture" & ileft & iright Do while (iPos =0) and not fich_source.atEndOfStream tmp = fich_source.readLine 'wscript.echo "Debug bloc_TXT deb " & tmp iPos = InStr(1, tmp, sChainedeb) 'wscript.echo "Debug bloc_TXT deb " & iPos Loop iPos =0 Do while (iPos =0) and not fich_source.atEndOfStream tmp = fich_source.readLine wscript.echo "Debug bloc_TXT fin " & tmp iPos = InStr(1, tmp, sChainefin) 'wscript.echo "Debug bloc_TXT fin " & iPos If iPos = 0 then nouv_fich.writeLine tmp End if Loop nouv_fich.close fich_source.close Set nouv_fich=nothing Set fich_source=nothing Set FOut=nothing Set FIn=nothing End Sub
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.