有哪些方式使 project is unviewable

大氵寿

1. vba 设置保护.

还有其他的吗?

大氵寿

方法一（共用级锁定）:
      1、先对excel档进行一般的vbaproject”工程密码保护"。
    2、打开要保护的档，选择∶工具--->保护--->保护并共用活页簿--->以追踪修订方式共用-->
           输入密码-->保存档。
    完成后，当你打开“vbaproject”工程属性时，就将会提示∶“工程不可看"
方法二（推荐，破坏型锁定）∶
      用16进制编辑工具，如winhex、ultraedit-32（可到此下载）等，再历害点的人完全可以
    用debug命令来做......用以上软体打开excel档，查找定位以下地方∶
      id="{00000000-0000-0000-0000-000000000000}"    注∶实际显示不会全部为0
      此时，你只要将其中的位元组随便修改一下即可。保存再打开，就会发现大功告成！
    当然，在修改前最好做好你的文档备份。至于恢复只要将改动过的地方还原即可（只要你记住了啊）。


复制到这里,再慢慢看.

大氵寿

我们在打开含有VBA代码的VBA工程时，有时会提示“工程不可查看”，造成这种提示原因有很多，下面说一下如何用“工享工作簿”来设置“工程不可查看”。
    第一步：打开要保护的工作簿，工具---保护---保护共享工作簿---选以追踪方式修订，确定
    第二步：文件另存为网页格式
    第三步：文件再另存为xls格式。
     完成。

   解锁方法：
       1  打开该excel文件，工具--共享工作簿--选中：允许多用户。。。确定
       2  打开该excel文件，工具--共享工作簿--取消选中：允许多用户。。。确定

   如果不行，再试试：VBA工程不可查看-破解方法
   
     用Ultraedit-32打开文件分别查找
             CMG=
             DPB=
              GC=   
         将"="
         替换为"."
保存后再即可打开。这个试试，百度的

大氵寿

工程不可查看解密代码转

新建一个Excel工作簿,Alt+F11 打开VBA编辑器,新建一个模块 ,复制以下代码,注意如提示变量未定义,则把Option Explicit行删除即可,经测试已经通过.

'移除VBA编码保护
Sub MoveProtect()
    Dim FileName As String
    FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
    If FileName = CStr(False) Then
       Exit Sub
    Else
       VBAPassword FileName, False
    End If
End Sub

'设置VBA编码保护
Sub SetProtect()
    Dim FileName As String
    FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
    If FileName = CStr(False) Then
       Exit Sub
    Else
       VBAPassword FileName, True
    End If
End Sub

Private Function VBAPassword(FileName AsString, Optional Protect As Boolean = False)
      If Dir(FileName) = "" Then
         Exit Function
      Else
         FileCopy FileName, FileName& ".bak"
      End If

      Dim GetDataAs String * 5
      Open FileName For Binary As #1
      Dim CMGs As Long
      Dim DPBo As Long
      For i = 1 To LOF(1)
          Get #1, i, GetData
          If GetData ="CMG=""" Then CMGs = i
          If GetData ="[Host" Then DPBo = i - 2: Exit For
      Next
      If CMGs = 0 Then
         MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
         Exit Function
      End If
      If Protect = False Then
         Dim St As String * 2
         Dim s20 As String * 1
         '取得一个0D0A十六进制字串
         Get #1, CMGs - 2, St
         '取得一个20十六制字串
         Get #1, DPBo + 16, s20
         '替换加密部份机码
         For i = CMGs To DPBo Step 2
             Put #1,i, St
         Next
         '加入不配对符号
         If (DPBo - CMGs) Mod 2<> 0 Then
            Put #1, DPBo+ 1, s20
         End If
         MsgBox "文件解密成功......", 32, "提示"
      Else
         Dim MMs As String * 5
         MMs ="DPB="""
         Put #1, CMGs, MMs
         MsgBox "对文件特殊加密成功......", 32, "提示"
      End If
      Close #1
End Function

大氵寿

Private Sub IC_Click()
Dim B     As Byte
Dim index As Double
Dim fso As FileSystemObject '要先添加引用“Microsoft Scripting Runtime”

dlg.ShowOpen
Filename = dlg.Filename

If Len(Filename) = 0 Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

fso.CopyFile Filename, Filename & ".bak", True

If Err.Number = 70 Then Tip.Text = "文件备份失败..."
Err.Clear

On Error GoTo 0

SetAttr Filename, 0
Open Filename For Binary As #1

DoEvents
index = 1

Do Until EOF(1)
       Get #1, index, B

       If B = 67 Then
         index = index + 1
         Get #1, index, B

         If B = 77 Then
            index = index + 1
            Get #1, index, B

            If B = 71 Then
                   Put #1, index + 1, 10
            End If
         End If

       Else
         index = index + 1
       End If

Loop

Close 1
Open Filename For Binary As #1
index = 1

Do Until EOF(1)
       Get #1, index, B

       If B = 68 Then
         index = index + 1
         Get #1, index, B

         If B = 80 Then
            index = index + 1
            Get #1, index, B

            If B = 66 Then
                   Put #1, index + 1, 10
            End If
         End If

       Else
         index = index + 1
       End If

Loop

Close 1
Open Filename For Binary As #1
index = 1

Do Until EOF(1)
       Get #1, index, B

       If B = 71 Then
         index = index + 1
         Get #1, index, B

         If B = 67 Then
            Put #1, index + 1, 10
         End If

       Else
         index = index + 1
       End If

Loop

Close 1

DoEvents
End Sub

liuninglook

标记 标记 标记