24小时热门版块排行榜

返回列表

当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

艾尔熙德

银虫 (初入文坛)

应助: 0 (幼儿园)
金币: 501
帖子: 22
在线: 10.9小时
虫号: 1596676
注册: 2012-02-02
性别: GG

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

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

[ 发自手机版 http://muchong.com/3g ]

回复此楼

» 猜你喜欢

天津工业大学郑柳春团队欢迎化学化工、高分子化学或有机合成方向的博士生和硕士生加入已经有4人回复
康复大学泰山学者周祺惠团队招收博士研究生已经有6人回复
AI论文写作工具：是科研加速器还是学术作弊器？已经有3人回复
孩子确诊有中度注意力缺陷已经有6人回复
2026博士申请-功能高分子，水凝胶方向已经有6人回复
论文投稿，期刊推荐已经有4人回复
硕士和导师闹得不愉快已经有13人回复
请问2026国家基金面上项目会启动申2停1吗已经有5人回复
同一篇文章，用不同账号投稿对编辑决定是否送审有没有影响？已经有3人回复
RSC ADV状态问题已经有4人回复

1楼2013-10-18 11:06:33

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

leroew

金虫 (小有名气)

应助: 3 (幼儿园)
金币: 1299.9
散金: 11
帖子: 117
在线: 55.5小时
虫号: 2711932
注册: 2013-10-10
性别: GG
专业: 通信理论与系统

【答案】应助回帖

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