| 查看: 5353 | 回复: 7 | ||
| 当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖 | ||
[求助]
自毁文件 已有2人参与
|
||
|
我想为我的文件加密，打开文件时需要输入密码，有3次机会，否则文件自毁或者自动删除。怎么实现这个加密？请高手指点？ [ 发自手机版 http://muchong.com/3g ] |
回复此楼» 猜你喜欢
急需调剂
已经有8人回复
-
申博/考博
已经有4人回复
-
化工学硕294分，求导师收留
已经有37人回复
-
求调剂
已经有11人回复
-
260求调剂
已经有4人回复
-
一志愿华中农业071010，320求调剂
已经有19人回复
-
304求调剂
已经有7人回复
-
求博导｜生物质基多孔碳/超级电容方向，已有相关成果，寻能源材料/碳材料方向老师
已经有3人回复
-
二苯甲酮酸类衍生物
已经有6人回复
-
接受任何调剂
已经有4人回复
longe87
铜虫 (小有名气)
- 应助: 7 (幼儿园)
- 金币: 1608.8
- 散金: 20
- 红花: 2
- 帖子: 176
- 在线: 55.7小时
- 虫号: 2738412
- 注册: 2013-10-20
- 性别: GG
- 专业: 计算机应用技术
5楼2013-12-04 09:21:05
沉默boy
木虫 (著名写手)
这是啥
- 应助: 8 (幼儿园)
- 金币: 1913.6
- 散金: 1019
- 红花: 2
- 帖子: 1155
- 在线: 141小时
- 虫号: 1440448
- 注册: 2011-10-13
- 性别: GG
- 专业: 光学
2楼2013-12-02 09:50:13
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 = IDEnd 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 |
3楼2013-12-03 16:43:24
virtualzx
木虫 (著名写手)
- 应助: 263 (大学生)
- 金币: 7161.3
- 红花: 54
- 帖子: 1605
- 在线: 317.6小时
- 虫号: 2069080
- 注册: 2012-10-18
- 性别: GG
- 专业: 理论和计算化学
4楼2013-12-04 03:04:52
20