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

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Windows编程 » 自毁文件
北京石油化工学院2026年研究生招生接收调剂公告
81/1返回列表
查看: 5327  |  回复: 7
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看

艾尔熙德

银虫 (初入文坛)

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

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

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

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

沉默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的回帖

longe87

铜虫 (小有名气)

【答案】应助回帖

用winrar， 就可以简单的加密啦。
实现自毁文件的话， 这种现成工具我没有找到。
自己编程实现一个，工作量有点大呢。
赞一下 回复此楼
看竹何须问主人
5楼2013-12-04 09:21:05
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

43fd6ys

木虫 (正式写手)

【答案】应助回帖

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

deephill

铁杆木虫 (职业作家)

【答案】应助回帖

我觉得可以调用windows 的批处理来进行。让dos命令来删除最核心的文件。
赞一下 回复此楼
7楼2016-12-15 00:03:26
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

westskyoo7
顶一下，感谢分享！

发自小木虫Android客户端
8楼2017-05-14 00:39:17
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 艾尔熙德 的主题更新
81/1返回列表
普通表情 龙 兔 虎 猫
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 求调剂 一志愿西南交通大学085701环境工程 282分 +10 多多爱吃汉堡 2026-04-04 10/500 2026-04-06 22:57 by chenzhimin
[考研] 0703化学 +9 goldtt 2026-04-02 11/550 2026-04-06 10:35 by 无际的草原
[考研] 372分，材料与化工，一志愿湖南大学，求调剂 +3 蓝笺片 2026-04-01 3/150 2026-04-06 09:04 by 无际的草原
[考研] 070300化学学硕311分求调剂 +11 梁富贵险中求 2026-04-04 13/650 2026-04-06 07:24 by houyaoxu
[考研] 316求调剂 +5 yyx想调剂 2026-04-05 5/250 2026-04-05 22:22 by 咔咔咔咔9
[考研] 生物与医药086000调剂一志愿西北农林320分 +3 美美女士 2026-04-03 3/150 2026-04-05 21:55 by 学员8dgXkO
[考研] 322求调剂 +3 嗯哼哼恒 2026-04-05 3/150 2026-04-05 19:52 by nepu_uu
[考研] 一志愿电子科技大学085600材料与化工 329分求调剂 +10 Naiko 2026-04-04 10/500 2026-04-05 09:40 by sam3303
[考研] 一志愿郑大0705求调剂 +3 橘十一 2026-04-02 4/200 2026-04-05 00:05 by chongya
[考研] 294求调剂 +6 Grey_Ey 2026-04-02 9/450 2026-04-04 22:07 by hemengdong
[考研] 求调剂 +4 晟功? 2026-04-03 4/200 2026-04-04 21:58 by hemengdong
[考研] 085400电子信息319求调剂（接受跨专业调剂） +5 星星不眨眼喽 2026-04-03 6/300 2026-04-04 21:50 by hemengdong
[考研] 306求调剂 +3 hyb上名工 2026-04-02 3/150 2026-04-04 18:12 by 热情沙漠
[考研] 319求调剂 +4 星星不眨眼喽 2026-04-03 4/200 2026-04-04 16:25 by 中飞院空管学院�
[考研] 化工求调剂 +11 荔香芝士椰奶 2026-04-03 11/550 2026-04-03 22:06 by 啵啵啵0119
[考研] 274求调剂 +10 薛定谔的虎。 2026-04-01 10/500 2026-04-03 10:13 by tianyyysss
[考研] 322求调剂 +5 熹僖XX 2026-03-31 6/300 2026-04-02 10:08 by 求调剂zz
[考研] 一志愿346上海大学生物学 +3 上海大学346调剂 2026-04-01 3/150 2026-04-02 08:36 by w虫虫123
[考研] 304求调剂 +12 素年祭语 2026-03-31 15/750 2026-04-01 22:41 by peike
[考研] 286求调剂 +5 Sa67890. 2026-04-01 7/350 2026-04-01 19:50 by 6781022
信息提示
关闭
请填处理意见
关闭