delphi模拟按键精灵自动控制PDF页面自动扩边的源代码

需要的环境：Adobe Acrobat 7.0 Professional  和   Quite Imposing Plus 1.5d Acrobat plugin  （qi160.exe）

程序界面：

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, RzTray, Vcl.ExtCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
Label2: TLabel;
Edit2: TEdit;
edtDownNum: TEdit;
Label3: TLabel;
Label4: TLabel;
BalloonHint1: TBalloonHint;
TrayIcon1: TTrayIcon;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses shellapi;
{$R *.dfm}

function Matchstrings(Source, pattern: String): Boolean;
var
pSource: array[0..255] of Char;
pPattern: array[0..255] of Char;
function MatchPattern(element, pattern: PChar): Boolean;
function IsPatternWild(pattern: PChar): Boolean;
begin
Result := StrScan(pattern, '*') <> nil;
if not Result then
Result := StrScan(pattern, '?') <> nil;
end;
begin
if 0 = StrComp(pattern, '*') then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else
begin
case pattern^ of
'*':
if MatchPattern(element, @pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1], pattern);
'?':
Result := MatchPattern(@element[1], @pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1], @pattern[1])
else
Result := False;
end;
end;
end;
begin
StrPCopy(pSource, Source);
StrPCopy(pPattern, pattern);
Result := MatchPattern(pSource, pPattern);
end; {匹配字符串函数}

{从磁盘中搜索指定类型的所有文件}
procedure FindFiles(ASourceDir, SearchFileType: String; var List: TStrings);
var
FileRec: TSearchrec;
Sour: String;
begin
Sour := ASourceDir;
if Sour[length(Sour)] <> '\' then
Sour := Sour + '\';
if FindFirst(Sour + '*.*', faAnyfile, FileRec) = 0 then
{循环}
repeat
if ((FileRec.Attr and faDirectory) <> 0) then
begin
if (FileRec.Name <> '.') and (FileRec.Name <> '..') then //找到目录
begin
FindFiles(Sour + FileRec.Name, SearchFileType, List);
end;
end
else //找到文件
begin
if Matchstrings(AnsiLowerCase(FileRec.Name), SearchFileType) then
begin
List.Add(Sour + FileRec.Name);
end; {拷贝所有类型的文件}
end;
until FindNext(FileRec) <> 0;
FindClose(FileRec);
end; {从磁盘中搜索指定类型的所有文件}

function ForceForegroundWindow(hwnd: HWND): Boolean;
const
SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
ForegroundThreadID: DWORD;
ThisThreadID: DWORD;
timeout: DWORD;
begin
if IsIconic(hwnd) then
ShowWindow(hwnd, SW_RESTORE);
// if not IsWindowVisible(hwnd) then
// ShowWindow(hwnd, SW_SHOWNOACTIVATE);

if GetForegroundWindow = hwnd then
Result := True
else
begin
if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and
(Win32MinorVersion > 0)))) then
begin
Result := False;
ForegroundThreadID := GetWindowThreadProcessID(GetForegroundWindow, nil);
ThisThreadID := GetWindowThreadPRocessId(hwnd, nil);
if AttachThreadInput(ThisThreadID, ForegroundThreadID, True) then
begin
BringWindowToTop(hwnd);
SetForegroundWindow(hwnd);
AttachThreadInput(ThisThreadID, ForegroundThreadID, False);
Result := (GetForegroundWindow = hwnd);
end;
if not Result then
begin
SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0,
TObject(0), SPIF_SENDCHANGE);
BringWindowToTop(hWnd);
SetForegroundWindow(hWnd);
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0,
TObject(timeout), SPIF_SENDCHANGE);
end;
end
else
begin
BringWindowToTop(hWnd);
SetForegroundWindow(hwnd);
end;

Result := (GetForegroundWindow = hwnd);
end;
end;

procedure pressButtonDown(btn:Thandle);
begin
postMessage(btn,WM_LBUTTONDOWN,VK_LBUTTON,0); // MK_LBUTTON 0231028E $1f0028
postMessage(btn,WM_LBUTTONUP,0,0);
postMessage(btn,WM_LBUTTONDOWN,VK_LBUTTON,0); // MK_LBUTTON 0231028E $1f0028
postMessage(btn,WM_LBUTTONUP,0,0);
end;

function closeAboutWindow():boolean;
var
rundemo,btnHandle: Cardinal;
begin
result:=false;
rundemo:= findwindow('#32770','About Quite Imposing 1.6 (EN)');
if rundemo<>0 then
begin
SetForegroundWindow(rundemo);
btnHandle:= findwindowex(rundemo,0,'Button','Run &demo');
if btnHandle<>0 then
begin
pressButtonDown(btnHandle);
result:=true;
end;
end;
end;

function PDFisOpen():boolean;
var readerHandle,mdiHandle,mdiHandle2:Cardinal;
Title: array[0..255] of Char;
begin
readerHandle:= findwindowEx(0,0,'AdobeAcrobat',nil);
result:=false;
if readerHandle<>0 then
begin

mdiHandle:= findwindowex(readerHandle,0,'MDIClient',nil);
if mdiHandle<>0 then
begin
mdiHandle2:= findwindowex(mdiHandle,0,'AcrobatMDIChildWnd',nil);
GetWindowText(mdiHandle2, Title, SizeOf(Title));
// showmessage('AcrobatMDIChildWnd='+string(Title));
if pos('.pdf',ansilowercase(string(Title)))>0 then
result:=true;

end;
end;
end;

function kuoBianAction():boolean;
var readerHandle:Cardinal;
mdiHandle: Cardinal;
mdiHandle2: Cardinal;

trimHandle: Cardinal;
ImpositionHandle: Cardinal;
DownNum: Integer;
NextBtn: Cardinal;
begin
readerHandle:= findwindowEx(0,0,'AdobeAcrobat',nil);

result:=false;
DownNum:=0;

if readerHandle<>0 then
begin
SetForegroundWindow(readerHandle);
// ForceForegroundWindow(readerHandle);
// form1.Memo1.Lines.Add('find AdobeAcrobat');

//Alt+P
keybd_event(18, MapVirtualKey(18, 0), 0, 0);
keybd_event(80, MapVirtualKey(80, 0), 0, 0);
keybd_event(80, MapVirtualKey(80, 0), KEYEVENTF_KEYUP, 0);
keybd_event(18, MapVirtualKey(18, 0), KEYEVENTF_KEYUP, 0);

DownNum:=strtointdef(form1.edtDownNum.Text,1); //工具菜单光标首次下移多少次

while DownNum>0 do
begin

sleep(100);
//方向键down （1次）
keybd_event(VK_DOWN, MapVirtualKey(VK_DOWN, 0), 0, 0);
keybd_event(VK_DOWN, MapVirtualKey(VK_DOWN, 0), KEYEVENTF_KEYUP, 0);

dec(DownNum);
end;

sleep(200);

//方向键 right（1次）
keybd_event(VK_RIGHT, MapVirtualKey(VK_RIGHT, 0), 0, 0);
keybd_event(VK_RIGHT, MapVirtualKey(VK_RIGHT, 0), KEYEVENTF_KEYUP, 0);

sleep(200);

//方向键 up（1次）
keybd_event(VK_UP, MapVirtualKey(VK_UP, 0), 0, 0);
keybd_event(VK_UP, MapVirtualKey(VK_UP, 0), KEYEVENTF_KEYUP, 0);

sleep(200);

//方向键 up（1次）
keybd_event(VK_UP, MapVirtualKey(VK_UP, 0), 0, 0);
keybd_event(VK_UP, MapVirtualKey(VK_UP, 0), KEYEVENTF_KEYUP, 0);

sleep(200);

//方向键 up（1次）
keybd_event(VK_UP, MapVirtualKey(VK_UP, 0), 0, 0);
keybd_event(VK_UP, MapVirtualKey(VK_UP, 0), KEYEVENTF_KEYUP, 0);

sleep(100);
//回车键 Enter （1次）
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0);
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0);

while not closeAboutWindow() do
begin
sleep(200);
closeAboutWindow();
break;
end;

sleep(500);
trimHandle:=findwindowex(0,0,'#32770','Trim and shift 1 - page selection');

while trimHandle=0 do
begin
application.ProcessMessages ;
trimHandle:=findwindowex(0,0,'#32770','Trim and shift 1 - page selection');
end;

if trimHandle<>0 then
begin
// SetForegroundWindow(trimHandle);
ForceForegroundWindow(trimHandle);
// form1.Memo1.Lines.Add('find Trim and shift 1 - page selection');

sleep(1000);

NextBtn:= findwindowex(trimHandle,0,'Button','&Next');

while NextBtn=0 do
begin
application.ProcessMessages ;
NextBtn:= findwindowex(trimHandle,0,'Button','&Next');
end;

if NextBtn<>0 then
begin
pressButtonDown(NextBtn);
end
else
begin
//回车键 Enter （1次）
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0);
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0);
end;

NextBtn:=0;

sleep(1000);
//回车键 Enter （1次）
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0);
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0);

sleep(1000);
//回车键 Enter （1次）
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0);
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0);

// sleep(300);

while True do
begin
application.ProcessMessages ;
// sleep(100);
ImpositionHandle:=findwindow(nil,'Imposition');
if ImpositionHandle>0 then
begin
break;
end;
end;

while True do
begin

application.ProcessMessages ;
ImpositionHandle:=findwindow(nil,'Imposition');
if ImpositionHandle=0 then
begin
// showmessage('find Imposition window');
//form1.Memo1.Lines.Add('本次扩边完毕！');

//Ctrl+S 保存
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(83, MapVirtualKey(83, 0), 0, 0);
keybd_event(83, MapVirtualKey(83, 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);

sleep(3000);

//Ctrl+W 关闭
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(87, MapVirtualKey(87, 0), 0, 0);
keybd_event(87, MapVirtualKey(87, 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);

break;

end;
end;

result:=true;
end;

end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
pdflist,configFile: TStrings;
i: integer;
label ok;
begin
//开始扩边
// Memo1.Clear ;
pdflist:=tstringlist.Create ;
configFile:=tstringlist.Create ;

configFile.Add('pdfpath='+edit1.Text); //PDF所在路径
configFile.Add('acrobat7='+edit2.Text); //Acrobat7完整路径
configFile.Add('DownNum='+trim(edtDownNum.Text));

configFile.SaveToFile(extractfilepath(application.ExeName)+'setinfo.txt');

findfiles(edit1.Text,'*.pdf',pdflist);

try
for i := 0 to pdflist.Count-1 do
begin
application.ProcessMessages ;
shellexecute(handle,'open',pchar(edit2.Text),pchar(pdflist[i]),nil,1);

while True do
begin
application.ProcessMessages ;
if PDFisOpen() then //文件已经打开
begin
ok:
application.ProcessMessages ;

if kuoBianAction() then //扩边
begin
if i=pdflist.Count-1 then
begin
TrayIcon1.BalloonTimeout:=30000;
TrayIcon1.BalloonTitle:='全部扩边完毕';
end;
TrayIcon1.BalloonTitle:='共有 '+inttostr(pdflist.Count)+' 个PDF ';
TrayIcon1.BalloonHint:='已处理：'+inttostr(i+1)+' 个PDF！';
TrayIcon1.ShowBalloonHint;
break;
end
else
goto ok;

end;

end;
self.Caption:='已处理（'+inttostr(i+1)+'）';
end;

finally
freeandnil(configFile);
freeandnil(pdflist);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var loadCfg:Tstrings;
begin
self.KeyPreview:=false;
edit1.Clear ;
edit2.Clear ;
//edit1.Text:='E:\tools\data';
//edit2.Text:='F:\Program Files\Adobe\Acrobat 7.0\Acrobat\Acrobat.exe';
loadCfg:=tstringlist.Create ;
try
if fileExists(extractfilepath(application.ExeName)+'setinfo.txt') then
begin
loadCfg.LoadFromFile(extractfilepath(application.ExeName)+'setinfo.txt');
edit1.Text:=loadCfg.Values['pdfpath'];
edit2.Text:=loadCfg.Values['acrobat7'];
edtDownNum.Text:=loadCfg.Values['DownNum'];
end;
finally
freeandnil(loadCfg);
end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var other:Thandle;
begin
{ other:=findwindow('#32770','Trim and shift - advanced options');
if other<>0 then
begin
postmessage(other,wm_close,0,0);
end;
}
end;

end.