_SaveLog.dpr立即备份晓亮的电脑操作记录热键(快捷键) F11由于原来的 AutoIt 杀毒软件总是误报
{*******************************************************}
{ }
{ _SaveLog.exe }
{ }
{ 版权所有 (C) 2013 DelphiCHM }
{ }
{*******************************************************}
/// /////////////////////////////////////////////////////////////////////////
// D:\SaveLog\_SaveLog.dpr //
// 立即备份晓亮的电脑操作记录 //
// 热键(快捷键) F11 //
// 由于原来的 AutoIt 杀毒软件总是误报 //
// 没办法只好麻烦一点用 Delphi XE4 做了 //
// 反正不会可以查询搜索引擎 百度谷歌搜狗 //
// http://www.baidu.com/ //
// http://www.cnblogs.com/delphichm/ //
// 执行顺序 启动EditPlus 激活EditPlus窗口 插入当前日期和时间 备份文件 //
// CnPack 工程备份热键(快捷键) ALT + NQB //
// 2013年11月2日 晓亮 //
// _SaveLog.exe 测试版(当前调试的版本) //
// SaveLog.exe 不带下划线的是正式版(当前正在使用的版本) //
// 需要改进的地方: 1 相对路径(在任意文件夹下都可以运行) //
// 2 过滤重复输入 //
// 3 当打开EditPlus但是不是SaveLog.txt时 //
/// /////////////////////////////////////////////////////////////////////////
unit Unit1;
interface
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
Tlhelp32, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
myatom: atom;
procedure hotkey(var msg: tmessage); message wm_hotkey; // 定义全局热键消息事件
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
a, b: integer;
isRuningLocked: Boolean;
implementation
{$R *.dfm}
{ -------------------------------------------------------------------------------
过程名: TForm1.FormCreate
作者: Administrator
日期: 2013.11.04
参数: Sender: TObject
返回值: 无
作用: 在窗口创建时注册全局热键(Windows快捷键)
------------------------------------------------------------------------------- }
procedure TForm1.FormCreate(Sender: TObject);
begin
myatom := globaladdatom('hotkey1'); // 设置全局热键ID
RegisterHotKey(handle, myatom, 0, vk_f11); // 注册热键
end;
{ -------------------------------------------------------------------------------
过程名: ProcedureIsExists
作者: Administrator
日期: 2013.11.04
参数: AppName: string
返回值: Boolean
作用: 判断一个程序是否已经在运行
用法: if ProcedureIsExists('EditPlus.exe') then
------------------------------------------------------------------------------- }
function ProcedureIsExists(AppName: string): Boolean;
var
lppe: TProcessEntry32;
ssHandle: THandle;
AppFound, findqq: Boolean;
Wnd: HWND;
begin
Result := False;
ssHandle := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
lppe.dwSize := SizeOf(lppe);
AppFound := Process32First(ssHandle, lppe);
while AppFound do
begin
// 其中lppe.szExefile就是程序名**********************************************
if UpperCase(ExtractFileName(lppe.szExeFile)) = UpperCase(AppName) then
begin
Result := True;
Exit;
end;
AppFound := Process32Next(ssHandle, lppe);
end;
end;
{ -------------------------------------------------------------------------------
过程名: WinActivate
作者: Administrator
日期: 2013.11.04
参数:
返回值: 无
作用: (测试版)激活指定的窗口(设置焦点到该窗口,使其成为活动窗口).
------------------------------------------------------------------------------- }
procedure WinActivate();
var
buf: array [Byte] of Char;
Found: HWND;
Found1: HWND;
begin
Found := FindWindow(nil, 'D:\SaveLog\_SaveLog.txt * - EditPlus');
if Found <> 0 then
begin
PostMessage(Found, WM_SYSCOMMAND, SC_MAXIMIZE, 0); // 最大化
SetForegroundWindow(Found);
SetWindowPos(Found, HWND_TOP, 0, 0, Screen.Width, Screen.Height,
SWP_SHOWWINDOW);
end;
Found1 := FindWindow(nil, 'D:\SaveLog\_SaveLog.txt - EditPlus');
if Found1 <> 0 then
begin
PostMessage(Found1, WM_SYSCOMMAND, SC_MAXIMIZE, 0); // 最大化
SetForegroundWindow(Found1);
SetWindowPos(Found1, HWND_TOP, 0, 0, Screen.Width, Screen.Height,
SWP_SHOWWINDOW);
end;
end;
{ -------------------------------------------------------------------------------
过程名: WinActive
作者: Administrator
日期: 2013.11.04
参数: PartOfTitle:string
返回值: Boolean
作用: 检查指定的窗口是否存在且当前被激活.
用法: 具体用法与 AutoIt3 相同,可以参考 AutoIt3CHS.CHM中文帮助
或者 http://www.autoitx.com/ AUTOIT CN AutoIt中文论坛
------------------------------------------------------------------------------- }
// function WinActive(PartOfWinTitle: string): Boolean;
function WinActive(): Boolean;
var
buf: array [Byte] of Char;
begin
GetWindowText(GetForegroundWindow, buf, Length(buf) * SizeOf(buf[0]));
if (buf = 'D:\SaveLog\_SaveLog.txt * - EditPlus') or
(buf = 'D:\SaveLog\_SaveLog.txt - EditPlus') then
begin
Result := True;
Exit;
end
else
begin
Result := False;
Exit;
end;
end;
procedure KeyDownAndUp(VKValue: Byte);
begin
keybd_event(VKValue, 0, 0, 0);
keybd_event(VKValue, 0, KEYEVENTF_KEYUP, 0);
end;
{ -------------------------------------------------------------------------------
过程名: InputDateTime
作者: Administrator
日期: 2013.11.04
参数:
返回值: 无
作用: 插入长格式的当前日期和时间到指定窗口(EditPlus)
------------------------------------------------------------------------------- }
procedure InputDateTime();
var
i: integer; // 插入字符用
begin
keybd_event(VK_CONTROL, 0, 0, 0);
KeyDownAndUp(VK_END); // 输入光标移到最后
keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0);
KeyDownAndUp(VK_RETURN); // 输入回车键
KeyDownAndUp(VK_RETURN); // 输入回车键
// 按下 Alt键,直到 KEYUP 为止
keybd_event(VK_MENU, 0, 0, 0); // 按下 Alt键,直到 KEYUP 为止
// 按下 Alt键,直到 KEYUP 为止
KeyDownAndUp(69); // ALT + EIL
KeyDownAndUp(73);
KeyDownAndUp(76);
keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
KeyDownAndUp(VK_SPACE);
// 按下 Alt键,直到 KEYUP 为止
keybd_event(VK_MENU, 0, 0, 0); // 按下 Alt键,直到 KEYUP 为止
// 按下 Alt键,直到 KEYUP 为止
KeyDownAndUp(69); // ALT + EIO
KeyDownAndUp(73);
KeyDownAndUp(79);
keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
KeyDownAndUp(VK_SPACE);
for i := 0 to 31 do
begin
KeyDownAndUp(189); // 插入减号,Delphi__VK
end;
KeyDownAndUp(VK_RETURN); // 输入回车键
Sleep(100);
keybd_event(VK_CONTROL, 0, 0, 0); // 按下 Alt键,直到 KEYUP 为止
KeyDownAndUp(83); // CTRL + S立即保存 --
keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0);
end;
// function RARBackupFiles(FileName:string,Drv:string):Boolean;
{ -------------------------------------------------------------------------------
过程名: RARBackupFiles
作者: Administrator
日期: 2013.11.04
参数:
返回值: Boolean
作用: 压缩备份文档 SaveLog.txt
------------------------------------------------------------------------------- }
function RARBackupFiles(): Boolean;
begin
try
// ------------------------------------------------------------------------------
// 压缩备份文档 SaveLog.txt
// ------------------------------------------------------------------------------
if FileExists('D:\SaveLog\rar.exe') then
begin
// ShowMessage('000');
CreateDir('C:\SaveLog\');
WinExec('D:\SaveLog\rar a -ag[yyyy-mm-dd] -isnd -m5 C:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
CreateDir('D:\SaveLog\');
WinExec('D:\SaveLog\rar a -ag[yyyy-mm-dd] -isnd -m5 D:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
{
CreateDir('C:\SaveLog\');
WinExec(PansiChar(ExtractFileDir(Application.ExeName) +
'\rar a -ag[yyyy-mm-dd] -isnd -m5 C:\MyPCLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt'),
SW_HIDE);
CreateDir('D:\SaveLog\');
WinExec(PansiChar(ExtractFileDir(Application.ExeName) +
'\rar a -ag[yyyy-mm-dd] -isnd -m5 D:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt'),
SW_HIDE);
}
end
else
ShowMessage('没有找到文件 RAR.exe');
Result := True;
except
Result := False;
end;
end;
{ -------------------------------------------------------------------------------
过程名: BackupSaveLog
作者: Administrator
日期: 2013.11.04
参数:
返回值: 无
作用: 备份SaveLog.txt文档到各分区
------------------------------------------------------------------------------- }
procedure BackupSaveLog();
begin
if CopyFile('D:\SaveLog\_SaveLog.txt',
PChar('D:\SaveLog\' + FormatDateTime('yyyy年mm月dd日', now()) +
'晓亮的电脑操作记录备份MyPCLog.txt'), False) then
// 而且,請確保你的文件路徑正確,否則函數返回失敗.
// ShowMessage('Copy File Completed!')
else
ShowMessage('Copy File Failed!备份失败！');
if RARBackupFiles then
// result:=true;
else
ShowMessage('RAR File Backup Failed! RAR压缩备份失败！');
end;
{ -------------------------------------------------------------------------------
过程名: TForm1.hotkey
作者: Administrator
日期: 2013.11.04
参数: var msg: tmessage
返回值: 无
作用: 定义全局热键(快捷键)响应事件,定义当用户按下热键时的操作
------------------------------------------------------------------------------- }
procedure TForm1.hotkey(var msg: tmessage); // 热键响应事件
var
ExePath: string;
begin
// if (msg.LParamHi = VK_F11) and (msg.LParamLo = MOD_ALT) then
if msg.LParamHi = vk_f11 then // 如果按下热键(快捷键) [F11]
begin
while not WinActive do
begin
if ProcedureIsExists('EditPlus.exe') then
begin // EditPlus.exe已经运行,有可能打开的不是SaveLog.txt
WinActivate; // 激活窗口
KeyDownAndUp(VK_RETURN); // 输入回车键
Sleep(100);
keybd_event(VK_CONTROL, 0, 0, 0); // 按下 Alt键,直到 KEYUP 为止
KeyDownAndUp(83); // CTRL + S立即保存 --
keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0);
end
else
begin // EditPlus.exe还没有运行
while not ProcedureIsExists('EditPlus.exe') do
begin
ExePath := ExtractFileDir(Application.ExeName) +
'\EditPlus\EditPlus.exe';
if FileExists(ExePath) then
WinExec('.\EditPlus\EditPlus.exe .\_SaveLog.txt',
SW_SHOWMAXIMIZED);
end;
WinActivate;
InputDateTime;
end;
end;
BackupSaveLog; // 备份文档
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
globalDeleteatom(myatom);
end;
end.
