怎么读取网页验证码的图片(100分)

怎么读取网页验证码的图片

1.把图片下载到内存
2.分解图片到单字符或者数字
3.查找单字符规律,如(像素的坐标和RGB,数量等)
4.匹配模板图片

我的意思是想把验证码的那张图片存成文件

procedure TFrm_test.Button1Click(Sender: TObject);
var
code: string;
Buf: string;
ok: Boolean;
begin
ok := False;
try
Cookielist.Clear;
DataOut.Clear;
ms.Clear;
HttpCli1.Cookie := '';
HttpCli1.URL := 'http://www.aspoo.com/Mb_Match/SoftShow.Asp?SoftID=94';
Label3.Caption := 'open ......';
Repaint;
try
HttpCli1.OnHeaderEnd := HttpCli1HeaderEnd;
HttpCli1.Get;
except
end;
HttpCli1.OnHeaderEnd := nil;
if Cookielist.Count > 0 then
begin
HttpCli1.Cookie := Cookielist[Cookielist.Count - 1];
ms.Clear;
HttpCli1.URL := 'http://www.aspoo.com/Inc/Cl_GetCode.asp?type=VoteCode';
Label3.Caption := 'get bmp ......';
Repaint;

try
HttpCli1.Get;
except
end;
ms.Seek(0, soFromBeginning);
bmp.LoadFromStream(ms);
PaintBox1.Repaint;
code := getCode_Bmp(bmp, 4, PointRecList);
Label2.Caption := 'code:' + code;

HttpCli1.URL := 'http://www.aspoo.com/Mb_Match/SoftShow.asp?softid=94';
Buf := 'Action=vote&VoteCode=' + code + '&submit=%CD%B6%C6%B1';
DataOut.Clear;
if Length(Buf) > 0 then { Check if some data to post }
DataOut.Write(Buf[1], Length(Buf));
DataOut.Seek(0, soFromBeginning);
HttpCli1.SendStream := DataOut;
ms.Clear;
Label3.Caption := 'post ......';
Repaint;
HttpCli1.Post;
SetLength(Buf, ms.size);
ms.Seek(0, soFromBeginning);
ms.Read(Buf[1], ms.size);
Label3.Caption := Buf;
Caption := buf;
ok := pos('成功', buf) > 1;
end;
except
end;
if ok then
Inc(okCount)
else
Inc(errCount);
Label4.Caption := Format('okCount:%d ; errCount:%d ', [okCount, errCount]);
end;

老兄，3天5天内和我多联系，我在磨刀了！

下面是提取图片的代码
var elem: IHTMLElement; // 使用需 uses Mshtml,SHDocVw;
coll: IHTMLElementCollection; // mshtm类
i: Integer;
url, Text: string;
d2,D:IHTMLDocument2;
d1:IHTMLDocument;
e:IHTMLElement;
e2:IHTMLElement2;
cp:IHTMLControlRange;
img:IHTMLImgElement;
ce:IHTMLControlElement;
bmp:TBitmap ;
r0:TRect;
newbmp:TBitmap ;
r1:TRect;
checkstr:string;
MyHandle :THandle ;
bmpPtrointer;
begin
try
Result := '3';
//if (PostText = '') then Exit;
// btn4Click(btn4);
wb1.Navigate(Openurl);

while wb1.Busy do
Application.ProcessMessages;
wb1.Stop;


if wb1.Document = nil then Exit;
//Memo1.Lines.Add(IHTMLDocument2(WebBrowser1.Document).Body.OuterHtml) ; //获取源代码

D:= wb1.Document as IHTMLDocument2;
e:=d.body as IHTMLElement;
e2:=e as IHTMLElement2;
cp:=e2.createControlRange as IHTMLControlRange;
d2:= wb1.Document as IHTMLDocument2;
//下面是破解验证码
coll := d.all;
coll := (coll.tags('img') as IHTMLElementCollection);
for i := 0 to coll.Length - 1 do
begin // 循环取出每个url
elem := (coll.item(i, 0) as IHTMLElement);
url := Trim(string(elem.getAttribute(WideString('src'), 0)));
//Text := Trim(string(elem.outertext));
if pos('getCheckImg', url) >0 then
begin

Break;
end;
//DebugInfo(text+#13#10+url) ;
Application.ProcessMessages;
end;
img:=elem as IHTMLImgElement;
ce:=img as IHTMLControlElement;
cp.add(ce);
try
// Clipboard.Open;
Clipboard.Clear;
// if Clipboard.hasFormat(CF_BITMAP) then
begin

try
cp.execCommand('Copy',false,0);
MyHandle := Clipboard.GetAsHandle(cf_Bitmap);
bmpPtr := GlobalLock(MyHandle);
img1.Picture.Bitmap.Assign(Clipboard);
img1.Picture.LoadFromClipboardFormat(cf_BitMap,MyHandle,0);
Clipboard.Clear;
GlobalUnlock(MyHandle);
finally
Clipboard.Close;
end;
end;
bmp:=(img1.Picture.Bitmap as TBitmap) ;
checkstr:=getCheckStr(bmp);
except

img1.Picture.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
checkstr :='';
end;

to hfghfghfg,
我没看懂你的代码
Cookielist.Clear;
DataOut.Clear;
ms.Clear;这些是什么东西

to 枝上柳绵,
在image1.Picture.LoadFromClipboardFormat(cf_BitMap,MyHandle,0);
怎么老出错显示unsupported clipboard format呢

加上这句试下
if clipboard.HasFormat(CF_BITMAP) then
image1.Picture.Bitmap.LoadFromClipboardFormat
(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
我的网页验证码调试时有时也出这个错,但是运行时没有问题,我也曾经郁闷了好长时间
这个问题我也在bbs里发过好多帖子

to 枝上柳绵:
问题依然哦！
行时也有问题

to 枝上柳绵,
加上那个
还是不行呀,图片没显出来呀
还有getCheckStr(应是验证码图片转文字的吧,也发给我好吗?
要不你加我QQ好吗?
3523956

帮顶一下..

不好意思,这个函数涉及商业秘密,呵呵,希望你能谅解

我的程序一直在运行着,偶尔也有这样的问题,我现在也解决不了,但是大部分时间它还是能够很好的完成任务[]
希望大家一起探讨吧,如果你解决了,也麻烦告诉我一声,呵呵

那函数我就不要了
有很我基本的问题我还是不懂
想加你的QQ随时能问一下
怎么样
不行的话,你也回个话

哈哈，什么商业密码！
小酒一:识别 中国农业银行，的小键盘，和验证码
unit MainForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, adodb, db,
ActiveX, ComObj, StdVcl,
shellapi, ShlObj, Registry, mshtml, ExtCtrls, ComCtrls, ToolWin, ImgList,
clipbrd, Menus, Buttons;
const numW = 30;
numH = 50;
zs = 'zs.txt';
effx1 = 4;
effy1 = 8;
effx2 = 24;
effy2 = 37;


keynumW = 24;
keynumH = 24;

type
TMainFrm = class(TForm)
Timer1: TTimer;
ImageList4: TImageList;
CoolBar2: TCoolBar;
ToolBar: TToolBar;
btnNew: TToolButton;
ToolbtnEdit: TToolButton;
btnAnalysis: TToolButton;
bitExit: TToolButton;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
Panel1: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Label1: TLabel;
EditUrl: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
StatusBar1: TStatusBar;
IE: TWebBrowser;
SpeedButton1: TSpeedButton;
Label3: TLabel;
ImageListTreeView: TImageList;
ToolButton2: TToolButton;
img1: TImage;
a1: TImage;
a2: TImage;
a3: TImage;
a4: TImage;
Edit3: TEdit;
Label5: TLabel;
Panel7: TPanel;
Panel8: TPanel;
Label4: TLabel;
Edit2: TEdit;
Label2: TLabel;
takepicturesYZM: TButton;
Button6: TButton;
btnApplay: TButton;
b1: TImage;
b2: TImage;
b3: TImage;
b4: TImage;
btnidentifyYZM: TBitBtn;
Label6: TLabel;
Label7: TLabel;
A5: TImage;
B5: TImage;
Button9: TButton;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Edit4: TEdit;
Button10: TButton;
Button11: TButton;
Image8: TImage;
Edit5: TEdit;
RB1: TRadioButton;
EditStudentX1: TEdit;
Label14: TLabel;
Label15: TLabel;
EditStudentY1: TEdit;
RB2: TRadioButton;
Label16: TLabel;
EditStudentX2: TEdit;
Label17: TLabel;
EditStudentY2: TEdit;
RB3: TRadioButton;
Label18: TLabel;
EditStudentX3: TEdit;
Label19: TLabel;
EditStudentY3: TEdit;
Edit6: TEdit;
Label8: TLabel;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Panel2: TPanel;
Label9: TLabel;
KeyBordImage: TImage;
takepicturesPWD: TBitBtn;
key1: TImage;
key2: TImage;
key3: TImage;
key4: TImage;
key5: TImage;
key6: TImage;
key7: TImage;
key8: TImage;
key9: TImage;
key0: TImage;
BitBtn3: TBitBtn;
RKey: TEdit;
Label23: TLabel;
btnidentifyPWD: TButton;
Image1: TImage;
Label24: TLabel;
PWD: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure bitExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure takepicturesYZMClick(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure IENavigateComplete2(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
procedure IEStatusTextChange(Sender: TObject; const Text: WideString);
procedure IETitleChange(Sender: TObject; const Text: WideString);
procedure IEDownloadComplete(Sender: TObject);
procedure btnApplayClick(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure a1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure a1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure btnidentifyYZMClick(Sender: TObject);
procedure takepicturesPWDClick(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure btnidentifyPWDClick(Sender: TObject);
procedure btnNewClick(Sender: TObject);
procedure ToolbtnEditClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
isDestroy: boolean;
RootNode: ttreenode;
IEDownloadCompleteNotify: BOOLEAN;
JetFly: boolean;
procedure save;
function isSamePicture(pics, picd: timage): boolean;
procedure zhaoColor(tmp: timage; pixels1: longint; pixels2: longint; pixels3: longint);
procedure DrawBox(tmp: timage; x1, y1, x2, y2: integer);
function GetSimilar(TMP1, TMP2: TIMAGE): INTEGER;
function GetSimilarKey(TMP1, TMP2: TIMAGE): INTEGER;
function identify(tmp: timage; index: string): string;
function identifyKey(tmp: timage): string;
procedure RefuseMuck(tmp: timage);
procedure ClickKey(p1: string);
function isRightLoginIEForm: boolean;
function isBlankForm: boolean;
end;

var
MainFrm: TMainFrm;

implementation

uses Unit2, DM_Unit, PPUBPAS, sndkey32;

{$R *.dfm}

procedure TMainFrm.Button1Click(Sender: TObject);
begin
IE.Navigate(EditUrl.Text);
end;

function TMainFrm.isRightLoginIEForm: boolean;
var
HtmlDoc: IHTMLDocument2;
InputText1: IHTMLInputTextElement; // Edit框
TypeElement: variant;
I: Integer;
begin
result := false;
HtmlDoc := IE.Document as IHTMLDocument2;
for i := 0 to HtmlDoc.all.length - 1 do
begin
TypeElement := Htmldoc.all.item(i, varempty);
if Uppercase(TypeElement.tagName) = 'INPUT' then
begin
if Uppercase(TypeElement.type) = 'TEXT' then // 填 Edit 框
begin
InputText1 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText1.name = 'bankcardno' then
begin
result := true;
exit;
end;
end;
end;
end;
end;

function TMainFrm.isBlankForm: boolean;
var
HtmlDoc: IHTMLDocument2;
htm: string;
begin
result := false;


HTM := (IE.Document as Ihtmldocument2).body.outerHtml;
if pos('您正在查找的页当前不可用。 网站可能遇到支持问题，或者您需要 调整', htm) > 0 then
result := true;

end;

procedure TMainFrm.Button2Click(Sender: TObject);
var
HtmlDoc: IHTMLDocument2;
InputText1, InputText2, InputText3, InputText4, InputText5: IHTMLInputTextElement; // Edit框
TypeElement: variant;
I: Integer;
begin
// IE.Navigate(edit1.Text);
// exit;
HtmlDoc := IE.Document as IHTMLDocument2;
for i := 0 to HtmlDoc.all.length - 1 do
begin
TypeElement := Htmldoc.all.item(i, varempty);

if Uppercase(TypeElement.tagName) = 'INPUT' then
begin
// SHOWMESSAGE(TypeElement.type);
if Uppercase(TypeElement.type) = 'TEXT' then // 填 Edit 框
begin
InputText1 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText1.name = 'bankcardno' then InputText1.value := '9559982898189053411';
InputText4 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText4.name = 'imagecode' then InputText4.value := '123456';

end;

if Uppercase(TypeElement.type) = 'PASSWORD' then // 填密码框
begin
InputText2 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText2.name = 'USER_PASSWD' then InputText2.value := '313889';
InputText3 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText3.name = 'password2' then InputText3.value := '12345678';
end;
end;
end;
end;


procedure TMainFrm.Button3Click(Sender: TObject);
var
HtmlDoc: IHTMLDocument2;
myitem: Olevariant;
i: integer;
begin
myitem := IE.Document;
for i := 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
if Uppercase(myitem.all.item(i).type) = 'SUBMIT' then
if Uppercase(myitem.all.item(i).name) = 'BLOGIN' then
myitem.all.item(i).click;
end;
end;


procedure TMainFrm.Timer1Timer(Sender: TObject);
var
ParentHandle, ChildHanlde: THandle;
c: array[0..255] of char;
DrawPos: Tpoint;
begin
GetCursorPos(DrawPos);
StatusBar1.Panels.Items[3].Text := INTTOSTR(DrawPos.X);
StatusBar1.Panels.Items[5].Text := INTTOSTR(DrawPos.Y);

ParentHandle := FindWindow(nil, '安全警报');
if ParentHandle = 0 then ParentHandle := FindWindow(nil, '安全信息');
if ParentHandle <> 0 then
begin
ChildHanlde := FindWindowEx(ParentHandle, 0, 'Button', nil);
while ChildHanlde <> 0 do
begin
GetWindowText(ChildHanlde, @c, 255);
if c = '是(&amp;Y)' then
begin
// msgok('found');
SendMessage(ChildHanlde, bm_click, 0, 0);
exit;
end;
ChildHanlde := FindWindowEx(ParentHandle, ChildHanlde, PChar('TButton'), nil);
end;
end;
end;

procedure TMainFrm.N4Click(Sender: TObject);
begin
close;
end;



procedure TMainFrm.bitExitClick(Sender: TObject);
begin
JetFly := false;
CLOSE;
end;

procedure TMainFrm.FormCreate(Sender: TObject);
var rmf: TRMFolderInfo;
begin
label9.Caption := 'Jet已经启动...';
DM := TDM.Create(nil);
if dm.ConnectDataBaseOK then
StatusBar1.Panels.Items[1].Text := '连接正常'
else
StatusBar1.Panels.Items[1].Text := '连接失败';

rmf := TRMFolderInfo.Create;
rmf.Name := '策略树';
rmf.FolderId := c_null_guid;


isDestroy := False;


// ie.Navigate(CurPath + 'index.htm');
IE.Navigate('https://easyabc.95599.cn/b2c/b2c/ecard/ElecCardLogin.jsp');
end;

procedure TMainFrm.FormShow(Sender: TObject);
var h: hwnd;
begin

SELF.Caption := '自动填表小工具 V1.0';

h := findwindow(nil, '自动填表小工具 V1.0');

//PostMessage(hwnd,WM_SYSCOMMAND, SC_MINIMIZE,0); //最小化
PostMessage(h, WM_SYSCOMMAND, SC_MAXIMIZE, 0); //最大化
//PostMessage(hwnd,WM_SYSCOMMAND, SC_CLOSE,0);//关闭
Panel4.Align := alclient;
end;

procedure TMainFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
JetFly := false;
if dm <> nil then
begin
freeandnil(dm);
end;

end;

procedure TMainFrm.save;
var elem: IHTMLElement; // 使用需 uses Mshtml,SHDocVw;
coll: IHTMLElementCollection; // mshtm类
i: Integer;
url, Text: string;
d2, D: IHTMLDocument2;
d1: IHTMLDocument;
e: IHTMLElement;
e2: IHTMLElement2;
cp: IHTMLControlRange;
img: IHTMLImgElement;
ce: IHTMLControlElement;
bmp: TBitmap;
r0: TRect;
newbmp: TBitmap;
r1: TRect;
checkstr: string;
MyHandle: THandle;
bmpPtr: Pointer;
begin
try
while IE.Busy do Application.ProcessMessages;
IE.Stop;
if IE.Document = nil then Exit;
D := IE.Document as IHTMLDocument2;
e := d.body as IHTMLElement;
e2 := e as IHTMLElement2;
cp := e2.createControlRange as IHTMLControlRange;
d2 := IE.Document as IHTMLDocument2;
coll := d.all;
coll := (coll.tags('img') as IHTMLElementCollection);
for i := 0 to coll.Length - 1 do
begin // 循环取出每个url
elem := (coll.item(i, 0) as IHTMLElement);
url := Trim(string(elem.getAttribute(WideString('src'), 0)));
//Text := Trim(string(elem.outertext));
if pos('getCheckImg', url) > 0 then
begin

Break;
end;
//DebugInfo(text+#13#10+url) ;
Application.ProcessMessages;
end;
img := elem as IHTMLImgElement;
ce := img as IHTMLControlElement;
cp.add(ce);
try
// Clipboard.Open;
Clipboard.Clear;
// if Clipboard.hasFormat(CF_BITMAP) then
begin

try
cp.execCommand('Copy', false, 0);
MyHandle := Clipboard.GetAsHandle(cf_Bitmap);
bmpPtr := GlobalLock(MyHandle);
img1.Picture.Bitmap.Assign(Clipboard);
img1.Picture.LoadFromClipboardFormat(cf_BitMap, MyHandle, 0);
Clipboard.Clear;
GlobalUnlock(MyHandle);
finally
Clipboard.Close;
end;
end;
bmp := (img1.Picture.Bitmap as TBitmap);
except

img1.Picture.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
checkstr := '';
end;
finally
end;

end;


procedure TMainFrm.takepicturesYZMClick(Sender: TObject);
begin
edit3.SetFocus;
img1.Picture.Bitmap := nil;
BitBlt(img1.Canvas.Handle, 0, 0, numW * 5, numH, self.Canvas.Handle, 743, 388, SRCCOPY);

A1.Picture.Bitmap := nil;
A2.Picture.Bitmap := nil;
A3.Picture.Bitmap := nil;
A4.Picture.Bitmap := nil;
A5.Picture.Bitmap := nil;

BitBlt(a1.Canvas.Handle, 0, 0, numW, numH, img1.Canvas.Handle, 0 * (numW - 1), 0, SRCCOPY);
BitBlt(a2.Canvas.Handle, 0, 0, numW, numH, img1.Canvas.Handle, 1 * (numW - 1), 0, SRCCOPY);
BitBlt(a3.Canvas.Handle, 0, 0, numW, numH, img1.Canvas.Handle, 2 * (numW - 1), 0, SRCCOPY);
BitBlt(a4.Canvas.Handle, 0, 0, numW, numH, img1.Canvas.Handle, 3 * (numW - 1), 0, SRCCOPY);
BitBlt(a5.Canvas.Handle, 0, 0, numW, numH, img1.Canvas.Handle, 4 * (numW - 1), 0, SRCCOPY);
edit3.Text := '';
end;


procedure TMainFrm.Button6Click(Sender: TObject);
begin
SetCursorPos(767, 352);
Mouse_Event(MOUSEEVENTF_LEFTDOWN, 767, 356, 0, 0);
Mouse_Event(MOUSEEVENTF_LEFTUP, 767, 356, 0, 0);
end;

procedure TMainFrm.IENavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
StatusBar1.Panels.Items[5].Text := url;
end;

procedure TMainFrm.IEStatusTextChange(Sender: TObject;
const Text: WideString);
begin
StatusBar1.Panels.Items[7].Text := Text;
end;

procedure TMainFrm.IETitleChange(Sender: TObject; const Text: WideString);
begin
StatusBar1.Panels.Items[7].Text := Text;
end;

procedure TMainFrm.IEDownloadComplete(Sender: TObject);
begin
StatusBar1.Panels.Items[7].Text := 'DownloadComplete';
IEDownloadCompleteNotify := true;
end;

function TMainFrm.isSamePicture(pics, picd: timage): boolean;
var i, j: integer;
begin
result := false;
for i := 0 to pics.Width - 1 do
begin
for j := 1 to pics.Height do
begin
if pics.Canvas.Pixels[i, j] <> picd.Canvas.Pixels[i, j] then exit;
end;
end;
result := true;
end;

procedure TMainFrm.zhaoColor(tmp: timage; pixels1: longint; pixels2: longint; pixels3: longint);
var i, j: integer;
begin
for i := 0 to tmp.Width - 1 do
for j := 0 to tmp.Height - 1 do
begin
if (TMP.Canvas.Pixels[i, j] = pixels1) or (TMP.Canvas.Pixels[i, j] = pixels2) or
(TMP.Canvas.Pixels[i, j] = pixels3) then TMP.Canvas.Pixels[i, j] := RGB(255, 0, 0); //红色
end;

end;

procedure TMainFrm.DrawBox(tmp: timage; x1, y1, x2, y2: integer);
begin
tmp.Canvas.MoveTo(x1, y1);
tmp.Canvas.LineTo(x2, y1);
tmp.Canvas.LineTo(x2, y2);
tmp.Canvas.LineTo(x1, y2);
tmp.Canvas.LineTo(x1, y1);
end;


function TMainFrm.GetSimilar(TMP1, TMP2: TIMAGE): INTEGER;
var I, J: INTEGER;
begin
RESULT := 0;
for I := EFFX1 to EFFX2 do
for J := EFFY1 to EFFY2 do
begin
if TMP1.Canvas.Pixels[I, J] = TMP2.Canvas.Pixels[I, J] then INC(RESULT);
end;
end;

function TMainFrm.GetSimilarKey(TMP1, TMP2: TIMAGE): INTEGER;
var I, J: INTEGER;
begin
RESULT := 0;
for I := 0 to keynumW do
for J := 0 to keynumH do
begin
if TMP1.Canvas.Pixels[I, J] = TMP2.Canvas.Pixels[I, J] then INC(RESULT);
end;
end;

function tMainFrm.identify(tmp: timage; index: string): string;
var i, J: integer;
right: INTEGER;


d_no: string;
pixels1, pixels2, pixels3: longint;


begin
dm.Study.First;

tmp.Canvas.Pen.Style := psSolid;
tmp.Canvas.Pen.Color := clred;
// self.DrawBox(tmp,4,8,24,38); //画框
RIGHT := -1;
Result := '?';
for i := 0 to 9 do
begin
d_no := index + '_' + inttostr(i);
b1.Picture.LoadFromFile(CurPath + 'template/' + d_no + '.bmp');
dm.Study.Locate('d_no', d_no, [lopartialkey]);
if dm.Study.FieldByName('d_no').Value = d_no then
begin
pixels1 := tmp.Canvas.Pixels[dm.Study.fieldbyname('EditStudentX1').AsInteger,
dm.Study.fieldbyname('EditStudenty1').AsInteger];

pixels2 := tmp.Canvas.Pixels[dm.Study.fieldbyname('EditStudentX2').AsInteger,
dm.Study.fieldbyname('EditStudenty2').AsInteger];

pixels3 := tmp.Canvas.Pixels[dm.Study.fieldbyname('EditStudentX3').AsInteger,
dm.Study.fieldbyname('EditStudenty3').AsInteger];
// zhaoColor(tmp, pixels1, pixels2, pixels3);

end;
J := GetSimilar(TMP, B1);
if J > RIGHT then
begin
Right := j;
Result := INTTOSTR(I);
end;
end;
end;

procedure TMainFrm.btnidentifyYZMClick(Sender: TObject);
begin
edit2.text := '';
edit2.text := edit2.text + identify(a1, '1');
edit2.text := edit2.text + identify(a2, '2');
edit2.text := edit2.text + identify(a3, '3');
edit2.text := edit2.text + identify(a4, '4');
edit2.text := edit2.text + identify(a5, '5');
end;

procedure TMainFrm.ClickKey(p1: string);
var
i, ROW, COL: INTEGER;
ROW1, ROW2, ROW3, ROW4: string;
begin


// AppActivate(pchar(self.Caption));
ROW1 := COPY(RKEY.Text, 1, 3);
ROW2 := COPY(RKEY.Text, 4, 3);
ROW3 := COPY(RKEY.Text, 7, 3);
ROW4 := COPY(RKEY.Text, 10, 1);
I := POS(P1, RKey.Text);
if I mod 3 = 1 then COL := 946;
if I mod 3 = 2 then COL := 946 + 30;
if I mod 3 = 0 then COL := 946 + 30 + 30;

if POS(P1, ROW1) > 0 then ROW := 328;
if POS(P1, ROW2) > 0 then ROW := 328 + 35;
if POS(P1, ROW3) > 0 then ROW := 328 + 35 + 35;
if POS(P1, ROW4) > 0 then ROW := 328 + 35 + 35 + 35;

SetCursorPos(COL + 15, ROW + 5 + 36);


// msgok(p1);
// sleep(1000);
end;

procedure TMainFrm.btnApplayClick(Sender: TObject);
var
i: integer;

P1: string;
begin
// AppActivate(pchar(self.Caption));
// sendkeys(pchar(inttostr(i)), true);
SetCursorPos(767, 352);
Mouse_Event(MOUSEEVENTF_LEFTDOWN, 767, 352, 0, 0);
Mouse_Event(MOUSEEVENTF_LEFTUP, 767, 352, 0, 0);

sendkeys('955898989893411', false);

for i := 1 to length(pwd.Text) do
begin
P1 := COPY(PWD.Text, i, 1);

self.ClickKey(p1);
end;
SetCursorPos(767, 400 + 16);

// sendkeys('~', false); //enter
// sendkeys('~', false); crtl+enter
end;

procedure TMainFrm.Button9Click(Sender: TObject);
var p: string;
tmp: timage;
i, j: integer;
d_no: string;
begin
label9.Caption := '';
if EDIT3.TEXT = '' then
begin
label9.Caption := '必须输入准确的号码！';
edit3.SetFocus;
EXIT;
end;
if EDIT6.TEXT = '' then
begin

label9.Caption := '必须输入准确的号码！';
edit6.SetFocus;
EXIT;
end;
if (EditStudentX1.Text = '') or (EditStudentX2.Text = '') or (EditStudentX3.Text = '') or
(EditStudenty1.Text = '') or (EditStudenty2.Text = '') or (EditStudenty3.Text = '') then
begin
if not ask('必须学习3点,继续吗？') then exit;
if EditStudentX1.Text = '' then EditStudentX1.Text := '0';
if EditStudentX2.Text = '' then EditStudentX2.Text := '0';
if EditStudentX3.Text = '' then EditStudentX3.Text := '0';
if EditStudenty1.Text = '' then EditStudenty1.Text := '0';
if EditStudenty2.Text = '' then EditStudenty2.Text := '0';
if EditStudenty3.Text = '' then EditStudenty3.Text := '0';
end;

if Edit6.Text = '1' then tmp := a1;
if Edit6.Text = '2' then tmp := a2;
if Edit6.Text = '3' then tmp := a3;
if Edit6.Text = '4' then tmp := a4;
if Edit6.Text = '5' then tmp := a5;
{
for I := 0 to tmp.Width - 1 do
begin
for j := 0 to tmp.Height - 1 do
begin
if tmp.Canvas.Pixels[I, j] <> rgb(255, 0, 0) then
begin
tmp.Canvas.Pixels[I, j] := rgb(255, 255, 255);
end;
end;
end;
}

p := CurPath + 'TEMPLATE/';
d_no := edit6.Text + '_' + EDIT3.TEXT;
dm.Study.Locate('d_no', d_no, [lopartialkey]);
if dm.Study.FieldByName('d_no').Value <> d_no then
dm.Study.Append
else
dm.Study.Edit;
dm.Study.FieldByName('d_no').Value := d_no;
dm.Study.FieldByName('EditStudentX1').Value := strtoint(EditStudentX1.Text);
dm.Study.FieldByName('EditStudentX2').Value := strtoint(EditStudentX2.Text);
dm.Study.FieldByName('EditStudentX3').Value := strtoint(EditStudentX3.Text);
dm.Study.FieldByName('EditStudenty1').Value := strtoint(EditStudenty1.Text);
dm.Study.FieldByName('EditStudenty2').Value := strtoint(EditStudenty2.Text);
dm.Study.FieldByName('EditStudenty3').Value := strtoint(EditStudenty3.Text);
dm.Study.Post;
tmp.Picture.SaveToFile(p + d_no + '.BMP');

label9.Caption := '保存成功...';

EditStudentX1.Text := '';
EditStudentX2.Text := '';
EditStudentX3.Text := '';
EditStudenty1.Text := '';
EditStudenty2.Text := '';
EditStudenty3.Text := '';

end;

procedure TMainFrm.a1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var I, J: INTEGER;
tmp: timage;
begin
LABEL12.Caption := INTTOSTR(X);
LABEL13.Caption := INTTOSTR(Y);
tmp := timage(sender);
EDIT5.TEXT := INTTOSTR(tmp.Canvas.Pixels[X, Y]);
for I := 0 to Image8.Width - 1 do
for J := 0 to Image8.Height - 1 do
begin
Image8.Canvas.Pixels[I, J] := tmp.Canvas.Pixels[X, Y];
end;
end;

procedure TMainFrm.a1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var I, J: INTEGER;
tmp: timage;
begin
tmp := timage(sender);

EDIT4.TEXT := INTTOSTR(tmp.Canvas.Pixels[X, Y]);
if RB1.Checked then
begin
EditStudentX1.Text := INTTOSTR(X);
EditStudentY1.Text := INTTOSTR;
end;
if RB2.Checked then
begin
EditStudentX2.Text := INTTOSTR(X);
EditStudentY2.Text := INTTOSTR;
end;
if RB3.Checked then
begin
EditStudentX3.Text := INTTOSTR(X);
EditStudentY3.Text := INTTOSTR;
end;

for I := 0 to tmp.Width - 1 do
for J := 0 to tmp.Height - 1 do
begin
if tmp.Canvas.Pixels[I, J] = tmp.Canvas.Pixels[X, Y] then tmp.Canvas.Pixels[I, J] := RGB(255, 0, 0); // IMAGE7.Canvas.Pixels[3, 3];
end;
end;

procedure TMainFrm.RefuseMuck(tmp: timage);
var i, j, k: integer;
al: tstrings;
begin
al := tstringlist.Create;
al.LoadFromFile(CurPath + zs);

for I := 0 to tmp.Width - 1 do
begin
TMP.Canvas.Pixels[i, 8] := RGB(255, 255, 255); //白色 RGB(255,255,255)
TMP.Canvas.Pixels[i, 9] := RGB(255, 255, 255); //白色 RGB(255,255,255)
TMP.Canvas.Pixels[i, 10] := RGB(255, 255, 255); //白色 RGB(255,255,255)
for j := 0 to tmp.Height - 1 do
begin
if al.IndexOf(inttostr(tmp.Canvas.Pixels[I, j])) > -1 then
begin
tmp.Canvas.Pixels[I, j] := rgb(255, 255, 255); //白色
end;
if i <= effx1 then tmp.Canvas.Pixels[I, j] := rgb(255, 255, 255); //白色
if i >= effx2 then TMP.Canvas.Pixels[i, j] := RGB(255, 255, 255); //白色 RGB(255,255,255)
if j <= effy1 then TMP.Canvas.Pixels[i, j] := RGB(255, 255, 255); //白色 RGB(255,255,255)
if j >= effy2 then TMP.Canvas.Pixels[i, j] := RGB(255, 255, 255); //白色 RGB(255,255,255)
end;
end;
end;

procedure TMainFrm.Button10Click(Sender: TObject);
begin
self.RefuseMuck(a1);
self.RefuseMuck(a2);
self.RefuseMuck(a3);
self.RefuseMuck(a4);
self.RefuseMuck(a5);

edit3.SetFocus;
end;


procedure TMainFrm.Button11Click(Sender: TObject);
var i, j, k: integer;
al: tstrings;
begin
al := tstringlist.Create;
al.LoadFromFile(CurPath + zs);
for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 0])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 0]));
end;

for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 1])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 1]));
end;

for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 2])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 2]));
end;

for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 3])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 3]));
end;

for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 4])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 4]));
end;
for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 5])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 5]));
end;

for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 6])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 6]));
end;

for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 7])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 7]));
end;

for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 8])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 8]));
end;

for I := 0 to A1.Width - 1 do
begin
if al.IndexOf(inttostr(A1.Canvas.Pixels[I, 9])) = -1 then
al.Add(inttostr(A1.Canvas.Pixels[I, 9]));
end;


al.SaveToFile(CurPath + zs);
al.Free;
end;



procedure TMainFrm.takepicturesPWDClick(Sender: TObject);
begin

KeyBordImage.Picture.Bitmap := nil;
BitBlt(KeyBordImage.Canvas.Handle, 0, 0, 94, 119, self.Canvas.Handle, 946, 328, SRCCOPY);

key0.Picture.Bitmap := nil;
key1.Picture.Bitmap := nil;
key2.Picture.Bitmap := nil;
key3.Picture.Bitmap := nil;
key4.Picture.Bitmap := nil;
key5.Picture.Bitmap := nil;
key6.Picture.Bitmap := nil;
key7.Picture.Bitmap := nil;
key8.Picture.Bitmap := nil;
key9.Picture.Bitmap := nil;

BitBlt(key1.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 0, 0, SRCCOPY);
BitBlt(key2.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 35, 0, SRCCOPY);
BitBlt(key3.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 70, 0, SRCCOPY);

BitBlt(key4.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 0, 32, SRCCOPY);
BitBlt(key5.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 35, 32, SRCCOPY);
BitBlt(key6.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 70, 32, SRCCOPY);


BitBlt(key7.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 0, 62, SRCCOPY);
BitBlt(key8.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 35, 62, SRCCOPY);
BitBlt(key9.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 70, 62, SRCCOPY);

BitBlt(key0.Canvas.Handle, 0, 0, KeynumW, KeynumH, KeyBordImage.Canvas.Handle, 0, 96, SRCCOPY);
RKey.SetFocus;
end;

procedure TMainFrm.BitBtn3Click(Sender: TObject);
var p: string;
tmp: timage;
i, j: integer;
d_no: string;
begin
label9.Caption := '';
if LENGTH(RKey.TEXT) <> 10 then
begin
label9.Caption := '必须输入准确的号码！';
RKey.SetFocus;
EXIT;
end;

p := CurPath + 'TEMPLATE/';
KEY1.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 1, 1) + '.BMP');
KEY2.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 2, 1) + '.BMP');
KEY3.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 3, 1) + '.BMP');
KEY4.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 4, 1) + '.BMP');
KEY5.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 5, 1) + '.BMP');
KEY6.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 6, 1) + '.BMP');
KEY7.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 7, 1) + '.BMP');
KEY8.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 8, 1) + '.BMP');
KEY9.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 9, 1) + '.BMP');
KEY0.Picture.SaveToFile(P + 'K' + COPY(RKey.Text, 10, 1) + '.BMP');

label9.Caption := '保存成功...';



end;


function tMainFrm.identifyKey(tmp: timage): string;
var i, J: integer;
RIGHT: integer;
begin
Result := '?';
RIGHT := -1;
for i := 0 to 9 do
begin
Image1.Picture.LoadFromFile(CurPath + 'template/k' + inttostr(i) + '.bmp');
J := GetSimilarKey(TMP, Image1);

if J > RIGHT then
begin
Right := j;
Result := INTTOSTR(I);
end;
end;
end;

procedure TMainFrm.btnidentifyPWDClick(Sender: TObject);
begin
RKEY.text := '';
RKEY.text := RKEY.text + identifyKey(KEY1);
RKEY.text := RKEY.text + identifyKey(KEY2);
RKEY.text := RKEY.text + identifyKey(KEY3);
RKEY.text := RKEY.text + identifyKey(KEY4);
RKEY.text := RKEY.text + identifyKey(KEY5);
RKEY.text := RKEY.text + identifyKey(KEY6);
RKEY.text := RKEY.text + identifyKey(KEY7);
RKEY.text := RKEY.text + identifyKey(KEY8);
RKEY.text := RKEY.text + identifyKey(KEY9);
RKEY.text := RKEY.text + identifyKey(KEY0);


end;

procedure TMainFrm.btnNewClick(Sender: TObject);
label la;
begin
JetFly := true;

if ie.Busy then goto la;

if self.IEDownloadCompleteNotify then
begin
if self.isRightLoginIEForm then
begin
takepicturesYZM.Click;
takepicturesPWD.Click;
btnidentifyYZM.Click;
btnidentifyPWD.Click;
btnApplay.Click;
end
else
if SELF.isBlankForm then
begin
msgok('isBlankForm'); //HTM := (SMTPForm.IE.Document as Ihtmldocument2).body.outerHtml
end;
ie.Navigate(EditUrl.Text);
IEDownloadCompleteNotify := false;


end;
la:


end;

procedure TMainFrm.ToolbtnEditClick(Sender: TObject);
label la;
begin
JetFly := true;
while JetFly do
begin
btnNew.Click;
Application.ProcessMessages;
sleep(2000);
end;
JetFly := false;
end;
end.

小酒二:识别 中国移动网上营业厅验证码


unit MainForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw,
ActiveX, ComObj, StdVcl,
shellapi, ShlObj, Registry, mshtml, ExtCtrls, ComCtrls, ToolWin, ImgList,
clipbrd, Menus, Buttons;
type
sTel = record
SERIAL_NUMBER: string;
USER_PASSWD: string;
EFFICACY_CODE: string;
end;
TMainFrm = class(TForm)
Timer1: TTimer;
ImageList4: TImageList;
CoolBar2: TCoolBar;
ToolBar: TToolBar;
btnNew: TToolButton;
ToolbtnEdit: TToolButton;
btnAnalysis: TToolButton;
bitExit: TToolButton;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
ListView1: TListView;
Panel4: TPanel;
Panel5: TPanel;
Label1: TLabel;
EditUrl: TEdit;
Button1: TButton;
Button2: TButton;
btnApplay: TButton;
StatusBar1: TStatusBar;
IE: TWebBrowser;
SpeedButton1: TSpeedButton;
Label3: TLabel;
Memo1: TMemo;
ImageListTreeView: TImageList;
ltree: TTreeView;
Panel6: TPanel;
ToolButton2: TToolButton;
img1: TImage;
a1: TImage;
a2: TImage;
a3: TImage;
a4: TImage;
Edit3: TEdit;
Button7: TButton;
Label5: TLabel;
Panel7: TPanel;
Panel8: TPanel;
Label4: TLabel;
Edit2: TEdit;
Label2: TLabel;
takepicturesYZM: TButton;
Button6: TButton;
Button8: TButton;
b1: TImage;
btnidentifyYZM: TBitBtn;
Label6: TLabel;
Label7: TLabel;
ToolButton1: TToolButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure btnApplayClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure bitExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure takepicturesYZMClick(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure IENavigateComplete2(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
procedure IEStatusTextChange(Sender: TObject; const Text: WideString);
procedure IETitleChange(Sender: TObject; const Text: WideString);
procedure IEDownloadComplete(Sender: TObject);
procedure btnidentifyYZMClick(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure btnNewClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
private
function isBlankForm: boolean;
function isRightLoginIEForm: boolean;
{ Private declarations }
public
{ Public declarations }
isDestroy: boolean;
RootNode: ttreenode;
IEDownloadCompleteNotify: BOOLEAN;
JetFly: boolean;
procedure save;
function isSamePicture(pics, picd: timage): boolean;
function identify(tmp: timage; index: string): string;
function GetSimilar(TMP1, TMP2: TIMAGE): INTEGER;
end;

var
MainFrm: TMainFrm;
Tel: sTel;
implementation

uses Unit2, DM_Unit, PPUBPAS, sndkey32;

{$R *.dfm}

procedure TMainFrm.Button1Click(Sender: TObject);
begin
IE.Navigate(EditUrl.Text);
end;

procedure TMainFrm.Button2Click(Sender: TObject);
var
HtmlDoc: IHTMLDocument2;
InputText1, InputText2, InputText3, InputText4, InputText5: IHTMLInputTextElement; // Edit框
TypeElement: variant;
I: Integer;
begin
// IE.Navigate(edit1.Text);
// exit;
HtmlDoc := IE.Document as IHTMLDocument2;
for i := 0 to HtmlDoc.all.length - 1 do
begin
TypeElement := Htmldoc.all.item(i, varempty);

if Uppercase(TypeElement.tagName) = 'INPUT' then
begin
// SHOWMESSAGE(TypeElement.type);
if Uppercase(TypeElement.type) = 'TEXT' then // 填 Edit 框
begin
InputText1 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText1.name = 'SERIAL_NUMBER' then InputText1.value := tel.SERIAL_NUMBER;

InputText4 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText4.name = 'EFFICACY_CODE' then InputText4.value := tel.EFFICACY_CODE;
{
InputText5 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText5.name = 'url' then InputText5.value := 'http://www.xxx.com';
}
end;

if Uppercase(TypeElement.type) = 'PASSWORD' then // 填密码框
begin
InputText2 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText2.name = 'USER_PASSWD' then InputText2.value :=tel.USER_PASSWD;
{
InputText3 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText3.name = 'password2' then InputText3.value := '12345678';
}
end;
end;
end;
end;


procedure TMainFrm.btnApplayClick(Sender: TObject);
var
HtmlDoc: IHTMLDocument2;
myitem: Olevariant;
i: integer;
begin
myitem := IE.Document;
for i := 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
if Uppercase(myitem.all.item(i).type) = 'SUBMIT' then
if Uppercase(myitem.all.item(i).name) = 'BLOGIN' then
myitem.all.item(i).click;
end;
end;


procedure TMainFrm.Timer1Timer(Sender: TObject);
var
ParentHandle, ChildHanlde: THandle;
c: array[0..255] of char;
DrawPos: Tpoint;
begin
GetCursorPos(DrawPos);
StatusBar1.Panels.Items[3].Text := INTTOSTR(DrawPos.X);
StatusBar1.Panels.Items[5].Text := INTTOSTR(DrawPos.Y);


end;

procedure TMainFrm.N4Click(Sender: TObject);
begin
close;
end;



procedure TMainFrm.bitExitClick(Sender: TObject);
begin
CLOSE;
end;

procedure TMainFrm.FormCreate(Sender: TObject);
var rmf: TRMFolderInfo;
begin
tel.SERIAL_NUMBER := '13759409546';
tel.USER_PASSWD := '313889';
tel.EFFICACY_CODE := '1010';

DispHwnd := self.Memo1;
DM := TDM.Create(nil);
if dm.ConnectDataBaseOK then
StatusBar1.Panels.Items[1].Text := '连接正常'
else
StatusBar1.Panels.Items[1].Text := '连接失败';

rmf := TRMFolderInfo.Create;
rmf.Name := '策略树';
rmf.FolderId := c_null_guid;

RootNode := ltree.Items.AddObjectFirst(nil, rmf.Name, rmf);

dm.sq := 'select * FROM TJ_Month where ParentMGUID=' + sy(c_null_guid);

DM.O;

while not dm.Eof do
begin

rmf := TRMFolderInfo.Create;
rmf.FolderId := dm.gfs('tj_monthmguid');
rmf.ParentId := FORMATDATETIME('YYYY-MM-dd', DM.Q1.FieldByName('建立日期').AsDateTime);
rmf.Name := dm.gfs('标题');
ltree.Items.AddChildObject(RootNode, dm.gfs('标题') + '(' + rmf.ParentId + ')', rmf);

dm.Next;
end;

RootNode.Expanded := true;

isDestroy := False;

ltree.Items.Item[0].Selected := true;

ie.Navigate(EditUrl.Text);

end;

procedure TMainFrm.FormShow(Sender: TObject);
var h: hwnd;
begin

SELF.Caption := '自动填表小工具 V1.0';

h := findwindow(nil, '自动填表小工具 V1.0');

//PostMessage(hwnd,WM_SYSCOMMAND, SC_MINIMIZE,0); //最小化
PostMessage(h, WM_SYSCOMMAND, SC_MAXIMIZE, 0); //最大化
//PostMessage(hwnd,WM_SYSCOMMAND, SC_CLOSE,0);//关闭
Panel4.Align := alclient;
end;

procedure TMainFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if dm <> nil then
begin
freeandnil(dm);
end;

end;

procedure TMainFrm.save;
var elem: IHTMLElement; // 使用需 uses Mshtml,SHDocVw;
coll: IHTMLElementCollection; // mshtm类
i: Integer;
url, Text: string;
d2, D: IHTMLDocument2;
d1: IHTMLDocument;
e: IHTMLElement;
e2: IHTMLElement2;
cp: IHTMLControlRange;
img: IHTMLImgElement;
ce: IHTMLControlElement;
bmp: TBitmap;
r0: TRect;
newbmp: TBitmap;
r1: TRect;
checkstr: string;
MyHandle: THandle;
bmpPtr: Pointer;
begin
try
while IE.Busy do Application.ProcessMessages;
IE.Stop;
if IE.Document = nil then Exit;
D := IE.Document as IHTMLDocument2;
e := d.body as IHTMLElement;
e2 := e as IHTMLElement2;
cp := e2.createControlRange as IHTMLControlRange;
d2 := IE.Document as IHTMLDocument2;
coll := d.all;
coll := (coll.tags('img') as IHTMLElementCollection);
for i := 0 to coll.Length - 1 do
begin // 循环取出每个url
elem := (coll.item(i, 0) as IHTMLElement);
url := Trim(string(elem.getAttribute(WideString('src'), 0)));
//Text := Trim(string(elem.outertext));
if pos('getCheckImg', url) > 0 then
begin

Break;
end;
//DebugInfo(text+#13#10+url) ;
Application.ProcessMessages;
end;
img := elem as IHTMLImgElement;
ce := img as IHTMLControlElement;
cp.add(ce);
try
// Clipboard.Open;
Clipboard.Clear;
// if Clipboard.hasFormat(CF_BITMAP) then
begin

try
cp.execCommand('Copy', false, 0);
MyHandle := Clipboard.GetAsHandle(cf_Bitmap);
bmpPtr := GlobalLock(MyHandle);
img1.Picture.Bitmap.Assign(Clipboard);
img1.Picture.LoadFromClipboardFormat(cf_BitMap, MyHandle, 0);
Clipboard.Clear;
GlobalUnlock(MyHandle);
finally
Clipboard.Close;
end;
end;
bmp := (img1.Picture.Bitmap as TBitmap);
except

img1.Picture.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
checkstr := '';
end;
finally
end;

end;


procedure TMainFrm.takepicturesYZMClick(Sender: TObject);
begin
img1.Picture.Bitmap := nil;
BitBlt(img1.Canvas.Handle, 0, 0, 48, 22, self.Canvas.Handle, 899, 522, SRCCOPY);
a1.Picture.Bitmap := nil;
a2.Picture.Bitmap := nil;
a3.Picture.Bitmap := nil;
a4.Picture.Bitmap := nil;

BitBlt(a1.Canvas.Handle, 0, 0, 12, 22, img1.Canvas.Handle, 0, 0, SRCCOPY);
BitBlt(a2.Canvas.Handle, 0, 0, 12, 22, img1.Canvas.Handle, 11, 0, SRCCOPY);
BitBlt(a3.Canvas.Handle, 0, 0, 12, 22, img1.Canvas.Handle, 22, 0, SRCCOPY);
BitBlt(a4.Canvas.Handle, 0, 0, 12, 22, img1.Canvas.Handle, 33, 0, SRCCOPY);

end;


procedure TMainFrm.Button6Click(Sender: TObject);
begin
SetCursorPos(741, 500);
Mouse_Event(MOUSEEVENTF_LEFTDOWN, 741, 500, 0, 0);
Mouse_Event(MOUSEEVENTF_LEFTUP, 741, 500, 0, 0);
end;

procedure TMainFrm.Button7Click(Sender: TObject);
begin
edit3.text := trim(edit3.text);
if length(edit3.Text) <> 4 then
begin
msgok('必须输入4位数！');
edit3.SetFocus;
exit;
end;

a1.Picture.SaveToFile(CurPath + 'template/d1_is_' + copy(edit3.text, 1, 1) + '.bmp');
a2.Picture.SaveToFile(CurPath + 'template/d2_is_' + copy(edit3.text, 2, 1) + '.bmp');
a3.Picture.SaveToFile(CurPath + 'template/d3_is_' + copy(edit3.text, 3, 1) + '.bmp');
a4.Picture.SaveToFile(CurPath + 'template/d4_is_' + copy(edit3.text, 4, 1) + '.bmp');
edit3.text := '';
end;

procedure TMainFrm.IENavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
StatusBar1.Panels.Items[5].Text := url;
end;

procedure TMainFrm.IEStatusTextChange(Sender: TObject;
const Text: WideString);
begin
StatusBar1.Panels.Items[7].Text := Text;
end;

procedure TMainFrm.IETitleChange(Sender: TObject; const Text: WideString);
begin
StatusBar1.Panels.Items[7].Text := Text;
end;

procedure TMainFrm.IEDownloadComplete(Sender: TObject);
begin
StatusBar1.Panels.Items[7].Text := 'DownloadComplete';
IEDownloadCompleteNotify := true;
end;

function TMainFrm.isSamePicture(pics, picd: timage): boolean;
var i, j: integer;
begin
result := false;
for i := 1 to pics.Width - 1 do
begin
for j := 1 to pics.Height - 1 do
begin
if (pics.Canvas.Pixels[i, j] < rgb(128, 128, 128)) and (picd.Canvas.Pixels[i, j] > rgb(128, 128, 128)) then
begin
// msgok('i=' + inttostr(i) + ' value:' + inttostr(pics.Canvas.Pixels[i, j]) + ' j=' + inttostr(j) + ' value:' + inttostr(picd.Canvas.Pixels[i, j]));
exit;
end;
end;
end;
result := true;
end;

function TMainFrm.GetSimilar(TMP1, TMP2: TIMAGE): INTEGER;
var I, J: INTEGER;

begin
RESULT := 0;

for I := 0 to tmp1.Width - 1 do
for J := 0 to tmp1.Height - 1 do
begin
if TMP1.Canvas.Pixels[I, J] = tmP2.Canvas.Pixels[I, J] then INC(RESULT);
end;

// result := abs(xx1 - bb1);
end;

function tMainFrm.identify(tmp: timage; index: string): string;
var i, j: integer;
begin
result := '?';

for i := 0 to 9 do
begin

b1.Picture.Bitmap := nil;
b1.Picture.LoadFromFile(CurPath + 'template/d' + index + '_is_' + inttostr(i) + '.bmp');

if isSamePicture(b1, tmp) then
begin
result := inttostr(i);
break;
end;
end;
end;

procedure TMainFrm.btnidentifyYZMClick(Sender: TObject);
begin
edit2.text := '';
edit2.text := edit2.text + identify(a1, '1');
{
if self.isSamePicture(b1, b2) then
msgok('b1 is b2')
else
msgok('b1 not is b2');

if self.isSamePicture(a1, b2) then
msgok('a1 is b2')
else
msgok('a1 not is b2');
}
edit2.text := edit2.text + identify(a2, '2');
edit2.text := edit2.text + identify(a3, '3');
edit2.text := edit2.text + identify(a4, '4');
end;

procedure TMainFrm.Button8Click(Sender: TObject);
var h: HWnd;
ch: HWnd;
i: integer;
buf: array[0..1024] of char;
begin


sendkeys('~', false); //enter
// sendkeys('~', false); crtl+enter
end;


function TMainFrm.isRightLoginIEForm: boolean;
var
HtmlDoc: IHTMLDocument2;
InputText1: IHTMLInputTextElement; // Edit框
TypeElement: variant;
I: Integer;
begin
result := false;
HtmlDoc := IE.Document as IHTMLDocument2;
for i := 0 to HtmlDoc.all.length - 1 do
begin
TypeElement := Htmldoc.all.item(i, varempty);
if Uppercase(TypeElement.tagName) = 'INPUT' then
begin
if Uppercase(TypeElement.type) = 'TEXT' then // 填 Edit 框
begin
InputText1 := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
if InputText1.name = 'bankcardno' then
begin
result := true;
exit;
end;
end;
end;
end;
end;

function TMainFrm.isBlankForm: boolean;
var
HtmlDoc: IHTMLDocument2;
htm: string;
begin
result := false;


HTM := (IE.Document as Ihtmldocument2).body.outerHtml;
if pos('您正在查找的页当前不可用。 网站可能遇到支持问题，或者您需要 调整', htm) > 0 then
result := true;

end;


procedure TMainFrm.btnNewClick(Sender: TObject);
label la;
begin
JetFly := true;

if ie.Busy then goto la;

if self.IEDownloadCompleteNotify then
begin
if self.isRightLoginIEForm then
begin
takepicturesYZM.Click;
btnidentifyYZM.Click;
btnApplay.Click;
end
else
if SELF.isBlankForm then
begin
msgok('isBlankForm'); //HTM := (SMTPForm.IE.Document as Ihtmldocument2).body.outerHtml
end;
ie.Navigate(EditUrl.Text);
IEDownloadCompleteNotify := false;


end;
la:


end;

procedure TMainFrm.ToolButton1Click(Sender: TObject);
label la;
begin
JetFly := true;

if ie.Busy then goto la;

if self.IEDownloadCompleteNotify then
begin
if self.isRightLoginIEForm then
begin
takepicturesYZM.Click;

btnidentifyYZM.Click;

btnApplay.Click;
end
else
if SELF.isBlankForm then
begin
msgok('isBlankForm'); //HTM := (SMTPForm.IE.Document as Ihtmldocument2).body.outerHtml
end;
ie.Navigate(EditUrl.Text);
IEDownloadCompleteNotify := false;


end;
la:


end;


end.

顶一个.

顶一下.