应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜    

CyRhmU.jpeg
小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Windows编程 » 自毁文件
51/1返回列表
查看: 5193  |  回复: 7
只看楼主@他人 存档 新回复提醒 (忽略) 收藏    在APP中查看
当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

艾尔熙德

银虫 (初入文坛)

[求助] 自毁文件已有2人参与

我想为我的文件加密，打开文件时需要输入密码，有3次机会，否则文件自毁或者自动删除。怎么实现这个加密？请高手指点？

[ 发自手机版 http://muchong.com/3g ]
回复此楼

» 猜你喜欢
1楼2013-10-18 11:06:33
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

43fd6ys

木虫 (正式写手)

【答案】应助回帖

所谓自毁,应该是失去功能.
可考虑在注册表中作一失效标记,或使用文件记录失效标识.
赞一下 回复此楼
6楼2015-07-24 21:24:00
 已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 8 个回答

沉默boy

木虫 (著名写手)

这是啥

【答案】应助回帖

我想你还是别这样想了，因为别人可以复制出好几份，然后一个一个试，当然所谓的复制以及一个一个试也是可以用程序实现的。。。。。
赞一下(3人) 回复此楼
总说平等，但是平等在哪里？
2楼2013-12-02 09:50:13
 已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

leroew

金虫 (小有名气)

【答案】应助回帖

Sub Auto_Open()
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject"
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(ThisWorkbook.Path)))
    s = d.serialnumber    '磁盘序列号
    If s = 1747673830 Then Exit Sub '要使用的电脑磁盘序列号
   
    Dim FirstDate, de, days
    FirstDate = Date
    de = GetSetting("XXX", "YYY", "date", ""  '从注册表取值
    If de = "" Then   '如果取不到值
        SaveSetting "XXX", "YYY", "date", FirstDate  '把日期保存到注册表
        MsgBox "本文件可使用60天，今天是第1次使用", , "提示"
    Else
        days = Date - CDate(de)  '计算文件使用的天数
        If days > 60 Then    '如果文件使用超过60天
            MsgBox "已超过使用期限，本文件将自杀", , "警告"
            ThisWorkbook.ChangeFileAccess xlReadOnly  '改为只读属性
            Kill ThisWorkbook.FullName  '自杀
            ThisWorkbook.Close False  '关闭不保存
        End If
        MsgBox "本文件已使用" & days & "天，还有" & 60 - days & "天可使用", , "提示"
    End If
End Sub

获取CPUID号.xls


  Private Sub ToggleButton1_Click()
  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2"
    Set colDevices = objWMIService.ExecQuery("Select * From Win32_Processor"
    For Each objDevice In colDevices
        ID = objDevice.ProcessorID
    Next
    MsgBox "你的CPU号是" & ID
     Range("A4".Value = ID
End Sub

获取没个盘的序列号.xls


Private Sub Workbook_Open()
  Dim fs, d, s
    On Error Resume Next
    For i = 3 To 26
    Set fs = CreateObject("Scripting.FileSystemObject"
    Set d = fs.GetDrive(Chr(64 + i) & ":"
    s = d.serialnumber    '′??ìDòáDo?
    Cells(i, 2) = d.serialnumber
    Cells(i, 1) = Chr(64 + i) & ":"
    Next i

End Sub

硬盘VBA-ID.xls（类模块）

Option Explicit
Private Const VER_PLATFORM_WIN32S = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const CREATE_NEW = 1

Private Enum HDINFO
    HD_MODEL_NUMBER
    HD_SERIAL_NUMBER
    HD_FIRMWARE_REVISION
End Enum

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Type IDEREGS
    bFeaturesReg As Byte
    bSectorCountReg As Byte
    bSectorNumberReg As Byte
    bCylLowReg As Byte
    bCylHighReg As Byte
    bDriveHeadReg As Byte
    bCommandReg As Byte
    bReserved As Byte
End Type

Private Type SENDCMDINPARAMS
    cBufferSize As Long
    irDriveRegs As IDEREGS
    bDriveNumber As Byte
    bReserved(1 To 3) As Byte
    dwReserved(1 To 4) As Long
End Type

Private Type DRIVERSTATUS
    bDriveError As Byte
    bIDEStatus As Byte
    bReserved(1 To 2) As Byte
    dwReserved(1 To 2) As Long
End Type

Private Type SENDCMDOUTPARAMS
    cBufferSize As Long
    DStatus As DRIVERSTATUS
    bBuffer(1 To 512) As Byte
End Type

Private Declare Function GetVersionEx _
    Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function CreateFile _
    Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Private Declare Function CloseHandle _
    Lib "kernel32" _
    (ByVal hObject As Long) As Long
Private Declare Function DeviceIoControl _
    Lib "kernel32" _
    (ByVal hDevice As Long, _
    ByVal dwIoControlCode As Long, _
    lpInBuffer As Any, _
    ByVal nInBufferSize As Long, _
    lpOutBuffer As Any, _
    ByVal nOutBufferSize As Long, _
    lpBytesReturned As Long, _
    ByVal lpOverlapped As Long) As Long
   
Private Declare Sub ZeroMemory _
    Lib "kernel32" Alias "RtlZeroMemory" _
    (dest As Any, _
    ByVal numBytes As Long)

Private Declare Sub CopyMemory _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

Private Declare Function GetLastError _
    Lib "kernel32" () As Long

Private mvarCurrentDrive As Byte
Private mvarPlatform As String

Public Function GetModelNumber() As String
    GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER)
End Function

Public Function GetSerialNumber() As String
    GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER)
End Function

Public Property Get Platform() As String
    Platform = mvarPlatform
End Property

Private Sub Class_Initialize()
  Dim OS As OSVERSIONINFO
  OS.dwOSVersionInfoSize = Len(OS)
  Call GetVersionEx(OS)
  mvarPlatform = "Unk"
  Select Case OS.dwPlatformId
    Case Is = VER_PLATFORM_WIN32S
         mvarPlatform = "32S"
    Case Is = VER_PLATFORM_WIN32_WINDOWS
         If OS.dwMinorVersion = 0 Then
            mvarPlatform = "W95"
         Else
            mvarPlatform = "W98"
         End If
    Case Is = VER_PLATFORM_WIN32_NT
         mvarPlatform = "WNT"
  End Select
End Sub

Private Function CmnGetHDData(hdi As HDINFO) As String
  Dim bin As SENDCMDINPARAMS
  Dim bout As SENDCMDOUTPARAMS
  Dim hdh As Long
  Dim br As Long
  Dim ix As Long
  Dim hddfr As Long
  Dim hddln As Long
  Dim s As String
   
  Select Case hdi
    Case HD_MODEL_NUMBER
         hddfr = 55
         hddln = 40
    Case HD_SERIAL_NUMBER
         hddfr = 21
         hddln = 20
    Case HD_FIRMWARE_REVISION
         hddfr = 47
         hddln = 8
    Case Else
         Err.Raise 10001, "Illegal HD Data type"
  End Select
   
  Select Case mvarPlatform
    Case "WNT"
         hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive, _
               GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, _
               0, OPEN_EXISTING, 0, 0)
    Case "W95", "W98"
         hdh = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
    Case Else
         Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)"
    End Select
   
    If hdh = 0 Then Err.Raise 10003, , "Error on CreateFile"

    ZeroMemory bin, Len(bin)
    ZeroMemory bout, Len(bout)
    With bin
        .bDriveNumber = mvarCurrentDrive
        .cBufferSize = 512
        With .irDriveRegs
            If (mvarCurrentDrive And 1) Then
                .bDriveHeadReg = &HB0
            Else
                .bDriveHeadReg = &HA0
            End If
            .bCommandReg = &HEC
            .bSectorCountReg = 1
            .bSectorNumberReg = 1
        End With
    End With
    DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, _
                    bin, Len(bin), bout, Len(bout), br, 0
   
    s = ""
    For ix = hddfr To hddfr + hddln - 1 Step 2
        If bout.bBuffer(ix + 1) = 0 Then Exit For
        s = s & Chr(bout.bBuffer(ix + 1))
        If bout.bBuffer(ix) = 0 Then Exit For
        s = s & Chr(bout.bBuffer(ix))
    Next ix
   
    CloseHandle hdh

    CmnGetHDData = Trim(s)
   
End Function
赞一下 回复此楼
怎么去除广告，用google chorme点击扩展程序找到Adblock Pro 2.5 ，和。视频广告屏蔽 + 嗅探 + 下载(3合1)超强绿色纯净版 6.1.5。自行加载就可以了。
3楼2013-12-03 16:43:24
 已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

virtualzx

木虫 (著名写手)

【答案】应助回帖

加密很容易实现；只要选择一个好一点的密码就基本没有破解的可能。

删除貌似没有意义。另外即使你自己的文件，三次输入错误是很容易发生的事情，到时候你就郁闷吧。
赞一下 回复此楼
4楼2013-12-04 03:04:52
 已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 8 个回答
普通表情 龙 兔 虎 猫
信息提示
关闭
请填处理意见
关闭