[已解决]如何做到非本机打开密码保护宏就删除所有代码？

zhaoyes

Function GetComputerName()
GetComputerName = Environ("ComputerName")
End Function
Sub Test()
    If UCase(GetComputerName) <> UCase("shourou") Then Exit Sub
End Sub

守柔提供的以上代码非常好用；现在我想在现有的宏代码中加入一段代码，如果不是自己的电脑打开starup文件夹下的WORD宏有工程保护密码模板文件时（密码是已知的），就删除自身所有的宏代码并保存，需要不弹出确认保存窗口就把所有代码删除！

请教守柔大师如何实现？

[此贴子已经被作者于2007-10-14 12:39:25编辑过]

守柔

可以参考一下这个链接：

http://club.excelhome.net/viewthread.php?tid=212027&replyID=667753&skin=0

zhaoyes

参考守柔的代码集：五十八) 删除所有代码(包括自身)
'* +++++++++++++++++++++++++++++++++++++++
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* --------------------------------------------------------------------------
Private Sub Document_Open()
        D im i ,  A  A s  I n t e g e r 

If UCase(GetComputerName) <> UCase("shourou") Then 
        For Each i In ActiveDocument.VBProject.VBComponents
        A  =  i.CodeModule.CountOflines
        i.CodeModule.DeleteLines  1,  A
    N e x t 
End Sub
'----------------------

这样可以吗？还有需要不弹出确认保存窗口就把所有代码删除怎么添加代码语句？

zhaoyes

守柔老大，这个问题我在论坛里找了很久都没有完美的解决方案阿，好像都被当成病毒了，要么就是WORD测试代码的时候弹出安全窗口不给运行代码，现在有更好的解决方案吗？

[此贴子已经被作者于2007-9-29 22:09:22编辑过]

守柔

QUOTE:

以下是引用zhaoyes在2007-9-29 22:08:58的发言：

守柔老大，这个问题我在论坛里找了很久都没有完美的解决方案阿，好像都被当成病毒了，要么就是WORD测试代码的时候弹出安全窗口不给运行代码，现在有更好的解决方案吗？

你没有认真去领会链接中的内容。

请认真阅读代码中的注释行。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2007-9-30 5:23:56
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0267^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Function GetComputerName()
    GetComputerName = Environ("ComputerName")
End Function
'----------------------
Sub RemoveMoudle()
'把所有重要的代码写到"模块1中",如果不够,可再插入"模块2"等
'在代码中继续移除已知名的模块即可.
'如果使用代码在模块中循环,则必须在安全性中设置信任对于VB项目的访问
'尽管可以使用VBA完成对于注册表中WORD安全性对于信任VB项目的修改
'但可能通过不病毒扫描程序
'本例只是在允许宏运行的前提下才存在,很明显,若要运行模块中的宏,必须允许
'宏运行,否则他人使用该文档也没有意义
'定义一个3个字节的string型常量
    Const MyPassWord As String * 3 = "123"
    On Error GoTo Finish '如果已移除模块后再次打开时,则退出
    '若更可靠些,可以写在文档变量(Variables)中
    Application.ScreenUpdating = False
    '输入密码
    Application.VBE.CommandBars.FindControl(ID:=2578).Execute
    SendKeys MyPassWord & "{Enter 2}", True
    Application.OrganizerDelete Source:=ThisDocument.FullName, Name:="模块1", Object:=wdOrganizerObjectProjectItems
Finish:
    Application.ScreenUpdating = True
    MsgBox "OK,已删除！"    '此句请删除,仅作为测试用
    ThisDocument.Close True
End Sub
'----------------------
Private Sub Document_Open()
'如果计算机用户名不为指定的用户("shourou")则进入删除模块程序
    If UCase(GetComputerName) <> UCase("shourou") Then RemoveMoudle
End Sub
'----------------------

zhaoyes

QUOTE:

以下是引用守柔在2007-9-30 5:33:16的发言：

你没有认真去领会链接中的内容。

请认真阅读代码中的注释行。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2007-9-30 5:23:56
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0267^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Function GetComputerName()
    GetComputerName = Environ("ComputerName")
End Function
'----------------------
Sub RemoveMoudle()
'把所有重要的代码写到"模块1中",如果不够,可再插入"模块2"等
'在代码中继续移除已知名的模块即可.
'如果使用代码在模块中循环,则必须在安全性中设置信任对于VB项目的访问
'尽管可以使用VBA完成对于注册表中WORD安全性对于信任VB项目的修改
'但可能通过不病毒扫描程序
'本例只是在允许宏运行的前提下才存在,很明显,若要运行模块中的宏,必须允许
'宏运行,否则他人使用该文档也没有意义
'定义一个3个字节的string型常量
    Const MyPassWord As String * 3 = "123"
    On Error GoTo Finish '如果已移除模块后再次打开时,则退出
    '若更可靠些,可以写在文档变量(Variables)中
    Application.ScreenUpdating = False
    '输入密码
    Application.VBE.CommandBars.FindControl(ID:=2578).Execute
    SendKeys MyPassWord & "{Enter 2}", True
    Application.OrganizerDelete Source:=ThisDocument.FullName, Name:="模块1", Object:=wdOrganizerObjectProjectItems
Finish:
    Application.ScreenUpdating = True
    MsgBox "OK,已删除！"    '此句请删除,仅作为测试用
    ThisDocument.Close True
End Sub
'----------------------
Private Sub Document_Open()
'如果计算机用户名不为指定的用户("shourou")则进入删除模块程序
    If UCase(GetComputerName) <> UCase("shourou") Then RemoveMoudle
End Sub
'----------------------

此代码做成word模板后放在STARUP文件下，就算非本机都不会触发Document_Open事件，而且所有宏代码控件功能都能正常使用，模块并没有被删除；当此模板改后缀名为.DOC时，符合条件后就会打不开文件和看不见代码，但是问题来了：用Advanced VBA Password Recovery密码恢复软件，它能够很轻松地得到Visual Basic编制的VBA密码，然后用密码进入VBE可看到所有代码并没有被删除，上述代码好像只是一个障眼法，请守柔检查一下我说的对不对。这样的话我需要删除代码不被人知道的功能就没有达到啊。

[此贴子已经被作者于2007-9-30 12:42:37编辑过]

zhaoyes

绕了很多弯路，终于完美解决！简化了代码之后如下

'删除模板模块的代码，有工程保护密码也一样删除模块，注意模板文件一定要另存为模板不能直接改后缀名
Option Explicit
Function GetComputerName()
    GetComputerName = Environ("ComputerName")
End Function
Sub RemoveMoudle()

On Error Resume Next '这一句一定要写
Application.OrganizerDelete Source:=ThisDocument.FullName, Name:="模块1",Object:=wdOrganizerObjectProjectItems
    Application.ScreenUpdating = True
    Me.Save
    ActiveDocument.Close (True)
End Sub
Sub AutoOpen()
    If UCase(GetComputerName) <> UCase("shourou") Then RemoveMoudle
End Sub
Sub AutoNew()
    If UCase(GetComputerName) <> UCase("shourou") Then RemoveMoudle
End Sub
Sub AutoExec()
'加载模板后如果计算机用户名不为指定的用户("shourou")则进入删除模块程序
    If UCase(GetComputerName) <> UCase("shourou") Then RemoveMoudle
End Sub
Private Sub Document_Open()
'打开文档后如果计算机用户名不为指定的用户("shourou")则进入删除模块程序
    If UCase(GetComputerName) <> UCase("shourou") Then RemoveMoudle
End Sub

[此贴子已经被作者于2007-10-15 9:13:59编辑过]

lcmphy

好帖，收藏学习！

yb010

好贴，收藏！

yijiboo

记录下。看看研究哈如何删除所有模块呢？...