[VBA]VBA编写的时光倒流软件
2007-01-29 09:54
435 查看
目的:
目前有很多共享软件都有试用期,过了使用期后就不能使用了。但是把系统时间退回去又可以使用了。我们可以简单的利用VBA技术把系统时间该回去执行共享软件。
原理:
1.设定打开程序的路径
2.打开前取得系统时间
3.把系统时间调整到启动程序的安装时间到过期时间中的任意一个时间
4.把系统时间设置到启动前的时间。
5.把自动关闭设置为自动的话,下次启动的时间就会自动启动默认程序。
画面:
------------------------------------------------
閉じる: [自動 ▼]
[実行] [・・・] [C:/Windwos/notepad.exe ]
[実行] [・・・] [ ]
[実行] [・・・] [ ]
------------------------------------------------
ThisBook的代码:
Private Sub Workbook_Open()
Dim sPath As String
Dim execDate As String
If Cells(5, 7).Value = "自動" Then
sPath = Cells(7, 16).Value
execDate = Cells(7, 11).Value
If doExec(sPath, execDate) = True Then
ThisWorkbook.Close
End If
End If
End Sub
------------------------------------------------------------------------------------------------------------------------------------
Sheet1的代码:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sPath As String
Dim execDate As String
If Target.Cells(1, 1) = "実行" Then
sPath = Cells(Target.Row, 16).Value
execDate = Cells(Target.Row, 11).Value
Call doExec(sPath, execDate)
ElseIf Target.Cells(1, 1) = "・・・" Then
sPath = Cells(Target.Row, 16).Value
Call doGetPath(sPath)
If sPath <> "" Then
Cells(Target.Row, 16).Value = sPath
ThisWorkbook.Save
End If
End If
Cells(Target.Row, 2).Select
End Sub
-----------------------------------------------------------------------------------------------------------------------------------
添加bas的代码:
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Function doExec(ByVal sPath As String, ByVal execDate As String) As Boolean
Dim dCurrDate As Date
On Error GoTo ERR_FUN
dCurrDate = Date
If Trim(execDate) = "" Then
MsgBox "実行日付を設定してください。"
doExec = False
Exit Function
ElseIf Trim(sPath) = "" Then
MsgBox "実行プログラムのパスを設定してください。"
doExec = False
Exit Function
End If
Date = execDate
Call Shell(sPath, vbMaximizedFocus)
Date = dCurrDate
doExec = True
Exit Function
ERR_FUN:
doExec = False
MsgBox Err.Description
End Function
Sub doGetPath(ByRef sPath As String)
Dim ofn As OPENFILENAME
Dim rtn As String
On Error GoTo ERR_FUN
ofn.lStructSize = Len(ofn)
'ofn.hwndOwner = Me.
'ofn.hInstance = Me.Application.hInstance
ofn.lpstrFilter = "*.exe"
ofn.lpstrFile = Space(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = sPath
ofn.lpstrTitle = "打開文件"
ofn.flags = 6148
rtn = GetOpenFileName(ofn)
If rtn >= 1 Then
sPath = ofn.lpstrFile
Else
sPath = ""
End If
Exit Sub
ERR_FUN:
MsgBox Err.Description
End Sub
目前有很多共享软件都有试用期,过了使用期后就不能使用了。但是把系统时间退回去又可以使用了。我们可以简单的利用VBA技术把系统时间该回去执行共享软件。
原理:
1.设定打开程序的路径
2.打开前取得系统时间
3.把系统时间调整到启动程序的安装时间到过期时间中的任意一个时间
4.把系统时间设置到启动前的时间。
5.把自动关闭设置为自动的话,下次启动的时间就会自动启动默认程序。
画面:
------------------------------------------------
閉じる: [自動 ▼]
[実行] [・・・] [C:/Windwos/notepad.exe ]
[実行] [・・・] [ ]
[実行] [・・・] [ ]
------------------------------------------------
ThisBook的代码:
Private Sub Workbook_Open()
Dim sPath As String
Dim execDate As String
If Cells(5, 7).Value = "自動" Then
sPath = Cells(7, 16).Value
execDate = Cells(7, 11).Value
If doExec(sPath, execDate) = True Then
ThisWorkbook.Close
End If
End If
End Sub
------------------------------------------------------------------------------------------------------------------------------------
Sheet1的代码:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sPath As String
Dim execDate As String
If Target.Cells(1, 1) = "実行" Then
sPath = Cells(Target.Row, 16).Value
execDate = Cells(Target.Row, 11).Value
Call doExec(sPath, execDate)
ElseIf Target.Cells(1, 1) = "・・・" Then
sPath = Cells(Target.Row, 16).Value
Call doGetPath(sPath)
If sPath <> "" Then
Cells(Target.Row, 16).Value = sPath
ThisWorkbook.Save
End If
End If
Cells(Target.Row, 2).Select
End Sub
-----------------------------------------------------------------------------------------------------------------------------------
添加bas的代码:
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Function doExec(ByVal sPath As String, ByVal execDate As String) As Boolean
Dim dCurrDate As Date
On Error GoTo ERR_FUN
dCurrDate = Date
If Trim(execDate) = "" Then
MsgBox "実行日付を設定してください。"
doExec = False
Exit Function
ElseIf Trim(sPath) = "" Then
MsgBox "実行プログラムのパスを設定してください。"
doExec = False
Exit Function
End If
Date = execDate
Call Shell(sPath, vbMaximizedFocus)
Date = dCurrDate
doExec = True
Exit Function
ERR_FUN:
doExec = False
MsgBox Err.Description
End Function
Sub doGetPath(ByRef sPath As String)
Dim ofn As OPENFILENAME
Dim rtn As String
On Error GoTo ERR_FUN
ofn.lStructSize = Len(ofn)
'ofn.hwndOwner = Me.
'ofn.hInstance = Me.Application.hInstance
ofn.lpstrFilter = "*.exe"
ofn.lpstrFile = Space(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = sPath
ofn.lpstrTitle = "打開文件"
ofn.flags = 6148
rtn = GetOpenFileName(ofn)
If rtn >= 1 Then
sPath = ofn.lpstrFile
Else
sPath = ""
End If
Exit Sub
ERR_FUN:
MsgBox Err.Description
End Sub
相关文章推荐
- 我的航拍直升机 控制基站软件的编写历程(三)——开始读QMK-GroundStation的代码
- 简述软件测试的编写规范
- java编写日记软件
- 计算机软件开发文档编写指南
- 利用Java技术编写桌面软件基础
- 一个C#编写QQ接口软件--QQ协议
- Day2 如何在没有安装halcon软件的电脑上运行halcon编写的程序
- 高级Linux程序设计第二章:编写良好的Linux软件
- (第二天)编写训练记忆软件--数字编码矩阵V1.0
- 编写一个服务监控及管理的软件
- 我想用java编写一类似VP-EYE的视频软件,该看何java资料啊!!
- 软件文档编写向导
- 如何自己编写一个交通仿真软件(二)原野。
- 关于VBA和Excel,GIS软件
- 编写了一个通过手机短信平台收发短信的软件
- QT 串口通讯软件编写
- 用PB编写一个简单的网络信息收集小工具软件
- 时光倒流
- 软件项目开发过程中应编写的十三类文档
- 软件测试技术JUnit和单元测试入门简介--单元测试及软件测试技术概念以及JUnit编写原则和特征