背景
司法、医疗等行业存在着大量的文书,一份文书或者卷宗少则几十页,多则几万页。在查看和检查这些文书时,会遇到大量的信息。当需要查询进一步的详细内容时,往往需要选择一下文字,然后再在各种系统中 查询详细的信息。客户就提出了一个思路:“文书智能助手”。文书智能助手:在Word 或者 记事本 或者 其他软件中,使用鼠标框选选中一段文字后,根据“选中的文字”在各种系统中检索数据,自动显示相关的数据项。并可以向Word插入文字和图片内容。
使用说明
启动程序
在文书中使用鼠标框选中文字
根据“选中的文字”在各种系统中检索数据,自动显示相关的数据项。
word监控工具
设计
程序分为主EXE 和DLL
DLL为鼠标HOOK
主EXE在鼠标框选中,获取当前选中的文字,然后进行查询,并显示查询结果。
代码
DLL代码
useswindows,messages,System.SysUtils,System.Classes;{$R *.res}constWM_my_cmd_mouse = WM_USER + 201;WM_my_cmd_key = WM_USER + 202;varidhook: longint;hNextHookProc: HHook;main_handle: THandle = 0;function KeyboardHookHandler(iCode: Integer; WParam: WParam; lParam: lParam): LRESULT stdcall;
const_KeyPressMask = $80000000;
varc: char;i: Integer;j: Integer;
beginResult := 0;if iCode < 0 thenbeginResult := CallNextHookEx(hNextHookProc, iCode, WParam, lParam);Exit;end;if main_handle > 0 thenbeginPostMessage(main_handle, WM_my_cmd_key, WParam, lParam);end;Result := CallNextHookEx(hNextHookProc, iCode, WParam, lParam);
end;function hookProc(nCode: Integer; // hook codeWParam: WParam; // message identifier消息标识lParam: lParam // mouse coordinates鼠标坐标): LRESULT; stdcall;
varx: Integer;y: Integer;l: DWORD;
beginif (WParam = WM_LBUTTONUP) or (WParam = WM_LBUTTONDOWN) thenbegintryif (WParam = WM_LBUTTONUP) or (WParam = WM_LBUTTONDOWN) thenbeginx := PMouseHookStruct(lParam)^.pt.x;y := PMouseHookStruct(lParam)^.pt.y;l := x * 10000 + y;PostMessage(main_handle, WM_my_cmd_mouse, WParam, l);end;finallyend;end;Result := CallNextHookEx(idhook, nCode, WParam, lParam);Exit;
end;function setHook(h: THandle): Boolean; stdcall;
beginmain_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;
beginif idhook > 0 thenUnhookWindowsHookEx(idhook);// if hNextHookProc > 0 then// UnhookWindowsHookEx(hNextHookProc);main_handle := 0;Result := true;
end;exportssetHook name 'setHook',delHook name 'delHook',hookProc name 'hookProc',KeyboardHookHandler name 'KeyboardHookHandler';beginend.
主EXE代码
unit U_main;interfaceusesWinapi.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;constWM_my_cmd = WM_USER + 101;WM_my_cmd_mouse = WM_USER + 201;str_nobookmark = '没有发现书签';typeTFrm_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);privatewill_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;varFrm_main: TFrm_main;implementationuses activex, comobj, Pub;
{$R *.dfm}procedure TFrm_main.BitBtn1Click(Sender: TObject);
beginPostMessage(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);
varpt: TPoint;x_begin, y_begin: Integer;x_end, y_end: Integer;
begintryif WParam = WM_LBUTTONDOWN thenbeginwrite_log('WM_LBUTTONDOWN');if frm_btn <> nil thenbeginpt := frm_btn.ScreenToClient(Point(X, Y));do_pt_frm_btn(pt);LBUTTONDOWN_x_last := X;LBUTTONDOWN_y_last := Y;endelsebeginLBUTTONDOWN_x_last := X;LBUTTONDOWN_y_last := Y;LBUTTONDOWN_handle := GetActiveWindow();end;if Shift_down() thenbeginif curr_frm_img <> nil thenFreeAndNil(curr_frm_img);show_btn_img(Point(X, Y));endelsebeginif curr_frm_img <> nil thenFreeAndNil(curr_frm_img);end;endelse if WParam = WM_LBUTTONUP thenbeginif curr_frm_img <> nil thenbeginx_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 thenbegincurr_imgfn := frm_makepng.MakeSceenCopyPath(x_begin, y_begin,x_end, y_end);Timer_img.Enabled := false;Timer_img.Interval := 50;Timer_img.Enabled := true;endelsebeginif frm_btn <> nil thenFreeAndNil(frm_btn);end;endelsebeginLBUTTONUP_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;excepton e: Exception dobeginwrite_log('my_cmd_mouse ' + e.Message);end;end;
end;procedure TFrm_main.do_copy;
beginkeybd_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);beginMemo1.Lines.Add(v);Edit1.Text := v;Application.ProcessMessages();sleep(300);end;beginPub.setHook(Handle);show_msg('初始化鼠标监控');show_msg('初始化Word服务');show_msg('正在监控Word');sleep(500);end;function TFrm_main.do_pt_frm_btn(pt: TPoint): Boolean;
vari: Integer;node: TDocBookMarkNodeDraw;bookmork: string;
beginwrite_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 thenexit;tryif (pt.Y > frm_btn.Height) or (pt.X > frm_btn.Width) thenbeginFreeAndNil(frm_btn);exit;end;if PtInRect(frm_btn.CloseBtn.BoundsRect, pt) thenbeginwrite_log('frm_btn.CloseBtn');FreeAndNil(frm_btn);exit;end;for i := 0 to frm_makepng.mgr.DrawList.Count - 1 dobeginnode := frm_makepng.mgr.DrawList[i];if PtInRect(node.Rect, pt) thenif node.texttype = 'BookMark' thenbeginbookmork := 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;excepton e: Exception dobeginwrite_log('do_pt_frm_btn ' + e.Message);end;end;if bookmork <> str_nobookmark thenbeginif curr_isimg thendo_typeimg(bookmork)else if curr_text <> '' thendo_typetext(bookmork, curr_text);end;
end;procedure TFrm_main.do_typeimg(bk: string);
varpvDisp: IDispatch;wordApp: OleVariant;doc: OleVariant;i: Integer;s: string;rend: OleVariant;
beginif not FileExists(curr_imgfn) thenexit;if (GetObject('Word.Application', IDispatch, pvDisp) = S_OK) thenbeginwordApp := pvDisp;tryif wordApp.Documents.Count >= 1 thenbegindoc := wordApp.ActiveDocument;if VarIsNull(doc) thendoc := wordApp.Documents.Item(1);tryif doc.BookMarks.Exists(bk) thenbeginrend := 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;exceptbeginend;end;end;exceptbeginend;end;rend := Unassigned;doc := Unassigned;wordApp := Unassigned;end;end;procedure TFrm_main.do_typetext(bk, txt: string);
varpvDisp: IDispatch;wordApp: OleVariant;doc: OleVariant;i: Integer;s: string;rend: OleVariant;
beginif (GetObject('Word.Application', IDispatch, pvDisp) = S_OK) thenbeginwordApp := pvDisp;tryif wordApp.Documents.Count >= 1 thenbegindoc := wordApp.ActiveDocument;if VarIsNull(doc) thendoc := wordApp.Documents.Item(1);tryif doc.BookMarks.Exists(bk) thenbeginrend := doc.BookMarks.Item(bk).Range.End - 1;wordApp.Selection.SetRange(rend, rend);wordApp.Selection.TypeText(txt);end;exceptbeginend;end;end;exceptbeginend;end;rend := Unassigned;doc := Unassigned;wordApp := Unassigned;end;end;procedure TFrm_main.do_word_timer;
varpvDisp: IDispatch;wordApp: OleVariant;doc: OleVariant;doc_filename, s: string;sl: TStringList;i: Integer;
beginsl := TStringList.Create;if (GetObject('Word.Application', IDispatch, pvDisp) = S_OK) thenbeginwordApp := pvDisp;tryif wordApp.Documents.Count >= 1 thenbegindoc := wordApp.ActiveDocument;if VarIsNull(doc) thendoc := wordApp.Documents.Item(1);doc_filename := doc.FullName;tryfor i := 1 to doc.BookMarks.Count dosl.Add(trim(doc.BookMarks.Item(i).Name));exceptbeginend;end;end;exceptbeginend;end;doc := Unassigned;wordApp := Unassigned;end;if doc_filename = '' thenbegindoc_filename := '没有发现打开的Word文档或Word无响应'end;frm_makepng.mgr.DocFullName := doc_filename;frm_makepng.mgr.clear_BookMarkList;for i := 0 to sl.Count - 1 dobegins := sl[i];if pos('_', s) < 1 thenfrm_makepng.mgr.add_BookMark(sl[i]);end;if frm_makepng.mgr.BookMarkList.Count = 0 thenfrm_makepng.mgr.add_BookMark(str_nobookmark);frm_makepng.mgr.MakeDraw;FreeAndNil(sl);
end;procedure TFrm_main.FormActivate(Sender: TObject);
beginOnActivate := nil;Timer1.Enabled := true;
end;procedure TFrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
beginif will_exit thenexit;Action := caHide;
end;procedure TFrm_main.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
beginif will_exit thenexit;CanClose := false;Hide();end;procedure TFrm_main.FormCreate(Sender: TObject);
beginis_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);
beginPub.delHook();tryif (frm_btn <> nil) thenFreeAndNil(frm_btn);FreeAndNil(frm_makepng);if (curr_frm_img <> nil) thenFreeAndNil(curr_frm_img);exceptend;write_log('FormDestroy');
end;procedure TFrm_main.frm_btnClose(Sender: TObject; var Action: TCloseAction);
beginAction := caFree;frm_btn := nil;
end;procedure TFrm_main.frm_btn_imgClose(Sender: TObject; var Action: TCloseAction);
begincurr_frm_img := nil;
end;procedure TFrm_main.N1Click(Sender: TObject);
beginPostMessage(Handle, WM_my_cmd, 1, 0);
end;procedure TFrm_main.N4Click(Sender: TObject);
beginPostMessage(Handle, WM_my_cmd, 3, 0);
end;procedure TFrm_main.show_btn(pt: TPoint; txt: string; isimg: Boolean);
varh: THandle;X, Y, l, t: Integer;
begintrywrite_log('show_btn txt:' + txt);if (txt = '') and (isimg = false) thenexit;do_word_timer();curr_text := txt;curr_isimg := isimg;h := GetActiveWindow();if (frm_btn <> nil) thenFreeAndNil(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 thenl := Screen.Width - frm_btn.Width;if t > Screen.Height - frm_btn.Height thent := 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);excepton e: Exception dobeginwrite_log('show_btn ' + e.Message);end;end;
end;procedure TFrm_main.show_btn_img(pt: TPoint);
begincurr_isimg := false;curr_imgfn := '';if (curr_frm_img <> nil) thenFreeAndNil(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);
beginTimer1.Enabled := false;do_init();top := 0 - 10 - Height;
end;procedure TFrm_main.Timer_imgTimer(Sender: TObject);
vari: Integer;X, Y: Integer;
beginTimer_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) thenbeginshow_btn(Point(LBUTTONUP_x_last, LBUTTONUP_y_last), '',true);endelsebeginif frm_btn <> nil thenFreeAndNil(frm_btn);end;
end;procedure TFrm_main.Timer_mouseTimer(Sender: TObject);
vari: Integer;txt: string;X, Y: Integer;
beginTimer_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) thenbegintxt := '';tryold_clipboard_text := Clipboard.AsText;Clipboard.AsText := '';for i := 1 to 6 dobegindo_copy();mysleep(200);txt := Clipboard.AsText;if txt <> '' thenBreak;end;Clipboard.AsText := old_clipboard_text;exceptend;show_btn(Point(LBUTTONUP_x_last, LBUTTONUP_y_last), trim(txt),false);endelsebeginif frm_btn <> nil thenFreeAndNil(frm_btn);end;
end;procedure TFrm_main.TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
beginif Button = mbLeft thenbeginPostMessage(Handle, WM_my_cmd, 1, 0);end;end;procedure TFrm_main.my_cmd(var Message: TMessage);
begincase Message.WParam of1:beginWindowState := wsNormal;Visible := true;BringWindowToTop(Handle);top := (Screen.Height - Height) div 2;left := (Screen.Width - Width) div 2;end;3:beginwill_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);
varX, Y: Integer;
begintryX := Message.LParam div 10000;Y := Message.LParam mod 10000;do_cmd_mouse(Message.WParam, X, Y);excepton e: Exception dobeginwrite_log('my_cmd_mouse ' + e.Message);end;end;
end;end.