Delphi结合百度图像识别接口进行企业微信通讯录数据采集

本人水平有限，如有错误，欢迎指正！

思路：企业微信的通讯录采集，通过百度图像识别接口及坐标定位实现。

1、找到企业微信窗口的句柄

2、截取相应区域的图像（不要截过大的区域，以免识别速度慢）

3、将截取的图像转换为Base64，并提交至百度图像识别接口（每天免费500次）

4、对识别结果进行分析（JSON解析）

unit GetWXUseru1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, sBitBtn,
  sSkinManager,strutils, ieview, imageenview, imageen, sMemo,jpeg,Soap.EncdDecd,
  clHttpRequest, clTcpClient, clTcpClientTls, clHttp, sLabel, Data.DB,
  Data.Win.ADODB, sCheckBox;

type
  TForm1 = class(TForm)
    sBitBtn1: TsBitBtn;
    sSkinManager1: TsSkinManager;
    sBitBtn2: TsBitBtn;
    sBitBtn3: TsBitBtn;
    ImageEn1: TImageEn;
    sMemo1: TsMemo;
    clHttp2: TclHttp;
    clHttpRequest2: TclHttpRequest;
    sMemo2: TsMemo;
    sBitBtn4: TsBitBtn;
    sMemo3: TsMemo;
    sLabel1: TsLabel;
    sMemo4: TsMemo;
    ADOConnection1: TADOConnection;
    UserList: TADOQuery;
    sCheckBox1: TsCheckBox;
    procedure sBitBtn1Click(Sender: TObject);
    procedure sBitBtn2Click(Sender: TObject);
    procedure sBitBtn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure sBitBtn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    APPHandle:hwnd;
    APPRect:TRect;
    procedure hotykey(var msg: TMessage); message WM_HOTKEY; // 定义全局热键消息事件
    function GetAPPHand:hwnd; //查询APP窗口，如找到返回非0，未找到返回0
    procedure CapFormPic(h:HWND;left_,top_,width_,height_:integer);
    function BaseImage: string;
    function Split(const Source,ch:string):TStringList;
    procedure SaveInfo;
    procedure GoToDown;
  end;

var
  Form1: TForm1;
  PicStream:TMemoryStream;
  FGetInfoKey:ATOM;
  CurMobile:string;

implementation

{$R *.dfm}

uses SuperObject;

procedure Delay(msecs:integer);
var
FirstTickCount:longint;

begin

FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages;
until ((GetTickCount-FirstTickCount) >= Longint(msecs));

end;

function TForm1.Split(const Source,ch:string):TStringList;
var
  temp:String;
  i:Integer;
begin
  Result:=TStringList.Create;
  //如果是空自符串则返回空列表
  if Source=''
  then exit;
  temp:=Source;
  i:=pos(ch,Source);
  while i<>0 do
  begin
     Result.add(copy(temp,0,i-1));
     Delete(temp,1,i);
     i:=pos(ch,temp);
  end;
  Result.add(temp);
end;

procedure TForm1.hotykey(var msg: TMessage); // 定义全局热键消息事件
begin
  if TWMHotKey(msg).HotKey = FGetInfoKey then//如果是Ctrl+F12
  begin
    if self.APPHandle=0 then
    begin
      showmessage('对不起，请先定位企业微信通讯录窗口！');
      exit;
    end;
    self.sBitBtn2Click(self);
  end;
end;

procedure TForm1.CapFormPic(h:HWND;left_,top_,width_,height_:integer);
var
  LDc:HDC;
  LBmp:TBitmap;
  LRect:TRect;
  jpegscreen:Tjpegimage;
begin
  LDc:=GetDC(h);
  if LDc=0 then
    exit;
  LBmp:=TBitmap.Create;
  try
    LBmp.Width:=width_;
    LBmp.Height:=height_;
    BitBlt(LBmp.Canvas.Handle,0,0,width_,height_,LDc,left_,top_,SRCCOPY);
    jpegscreen:=Tjpegimage.Create ;
    jpegscreen.Assign (LBmp);
    jpegscreen.CompressionQuality:=100;
    jpegscreen.SaveToStream(PicStream);
  finally
    picStream.Position:=0;
    self.ImageEn1.IO.LoadFromStreamJpeg(picstream);
    ReleaseDC(h,LDc);
    LBmp.Free;
    jpegscreen.Free ;
    self.ImageEn1.Update;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  self.APPHandle:=0;
  //注册全局按键
  FGetInfoKey:= GlobalAddAtom('getinfokey');
  RegisterHotKey(handle, FGetInfoKey, mod_control, VK_TAB);//注册Ctrl+TAB全局按键
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnregisterHotKey( Handle,FGetInfoKey );
  GlobalDeleteAtom(FGetInfoKey);
end;

function TForm1.GetAPPHand:hwnd; //查询APP窗口，如找到返回非0，未找到返回0
var
  h: HWnd;
  p: array[0..254] of char;
begin
  h := GetWindow(Handle, GW_HWNDFIRST);
  while h <> 0 do
  begin
    if GetWindowText(h, p, 255) > 0 then
    begin
      if leftstr(p,Length('企业微信-通讯录'))='企业微信-通讯录' then
        break;
    end;
    h := GetWindow(h, GW_HWNDNEXT);
  end;
  result:=h;
end;

procedure TForm1.sBitBtn1Click(Sender: TObject);
begin
  self.APPHandle:=self.GetAPPHand;
  if self.APPHandle<>0 then
  begin
    showmessage('企业微信通讯录窗口定位成功！');
    self.sBitBtn2.Enabled:=true;
  end
  else
  begin
    showmessage('对不起，企业微信未启动或未切换到通讯录窗口！');
  end;
end;

function TForm1.BaseImage: string;
var
  m2: TStringStream;
  str: string;
begin
  m2 := TStringStream.Create;
  EncodeStream(PicStream, m2);                       // 将m1的内容Base64到m2中
  str := m2.DataString;
  str := StringReplace(str, #13, '', [rfReplaceAll]);  // 这里m2中数据会自动添加回车换行，所以需要将回车换行替换成空字符
  str := StringReplace(str, #10, '', [rfReplaceAll]);
  result := str;                                       // 返回值为Base64的Stream
  m2.Free;
end;

procedure TForm1.sBitBtn2Click(Sender: TObject);
begin
  PicStream:=TMemoryStream.Create;
  try
    self.CapFormPic(self.APPHandle,1000,100,435,700);
  finally
    picstream.Position:=0;
    Self.sMemo1.Lines.Text:=self.BaseImage;
  end;
  PicStream.Free;
  self.sBitBtn3Click(self);
end;

procedure TForm1.sBitBtn3Click(Sender: TObject);
var
  url:string;
begin
  self.clHttpRequest2.FormFields['image'].FieldValue:=self.sMemo1.Lines.Text;
  url:='https://aip.baidubce.com/rest/2.0/ocr/v1/webimage_loc?access_token=这里加上百度获取的access_token';
  try
    self.clHttp2.Post(url,self.sMemo2.Lines);
  finally
    self.sBitBtn4Click(self);
  end;
end;

procedure TForm1.SaveInfo;
var
  sz:Tstrings;
  r:integer;
begin
  self.UserList.Close;
  self.UserList.SQL.Text:='select top 1 * from cms_UserList where Mobile='''+CurMobile+'''';
  self.UserList.Open;
  if self.UserList.RecordCount=0 then
  begin
    self.UserList.Append;
    sz:=Tstrings.Create;
    for r := 0 to self.sMemo3.Lines.Count-1 do
    begin
      sz:=self.Split(self.sMemo3.Lines[r],':');
      if sz.Count=2 then
      begin
        if sz.Strings[0]='姓名' then
          self.UserList.FieldByName('Name').Value:=sz.Strings[1]
        else
          if sz.Strings[0]='职务' then
            self.UserList.FieldByName('ZW').Value:=sz.Strings[1]
          else
            if sz.Strings[0]='手机' then
              self.UserList.FieldByName('Mobile').Value:=sz.Strings[1]
            else
              if sz.Strings[0]='邮箱' then
                self.UserList.FieldByName('Email').Value:=sz.Strings[1];
      end;
    end;
    self.UserList.FieldByName('BM').Value:=self.sMemo4.Lines.Text;
    sz.Free;
    self.UserList.Post;
  end;
end;

procedure TForm1.GoToDown;
begin
  postmessage(Self.APPHandle, wm_keydown, 39, 0);
  Delay(500);
  postmessage(Self.APPHandle, wm_keydown, 40, 0);
  delay(500);
end;

procedure TForm1.sBitBtn4Click(Sender: TObject);
var
  r,c,top_,left_:integer;
  jo:ISuperObject;
  arytxt:TSuperArray;
  word:string;
  isbegin:Boolean;
begin
  self.sMemo3.Clear;
  Self.sMemo4.Clear;
  CurMobile:='';
  jo:=so(self.sMemo2.Lines.Text);
  c:=jo['words_result_num'].AsInteger;
  if c>20 then
  begin
    arytxt:=jo['words_result'].AsArray;
    isbegin:=false;
    for r := 0 to c-1 do
    begin
      word:=arytxt[r]['words'].AsString;//词
      top_:=arytxt[r]['location.top'].AsInteger;
      left_:=arytxt[r]['location.left'].AsInteger;
      if (top_>=69) and (top_<=75) and (left_>=48) and (left_<=52) then //姓名
      begin
        self.sMemo3.Lines.Add('姓名:'+arytxt[r]['words'].AsString);
      end
      else
       if (top_>=96) and (top_<=98) and (left_>=48) and (left_<=52) then //职位
       begin
         self.sMemo3.Lines.Add('职务:'+arytxt[r]['words'].AsString);
       end
       else
         if (top_>=201) and (top_<=203) and (left_>=49) and (left_<=51) then //手机或邮箱
         begin
           if (word='手机') or (word='邮箱') then
           begin
              self.sMemo3.Lines.Add(arytxt[r]['words'].AsString+':'+arytxt[r+1]['words'].AsString);
              if word='手机' then
                CurMobile:=arytxt[r+1]['words'].AsString;
           end;
         end
         else
           if (top_>=232) and (top_<=234) and (left_>=49) and (left_<=51) then //手机或邮箱
           begin
             if (word='手机') or (word='邮箱') then
             begin
               self.sMemo3.Lines.Add(arytxt[r]['words'].AsString+':'+arytxt[r+1]['words'].AsString);
               if word='手机' then
                 CurMobile:=arytxt[r+1]['words'].AsString;
             end;
           end
           else
             if (top_>=263) and (top_<=265) and (left_>=49) and (left_<=51) then //手机或邮箱
             begin
               if (word='手机') or (word='邮箱') then
               begin
                 self.sMemo3.Lines.Add(arytxt[r]['words'].AsString+':'+arytxt[r+1]['words'].AsString);
                 if word='手机' then
                   CurMobile:=arytxt[r+1]['words'].AsString;
               end;
             end;
       if word='部门' then
       begin
         isbegin:=true;
       end
       else
         if word='发消息' then
         begin
           isbegin:=false;
           //在这里保存信息
           self.SaveInfo;
           if CurMobile='18322475983' then
           begin
             self.ADOConnection1.Close;
             Application.Terminate;
           end;
           if self.sCheckBox1.Checked then//如果自动进行
           begin
             self.GoToDown;
             Self.sBitBtn2Click(self);
           end;
         end;
       if isbegin then
       begin
         if (left_>=113) and (left_<=115) then
         begin
           if (Length(Self.sMemo4.Lines[Self.sMemo4.Lines.Count-1])>=21) and (Length(Self.sMemo4.Lines[Self.sMemo4.Lines.Count-1])<=22) then
           begin
             if Pos('/',Self.sMemo4.Lines[Self.sMemo4.Lines.Count-1])>0 then
             begin
               Self.sMemo4.Lines[Self.sMemo4.Lines.Count-1]:=Self.sMemo4.Lines[Self.sMemo4.Lines.Count-1]+arytxt[r]['words'].AsString;
             end
             else
               self.sMemo4.Lines.Add(arytxt[r]['words'].AsString);
           end
           else
             self.sMemo4.Lines.Add(arytxt[r]['words'].AsString);
         end;
       end;
    end;
  end
  else
     if self.sCheckBox1.Checked then//如果自动进行
     begin
       self.GoToDown;
       Self.sBitBtn2Click(self);
     end;
end;

end.