// D:\SaveLog\_SaveLog.dpr立即备份晓亮的电脑操作记录热键(快捷键) F11由于原来的 AutoIt 杀毒软件总是误报没办法只好麻烦一点用 Delphi XE4 做了
// D:\SaveLog\_SaveLog.dpr立即备份晓亮的电脑操作记录
热键(快捷键) F11由于原来的 AutoIt 杀毒软件总是误报没办法只好麻烦一点用 Delphi 各种版本 做了
(我主要用的版本是Delphi2007(Delphi11))
(从Delphi6到Embarcadero.Delphi.XE5.Lite)
// D:\SaveLog\_SaveLog.dpr立即备份晓亮的电脑操作记录
热键(快捷键) F11由于原来的 AutoIt 杀毒软件总是误报没办法只好麻烦一点用 Delphi XE4 做了
/// /////////////////////////////////////////////////////////////////////////
// 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 不带下划线的是正式版(当前正在使用的版本) //
/// /////////////////////////////////////////////////////////////////////////
program _SaveLog;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
//Application.MainFormOnTaskbar := False;
Application.ShowMainForm := False;
Application.CreateForm(TForm1, Form1);
Form1.Visible := False;
Application.Run;
end.
{*******************************************************}
{ }
{ _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, ExtCtrls, ShellApi;
const
WM_ICONTRAY = WM_USER + 2;
NIF_INFO = $10;
NIIF_INFO = $00000001;
type
TDUMMYUNIONNAME = record
case Integer of
0: (uTimeout: UINT);
1: (uVersion: UINT);
end;
TNotifyIconData = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of Char;
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of Char;
DUMMYUNIONNAME: TDUMMYUNIONNAME;
szInfoTitle: array[0..63] of Char;
dwInfoFlags: DWORD;
end;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
TrayIconData: TNotifyIconData;
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] -hp637 -isnd -m5 C:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
CreateDir('D:\SaveLog\');
WinExec('D:\SaveLog\rar a -ag[yyyy-mm-dd] -hp637 -isnd -m5 D:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
CreateDir('D:\快盘\');
CreateDir('D:\快盘\SaveLog\');
WinExec('D:\SaveLog\rar a -ag[yyyy-mm-dd] -hp637 -isnd -m5 D:\快盘\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
CreateDir('E:\SaveLog\');
WinExec('D:\SaveLog\rar a -ag[yyyy-mm-dd] -hp637 -isnd -m5 E:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
CreateDir('F:\SaveLog\');
WinExec('D:\SaveLog\rar a -ag[yyyy-mm-dd] -hp637 -isnd -m5 F:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
CreateDir('G:\SaveLog\');
WinExec('D:\SaveLog\rar a -ag[yyyy-mm-dd] -hp637 -isnd -m5 G:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
CreateDir('H:\SaveLog\');
WinExec('D:\SaveLog\rar a -ag[yyyy-mm-dd] -hp637 -isnd -m5 H:\SaveLog\晓亮的电脑操作记录备份SaveLog.rar D:\SaveLog\_SaveLog.txt',
SW_HIDE);
{
CreateDir('C:\SaveLog\');
WinExec(PansiChar(ExtractFileDir(Application.ExeName) +
'\rar a -ag[yyyy-mm-dd] -hp637 -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] -hp637 -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
sleep(2000);
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!备份失败！D:\SaveLog\');
if (CreateDir('D:\快盘\SaveLog\')) or (CopyFile('D:\SaveLog\_SaveLog.txt', PChar('D:\快盘\SaveLog\' + FormatDateTime('yyyy年mm月dd日', now()) +
'晓亮的电脑操作记录备份MyPCLog.txt'), False)) then
// 而且,請確保你的文件路徑正確,否則函數返回失敗.
// ShowMessage('Copy File Completed!')
else
ShowMessage('Please Login KuaiPan!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;
FTitle, FText: string;
begin
// if (msg.LParamHi = VK_F11) and (msg.LParamLo = MOD_ALT) then
if msg.LParamHi = vk_f11 then // 如果按下热键(快捷键) [F11]
begin
{
begin
TrayIconData.cbSize := SizeOf(TrayIconData);
TrayIconData.uFlags := NIF_INFO;
Ftext := '正在备份 SaveLog.txt ... '; //这里显示气球提示的内容
strPLCopy(TrayIconData.szInfo, Ftext, SizeOf(TrayIconData.szInfo) - 1);
Ftitle := '正在备份 SaveLog.txt ... ';//气球提示标题
strPLCopy(TrayIconData.szInfoTitle, Ftitle, SizeOf(TrayIconData.szInfoTitle) - 1);
TrayIconData.dwInfoFlags := NIIF_INFO; //图标类型
Shell_NotifyIcon(NIM_MODIFY, @TrayIconData);
end;
}
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.
// D:\SaveLog\_SaveLog.dpr立即备份晓亮的电脑操作记录
热键(快捷键) F11由于原来的 AutoIt 杀毒软件总是误报没办法只好麻烦一点用 Delphi 各种版本 做了
(从Delphi6到Embarcadero.Delphi.XE5.Lite)
