文书智能助手

背景

司法、医疗等行业存在着大量的文书,一份文书或者卷宗少则几十页,多则几万页。在查看和检查这些文书时,会遇到大量的信息。当需要查询进一步的详细内容时,往往需要选择一下文字,然后再在各种系统中 查询详细的信息。客户就提出了一个思路:"文书智能助手"。文书智能助手:在Word 或者 记事本 或者 其他软件中,使用鼠标框选选中一段文字后,根据"选中的文字"在各种系统中检索数据,自动显示相关的数据项。并可以向Word插入文字和图片内容。

使用说明

启动程序

在文书中使用鼠标框选中文字

根据"选中的文字"在各种系统中检索数据,自动显示相关的数据项。

word监控工具

设计

程序分为主EXE 和DLL

DLL为鼠标HOOK

主EXE在鼠标框选中,获取当前选中的文字,然后进行查询,并显示查询结果。

代码

DLL代码

Delphi 复制代码
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代码

Delphi 复制代码
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.
相关推荐
下雪天的夏风8 分钟前
TS - tsconfig.json 和 tsconfig.node.json 的关系,如何在TS 中使用 JS 不报错
前端·javascript·typescript
diygwcom20 分钟前
electron-updater实现electron全量版本更新
前端·javascript·electron
Hello-Mr.Wang37 分钟前
vue3中开发引导页的方法
开发语言·前端·javascript
程序员凡尘1 小时前
完美解决 Array 方法 (map/filter/reduce) 不按预期工作 的正确解决方法,亲测有效!!!
前端·javascript·vue.js
编程零零七4 小时前
Python数据分析工具(三):pymssql的用法
开发语言·前端·数据库·python·oracle·数据分析·pymssql
(⊙o⊙)~哦6 小时前
JavaScript substring() 方法
前端
无心使然云中漫步7 小时前
GIS OGC之WMTS地图服务,通过Capabilities XML描述文档,获取matrixIds,origin,计算resolutions
前端·javascript
Bug缔造者7 小时前
Element-ui el-table 全局表格排序
前端·javascript·vue.js
xnian_7 小时前
解决ruoyi-vue-pro-master框架引入报错,启动报错问题
前端·javascript·vue.js
麒麟而非淇淋8 小时前
AJAX 入门 day1
前端·javascript·ajax