背景
司法、医疗等行业存在着大量的文书,一份文书或者卷宗少则几十页,多则几万页。在查看和检查这些文书时,会遇到大量的信息。当需要查询进一步的详细内容时,往往需要选择一下文字,然后再在各种系统中 查询详细的信息。客户就提出了一个思路:“文书智能助手”。文书智能助手:在Word 或者 记事本 或者 其他软件中,使用鼠标框选选中一段文字后,根据“选中的文字”在各种系统中检索数据,自动显示相关的数据项。并可以向Word插入文字和图片内容。
使用说明
启动程序
在文书中使用鼠标框选中文字
根据“选中的文字”在各种系统中检索数据,自动显示相关的数据项。
word监控工具
设计
程序分为主EXE 和DLL
DLL为鼠标HOOK
主EXE在鼠标框选中,获取当前选中的文字,然后进行查询,并显示查询结果。
代码
DLL代码
uses
windows,
messages,
System.SysUtils,
System.Classes;
{$R *.res}
const
WM_my_cmd_mouse = WM_USER + 201;
WM_my_cmd_key = WM_USER + 202;
var
idhook: longint;
hNextHookProc: HHook;
main_handle: THandle = 0;
function KeyboardHookHandler(iCode: Integer; WParam: WParam; lParam: lParam)
: LRESULT stdcall;
const
_KeyPressMask = $80000000;
var
c: char;
i: Integer;
j: Integer;
begin
Result := 0;
if iCode < 0 then
begin
Result := CallNextHookEx(hNextHookProc, iCode, WParam, lParam);
Exit;
end;
if main_handle > 0 then
begin
PostMessage(main_handle, WM_my_cmd_key, WParam, lParam);
end;
Result := CallNextHookEx(hNextHookProc, iCode, WParam, lParam);
end;
function hookProc(nCode: Integer; // hook code
WParam: WParam; // message identifier消息标识
lParam: lParam // mouse coordinates鼠标坐标
): LRESULT; stdcall;
var
x: Integer;
y: Integer;
l: DWORD;
begin
if (WParam = WM_LBUTTONUP) or (WParam = WM_LBUTTONDOWN) then
begin
try
if (WParam = WM_LBUTTONUP) or (WParam = WM_LBUTTONDOWN) then
begin
x := PMouseHookStruct(lParam)^.pt.x;
y := PMouseHookStruct(lParam)^.pt.y;
l := x * 10000 + y;
PostMessage(main_handle, WM_my_cmd_mouse, WParam, l);
end;
finally
end;
end;
Result := CallNextHookEx(idhook, nCode, WParam, lParam);
Exit;
end;
function setHook(h: THandle): Boolean; stdcall;
begin
main_handle := h;
idhook := SetWindowsHookEx(WH_MOUSE_ll, @hookProc, HInstance, 0);
// hNextHookProc := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookHandler,
// HInstance, 0);
Result := idhook <> 0;
end;
// 删除鼠标钩子
function delHook: Boolean; stdcall;
begin
if idhook > 0 then
UnhookWindowsHookEx(idhook);
// if hNextHookProc > 0 then
// UnhookWindowsHookEx(hNextHookProc);
main_handle := 0;
Result := true;
end;
exports
setHook name 'setHook',
delHook name 'delHook',
hookProc name 'hookProc',
KeyboardHookHandler name 'KeyboardHookHandler';
begin
end.
主EXE代码
unit U_main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.ImageList, Vcl.ImgList,
Vcl.Menus, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Buttons, U_Pub, U_makepng, U_img,
U_btnImg,
u_btn, U_DocBookMarkMgr, Clipbrd;
const
WM_my_cmd = WM_USER + 101;
WM_my_cmd_mouse = WM_USER + 201;
str_nobookmark = '没有发现书签';
type
TFrm_main = class(TForm)
TrayIcon1: TTrayIcon;
PopupMenu1: TPopupMenu;
ImageList1: TImageList;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
ImageList2: TImageList;
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Label1: TLabel;
Timer1: TTimer;
Edit1: TEdit;
Label3: TLabel;
Memo1: TMemo;
Timer_mouse: TTimer;
Timer_img: TTimer;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N4Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure N1Click(Sender: TObject);
procedure TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer_mouseTimer(Sender: TObject);
procedure Timer_imgTimer(Sender: TObject);
private
will_exit: Boolean;
is_timer_word: Boolean;
LBUTTONDOWN_handle: THandle;
LBUTTONDOWN_x_last: Integer;
LBUTTONDOWN_y_last: Integer;
LBUTTONUP_x_last: Integer;
LBUTTONUP_y_last: Integer;
frm_makepng: TFrm_makepng;
frm_btn: TFrm_btn;
curr_frm_img: TFrm_btnimg;
old_clipboard_text: string;
curr_text: string;
curr_isimg: Boolean;
curr_imgfn: string;
public
{ Public declarations }
procedure my_cmd(var Message: TMessage); message WM_my_cmd;
procedure my_cmd_mouse(var Message: TMessage); message WM_my_cmd_mouse;
procedure do_cmd_mouse(WParam, X, Y: Integer);
procedure do_init();
procedure do_word_timer();
function do_pt_frm_btn(pt: TPoint): Boolean;
procedure show_btn(pt: TPoint; txt: string; isimg: Boolean);
procedure show_btn_img(pt: TPoint);
procedure frm_btnClose(Sender: TObject; var Action: TCloseAction);
procedure frm_btn_imgClose(Sender: TObject; var Action: TCloseAction);
procedure do_copy();
procedure do_typetext(bk, txt: string);
procedure do_typeimg(bk: string);
end;
var
Frm_main: TFrm_main;
implementation
uses activex, comobj, Pub;
{$R *.dfm}
procedure TFrm_main.BitBtn1Click(Sender: TObject);
begin
PostMessage(Handle, WM_my_cmd, 3, 0);
end;
procedure TFrm_main.BitBtn2Click(Sender: TObject);
begin
// Hide;
top := 0 - 10 - Height;
end;
procedure TFrm_main.do_cmd_mouse(WParam, X, Y: Integer);
var
pt: TPoint;
x_begin, y_begin: Integer;
x_end, y_end: Integer;
begin
try
if WParam = WM_LBUTTONDOWN then
begin
write_log('WM_LBUTTONDOWN');
if frm_btn <> nil then
begin
pt := frm_btn.ScreenToClient(Point(X, Y));
do_pt_frm_btn(pt);
LBUTTONDOWN_x_last := X;
LBUTTONDOWN_y_last := Y;
end
else
begin
LBUTTONDOWN_x_last := X;
LBUTTONDOWN_y_last := Y;
LBUTTONDOWN_handle := GetActiveWindow();
end;
if Shift_down() then
begin
if curr_frm_img <> nil then
FreeAndNil(curr_frm_img);
show_btn_img(Point(X, Y));
end
else
begin
if curr_frm_img <> nil then
FreeAndNil(curr_frm_img);
end;
end
else if WParam = WM_LBUTTONUP then
begin
if curr_frm_img <> nil then
begin
x_begin := curr_frm_img.x_begin;
y_begin := curr_frm_img.y_begin;
x_end := curr_frm_img.x_end;
y_end := curr_frm_img.y_end;
FreeAndNil(curr_frm_img);
LBUTTONUP_x_last := X;
LBUTTONUP_y_last := Y;
write_log('WM_LBUTTONUP');
if (x_begin - x_end) * (x_begin - x_end) + (y_begin - y_end) *
(y_begin - y_end) > 100 then
begin
curr_imgfn := frm_makepng.MakeSceenCopyPath(x_begin, y_begin,
x_end, y_end);
Timer_img.Enabled := false;
Timer_img.Interval := 50;
Timer_img.Enabled := true;
end
else
begin
if frm_btn <> nil then
FreeAndNil(frm_btn);
end;
end
else
begin
LBUTTONUP_x_last := X;
LBUTTONUP_y_last := Y;
write_log('WM_LBUTTONUP');
Timer_mouse.Enabled := false;
Timer_mouse.Interval := 100;
Timer_mouse.Enabled := true;
end;
end;
except
on e: Exception do
begin
write_log('my_cmd_mouse ' + e.Message);
end;
end;
end;
procedure TFrm_main.do_copy;
begin
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0); // 按下Ctrl键
keybd_event(ord('C'), MapVirtualKey(ord('C'), 0), 0, 0); // 按下C键
keybd_event(ord('C'), MapVirtualKey(ord('C'), 0), KEYEVENTF_KEYUP, 0); // 放开C键
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;
procedure TFrm_main.do_init;
procedure show_msg(v: string);
begin
Memo1.Lines.Add(v);
Edit1.Text := v;
Application.ProcessMessages();
sleep(300);
end;
begin
Pub.setHook(Handle);
show_msg('初始化鼠标监控');
show_msg('初始化Word服务');
show_msg('正在监控Word');
sleep(500);
end;
function TFrm_main.do_pt_frm_btn(pt: TPoint): Boolean;
var
i: Integer;
node: TDocBookMarkNodeDraw;
bookmork: string;
begin
write_log('do_pt_frm_btn x:' + inttostr(pt.X) + ' y:' + inttostr(pt.Y));
write_log('do_pt_frm_btn GetCurrentProcessId:' +
inttostr(GetCurrentProcessId));
Result := false;
if frm_btn = nil then
exit;
try
if (pt.Y > frm_btn.Height) or (pt.X > frm_btn.Width) then
begin
FreeAndNil(frm_btn);
exit;
end;
if PtInRect(frm_btn.CloseBtn.BoundsRect, pt) then
begin
write_log('frm_btn.CloseBtn');
FreeAndNil(frm_btn);
exit;
end;
for i := 0 to frm_makepng.mgr.DrawList.Count - 1 do
begin
node := frm_makepng.mgr.DrawList[i];
if PtInRect(node.Rect, pt) then
if node.texttype = 'BookMark' then
begin
bookmork := node.BookMark.Name;
FreeAndNil(frm_btn);
// Timer_post.Enabled := false;
// Timer_post.Interval := 500;
// will_do_bookmork := node.BookMark.Name;
// Timer_post.Enabled := true;
Result := true;
Break;
end;
end;
except
on e: Exception do
begin
write_log('do_pt_frm_btn ' + e.Message);
end;
end;
if bookmork <> str_nobookmark then
begin
if curr_isimg then
do_typeimg(bookmork)
else if curr_text <> '' then
do_typetext(bookmork, curr_text);
end;
end;
procedure TFrm_main.do_typeimg(bk: string);
var
pvDisp: IDispatch;
wordApp: OleVariant;
doc: OleVariant;
i: Integer;
s: string;
rend: OleVariant;
begin
if not FileExists(curr_imgfn) then
exit;
if (GetObject('Word.Application', IDispatch, pvDisp) = S_OK) then
begin
wordApp := pvDisp;
try
if wordApp.Documents.Count >= 1 then
begin
doc := wordApp.ActiveDocument;
if VarIsNull(doc) then
doc := wordApp.Documents.Item(1);
try
if doc.BookMarks.Exists(bk) then
begin
rend := doc.BookMarks.Item(bk).Range.End - 1;
wordApp.Selection.SetRange(rend, rend);
wordApp.Selection.InlineShapes.addpicture
(curr_imgfn, false, true);
// Word.ActiveDocument.Range.InlineShapes.addpicture(extractfilepath(Application.ExeName)+'\test.jpg',True, True);
end;
except
begin
end;
end;
end;
except
begin
end;
end;
rend := Unassigned;
doc := Unassigned;
wordApp := Unassigned;
end;
end;
procedure TFrm_main.do_typetext(bk, txt: string);
var
pvDisp: IDispatch;
wordApp: OleVariant;
doc: OleVariant;
i: Integer;
s: string;
rend: OleVariant;
begin
if (GetObject('Word.Application', IDispatch, pvDisp) = S_OK) then
begin
wordApp := pvDisp;
try
if wordApp.Documents.Count >= 1 then
begin
doc := wordApp.ActiveDocument;
if VarIsNull(doc) then
doc := wordApp.Documents.Item(1);
try
if doc.BookMarks.Exists(bk) then
begin
rend := doc.BookMarks.Item(bk).Range.End - 1;
wordApp.Selection.SetRange(rend, rend);
wordApp.Selection.TypeText(txt);
end;
except
begin
end;
end;
end;
except
begin
end;
end;
rend := Unassigned;
doc := Unassigned;
wordApp := Unassigned;
end;
end;
procedure TFrm_main.do_word_timer;
var
pvDisp: IDispatch;
wordApp: OleVariant;
doc: OleVariant;
doc_filename, s: string;
sl: TStringList;
i: Integer;
begin
sl := TStringList.Create;
if (GetObject('Word.Application', IDispatch, pvDisp) = S_OK) then
begin
wordApp := pvDisp;
try
if wordApp.Documents.Count >= 1 then
begin
doc := wordApp.ActiveDocument;
if VarIsNull(doc) then
doc := wordApp.Documents.Item(1);
doc_filename := doc.FullName;
try
for i := 1 to doc.BookMarks.Count do
sl.Add(trim(doc.BookMarks.Item(i).Name));
except
begin
end;
end;
end;
except
begin
end;
end;
doc := Unassigned;
wordApp := Unassigned;
end;
if doc_filename = '' then
begin
doc_filename := '没有发现打开的Word文档或Word无响应'
end;
frm_makepng.mgr.DocFullName := doc_filename;
frm_makepng.mgr.clear_BookMarkList;
for i := 0 to sl.Count - 1 do
begin
s := sl[i];
if pos('_', s) < 1 then
frm_makepng.mgr.add_BookMark(sl[i]);
end;
if frm_makepng.mgr.BookMarkList.Count = 0 then
frm_makepng.mgr.add_BookMark(str_nobookmark);
frm_makepng.mgr.MakeDraw;
FreeAndNil(sl);
end;
procedure TFrm_main.FormActivate(Sender: TObject);
begin
OnActivate := nil;
Timer1.Enabled := true;
end;
procedure TFrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if will_exit then
exit;
Action := caHide;
end;
procedure TFrm_main.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if will_exit then
exit;
CanClose := false;
Hide();
end;
procedure TFrm_main.FormCreate(Sender: TObject);
begin
is_timer_word := false;
frm_makepng := TFrm_makepng.Create(nil);
u_btn.imgpath := GetPath();
U_makepng.imgpath := u_btn.imgpath;
frm_btn := nil;
curr_frm_img := nil;
write_log('FormCreate');
end;
procedure TFrm_main.FormDestroy(Sender: TObject);
begin
Pub.delHook();
try
if (frm_btn <> nil) then
FreeAndNil(frm_btn);
FreeAndNil(frm_makepng);
if (curr_frm_img <> nil) then
FreeAndNil(curr_frm_img);
except
end;
write_log('FormDestroy');
end;
procedure TFrm_main.frm_btnClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
frm_btn := nil;
end;
procedure TFrm_main.frm_btn_imgClose(Sender: TObject; var Action: TCloseAction);
begin
curr_frm_img := nil;
end;
procedure TFrm_main.N1Click(Sender: TObject);
begin
PostMessage(Handle, WM_my_cmd, 1, 0);
end;
procedure TFrm_main.N4Click(Sender: TObject);
begin
PostMessage(Handle, WM_my_cmd, 3, 0);
end;
procedure TFrm_main.show_btn(pt: TPoint; txt: string; isimg: Boolean);
var
h: THandle;
X, Y, l, t: Integer;
begin
try
write_log('show_btn txt:' + txt);
if (txt = '') and (isimg = false) then
exit;
do_word_timer();
curr_text := txt;
curr_isimg := isimg;
h := GetActiveWindow();
if (frm_btn <> nil) then
FreeAndNil(frm_btn);
h := GetActiveWindow();
LBUTTONDOWN_handle := h;
// frm_makepng.Test();
frm_makepng.MakePng(u_btn.imgpath + 'btn.png');
frm_btn := TFrm_btn.Create(nil);
frm_btn.OnClose := frm_btnClose;
X := pt.X;
Y := pt.Y + 16;
l := X - frm_btn.Width div 2;
t := Y;
if l > Screen.Width - frm_btn.Width then
l := Screen.Width - frm_btn.Width;
if t > Screen.Height - frm_btn.Height then
t := Screen.Height - frm_btn.Height;
frm_btn.left := l;
frm_btn.top := t;
ShowWindow(frm_btn.Handle, SW_NORMAL or SW_SHOWNOACTIVATE);
Application.ProcessMessages;
sleep(100);
Application.ProcessMessages;
SetForegroundWindow(LBUTTONDOWN_handle);
except
on e: Exception do
begin
write_log('show_btn ' + e.Message);
end;
end;
end;
procedure TFrm_main.show_btn_img(pt: TPoint);
begin
curr_isimg := false;
curr_imgfn := '';
if (curr_frm_img <> nil) then
FreeAndNil(curr_frm_img);
frm_makepng.MakeScreenPng();
U_btnImg.curr_bmpstream := frm_makepng.screen_stream_adapter;
curr_frm_img := TFrm_btnimg.Create(nil);
curr_frm_img.x_begin := pt.X;
curr_frm_img.y_begin := pt.Y;
curr_frm_img.x_end := pt.X;
curr_frm_img.y_end := pt.Y;
curr_frm_img.OnClose := frm_btn_imgClose;
curr_frm_img.left := 0;
curr_frm_img.top := 0;
// ShowWindow(curr_frm_img.Handle, SW_NORMAL or SW_SHOWNOACTIVATE);
// ShowWindow(curr_frm_img.Handle, SW_NORMAL);
curr_frm_img.Show;
Application.ProcessMessages;
SetForegroundWindow(curr_frm_img.Handle);
end;
procedure TFrm_main.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := false;
do_init();
top := 0 - 10 - Height;
end;
procedure TFrm_main.Timer_imgTimer(Sender: TObject);
var
i: Integer;
X, Y: Integer;
begin
Timer_img.Enabled := false;
if ((LBUTTONDOWN_x_last - LBUTTONUP_x_last) *
(LBUTTONDOWN_x_last - LBUTTONUP_x_last) +
(LBUTTONDOWN_y_last - LBUTTONUP_y_last) *
(LBUTTONDOWN_y_last - LBUTTONUP_y_last) > 100) and (true) then
begin
show_btn(Point(LBUTTONUP_x_last, LBUTTONUP_y_last), '',true);
end
else
begin
if frm_btn <> nil then
FreeAndNil(frm_btn);
end;
end;
procedure TFrm_main.Timer_mouseTimer(Sender: TObject);
var
i: Integer;
txt: string;
X, Y: Integer;
begin
Timer_mouse.Enabled := false;
if ((LBUTTONDOWN_x_last - LBUTTONUP_x_last) *
(LBUTTONDOWN_x_last - LBUTTONUP_x_last) +
(LBUTTONDOWN_y_last - LBUTTONUP_y_last) *
(LBUTTONDOWN_y_last - LBUTTONUP_y_last) > 100) and (true) then
begin
txt := '';
try
old_clipboard_text := Clipboard.AsText;
Clipboard.AsText := '';
for i := 1 to 6 do
begin
do_copy();
mysleep(200);
txt := Clipboard.AsText;
if txt <> '' then
Break;
end;
Clipboard.AsText := old_clipboard_text;
except
end;
show_btn(Point(LBUTTONUP_x_last, LBUTTONUP_y_last), trim(txt),false);
end
else
begin
if frm_btn <> nil then
FreeAndNil(frm_btn);
end;
end;
procedure TFrm_main.TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
PostMessage(Handle, WM_my_cmd, 1, 0);
end;
end;
procedure TFrm_main.my_cmd(var Message: TMessage);
begin
case Message.WParam of
1:
begin
WindowState := wsNormal;
Visible := true;
BringWindowToTop(Handle);
top := (Screen.Height - Height) div 2;
left := (Screen.Width - Width) div 2;
end;
3:
begin
will_exit := true;
OnClose := nil;
OnCloseQuery := nil;
WindowState := wsNormal;
Visible := true;
BringWindowToTop(Handle);
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
end;
end;
procedure TFrm_main.my_cmd_mouse(var Message: TMessage);
var
X, Y: Integer;
begin
try
X := Message.LParam div 10000;
Y := Message.LParam mod 10000;
do_cmd_mouse(Message.WParam, X, Y);
except
on e: Exception do
begin
write_log('my_cmd_mouse ' + e.Message);
end;
end;
end;
end.