mybrowser.pas

自动投票,你可以从中学到一些网上自动投票的东东

  ntmastr, rccstr, utmzstr, sessidstr, rcctstr: string;


begin
//  if EndFlag then exit;

  case flag of
    -1:
      begin
//    MyWebBrowser.oleobject.document.Forms.Item(0, 0).submit;

      end;
    1:
      begin
 {填写数据}
 //当前网页页面文档对象
        if MyWebBrowser.LocationUrl <> 'http://www.inker.com.cn/user/register' then
        begin
//   Timer1.Enabled:=True;
          exit;
        end;
        HtmlDoc := MyWebBrowser.document as IHTMLDocument2;

        CopyIECache('code_image');
//  Image1.Picture.LoadFromFile(ExtractFilePath(application.ExeName)+'\CodeImg\temp.jpg');

 //给网页中每个输入对象赋值
        for i := 0 to HtmlDoc.all.length - 1 do
        begin
          TypeElement := HtmlDoc.all.item(i, varempty); //组件类型单元
   {赋值}
   //INPUT(TEXT)
          if (Uppercase(TypeElement.tagName) = 'INPUT') and (Uppercase(TypeElement.type) = 'PASSWORD') then
          begin
            InputText := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;
            if InputText.name = 'user[password]' then
            begin
              InputText.value := '111111'
            end;
            if InputText.name = 'user_pwdagain' then
            begin
              InputText.value := '111111'
            end;

          end;

          if (Uppercase(TypeElement.tagName) = 'INPUT') and (Uppercase(TypeElement.type) = 'TEXT') then
          begin
     //组件对象
            InputText := HtmlDoc.all.item(i, varempty) as IHTMLInputTextElement;

     //InputNum是网页上输入Form控件的名称，看网页的源码可以知道
            if InputText.name = 'user[login_name]' then
            begin
              if not regerrflag then
                mailaddr := GetEMail;

              InputText.value := mailaddr;

            end;
            if InputText.name = 'user[pen_name]' then
            begin
              if mailaddr = '' then
                InputText.value := 'A' + formatdatetime('hhmmss', now)
              else
                InputText.value := copy(mailaddr, 1, pos('@', mailaddr) - 1);

            end;

            if InputText.name = 'typed_code' then
            begin
              InputText.value := ReadImg;
            end;
          end; //end of if INPUT(TEXT)
        end;
        MyWebBrowser.oleobject.document.Forms.Item(0, 0).submit;

        flag := 3;

      end;
    2:
      begin
        if MyWebBrowser.LocationUrl <> 'http://www.inker.com.cn/user/register#' then
        begin
//      Timer1.Enabled:=True;
          exit;

        end;
        flag := 3;
      end;
    3:
      begin
//    MyWebBrowser.oleobject.document.Forms.Item(0, 0).submit;
        if MyWebBrowser.LocationUrl <> 'http://www.inker.com.cn/client/download' then
        begin
          if MyWebBrowser.LocationUrl = 'http://www.inker.com.cn/user/register' then
          begin
            flag := 1;
            regerrflag := True;
            HtmlDoc := MyWebBrowser.document as IHTMLDocument2;

            if pos('此用户名已存在', HtmlDoc.body.outerText) > 0 then
              regerrflag := false;

            MyWebBrowser.Navigate('http://www.inker.com.cn/user/register');
            MyWebBrowser.Visible := True;
            exit;
          end;
//      Timer1.Enabled:=True;
          exit;
        end;
        flag := 4;
        regerrflag := false;
        if ispre = 0 then
          MyWebBrowser.Navigate('http://www.inker.com.cn/share/info/8691')
        else
          MyWebBrowser.Navigate('http://www.inker.com.cn/product/flashview/8691');

        MyWebBrowser.Visible := True;

      end;
    4:
      begin
        HtmlDoc := MyWebBrowser.document as IHTMLDocument2;
        cookstr := HtmlDoc.cookie + ';';
{
 ntmastr:= copy(cookstr,pos('__utma',cookstr),posex(';',cookstr,pos('__utma',cookstr))-pos('__utma',cookstr));
 rccstr := copy(cookstr,pos('rcc217802768',cookstr),posex(';',cookstr,pos('rcc217802768',cookstr))-pos('rcc217802768',cookstr));
 utmzstr:= copy(cookstr,pos('__utmz',cookstr),      posex(';',cookstr,pos('__utmz',      cookstr))-pos('__utmz',cookstr));
 sessidstr:=copy(cookstr,pos('_session_id',cookstr),posex(';',cookstr,pos('_session_id',cookstr))-pos('_session_id',cookstr));
 rcctstr:=copy(cookstr,pos('rcct217802768',cookstr),posex(';',cookstr,pos('rcct217802768',cookstr))-pos('rcct217802768',cookstr));
}

        PostStr := PostStr3 + #13#10 + 'Cookie: ' + HtmlDoc.cookie + #13#10 + #13#10;
        if TcpClient1.Active then TcpClient1.Close;
        TcpClient1.Open;
        TcpClient1.Sendln(PostStr, #13#10);


        flag := 5;
        Timer2.Enabled := False;
        Timer1.Enabled := True;

      end;
    5:
      begin
        flag := 6;

      end;
  end;

end;

function TfrmMyBrowssr.ReadImg: string;
var
  i, j, x, y: integer;
  kl: longint;
  rr, gg, bb: byte;
  res: byte;
  PersistFile: IPersistFile;
  HTMLDocument: IHTMLDocument2;
  tmpstr: string;

begin
  tmpstr := '';

  Img.Picture.LoadFromFile(ExtractFilePath(application.ExeName) + '\CodeImg\temp.jpg');

  lo.Assign(Img.Picture.Graphic);

  for i := 0 to lo.Width + 1 do
  begin
    for j := 0 to lo.height + 1 do
    begin
      kl := ColorToRGB(lo.Canvas.Pixels[i, j]);
      rr := byte(kl);
      gg := byte(kl);
      bb := byte(kl);
//      if (rr <> 0) and (rr <> 255) and (gg <> 0) and (gg <> 255) and (bb <> 0) and (bb <> 255) then
//        lo.Canvas.Pixels[i, j] := rgb(255, 255, 255);
//     if (rr<>0) and (rr<>255) and (gg<>0) and (gg<>255) and (bb<>0) and (bb<>255) then
      if (rr >= 120) and (gg >= 120) and (bb >= 120) then
        lo.Canvas.Pixels[i, j] := rgb(255, 255, 255)
      else
        lo.Canvas.Pixels[i, j] := rgb(0, 0, 0);

    end;
  end; //for do
  Img.Picture.Assign(lo);

  y := 0;
  tmpImg.Picture := nil;
  x := DuZM_W(0, img.Picture.Bitmap);
  y := DuZM_Y(startx, endx, 0, img.Picture.Bitmap);
  bitblt(tmpImg.Canvas.handle, 0, 0, endx - startx, endy - starty,
    img.canvas.handle, startx, starty, SRCCOPY); //x,y为你要拷贝的原图形的左上角坐标。

  tmpstr := tmpstr + DuTu(tmpImg, endx - startx, endy - starty);

  tmpImg.Picture := nil;
  x := DuZM_W(endx, img.Picture.Bitmap);
  y := DuZM_Y(startx, endx, 0, img.Picture.Bitmap);
  bitblt(tmpImg.Canvas.handle, 0, 0, endx - startx, endy - starty,
    img.canvas.handle, startx, starty, SRCCOPY); //x,y为你要拷贝的原图形的左上角坐标。
  tmpstr := tmpstr + DuTu(tmpImg, endx - startx, endy - starty);


  tmpImg.Picture := nil;
  x := DuZM_W(endx, img.Picture.Bitmap);
  y := DuZM_Y(startx, endx, 0, img.Picture.Bitmap);
  bitblt(tmpImg.Canvas.handle, 0, 0, endx - startx, endy - starty,
    img.canvas.handle, startx, starty, SRCCOPY); //x,y为你要拷贝的原图形的左上角坐标。
  tmpstr := tmpstr + DuTu(tmpImg, endx - startx, endy - starty);


  tmpImg.Picture := nil;
  x := DuZM_W(endx, img.Picture.Bitmap);
  y := DuZM_Y(startx, endx, 0, img.Picture.Bitmap);
  bitblt(tmpImg.Canvas.handle, 0, 0, endx - startx, endy - starty,
    img.canvas.handle, startx, starty, SRCCOPY); //x,y为你要拷贝的原图形的左上角坐标。
  tmpstr := tmpstr + DuTu(tmpImg, endx - startx, endy - starty);

  tmpImg.Picture := nil;
  x := DuZM_W(endx, img.Picture.Bitmap);
  y := DuZM_Y(startx, endx, 0, img.Picture.Bitmap);
  bitblt(tmpImg.Canvas.handle, 0, 0, endx - startx, endy - starty,
    img.canvas.handle, startx, starty, SRCCOPY); //x,y为你要拷贝的原图形的左上角坐标。
  tmpstr := tmpstr + DuTu(tmpImg, endx - startx, endy - starty);

  tmpImg.Picture := nil;
  x := DuZM_W(endx, img.Picture.Bitmap);
  y := DuZM_Y(startx, endx, 0, img.Picture.Bitmap);
  bitblt(tmpImg.Canvas.handle, 0, 0, endx - startx, endy - starty,
    img.canvas.handle, startx, starty, SRCCOPY); //x,y为你要拷贝的原图形的左上角坐标。
  tmpstr := tmpstr + DuTu(tmpImg, endx - startx, endy - starty);
{
  finally
    lo.free;
  end;
}
  result := tmpstr
end;


function TfrmMyBrowssr.DuZM_W(x: integer; plo: tbitmap): integer;
var
  i, j, k, h, m: integer;
  kl: longint;
  rr, gg, bb: byte;
  res: byte;
begin
  k := 0;
// endx:=lo.Width;

  for i := x to plo.Width - 1 do
  begin
    h := 0;
    for j := 0 to plo.height - 1 do
    begin
      kl := ColorToRGB(plo.Canvas.Pixels[i, j]);
      rr := byte(kl);
      gg := byte(kl);
      bb := byte(kl);
      if (rr = 0) and (gg = 0) and (bb = 0) then
      begin
        h := h + 1;
      end;
    end;
    if k = 0 then
    begin
      if h > 0 then
      begin
        startx := i;
        k := 1;
      end;
    end;
    if k <> 0 then
    begin
      if h = 0 then
      begin
        if (i - startx) > 8 then
        begin
          if (i - startx) > 28 then
          begin
            endx := startx + 29;
          end
          else
          begin
            endx := i;
          end;
          if endx > plo.Width then
            endx := plo.Width;

          break;
        end;
      end;
    end;
  end; //for do

  result := 0;
end;

function TfrmMyBrowssr.DuZM_Y(sx, ex, y: integer; plo: tbitmap): integer;
var
  i, j, k, h: integer;
  kl: longint;
  rr, gg, bb: byte;
  res: byte;
begin
  k := 0;
  endy := plo.height;
  for j := 0 to plo.height - 1 do
  begin
    h := 0;
    for i := sx to ex do
    begin
      kl := ColorToRGB(plo.Canvas.Pixels[i, j]);
      rr := byte(kl);
      gg := byte(kl);
      bb := byte(kl);
      if (rr = 0) and (gg = 0) and (bb = 0) then
      begin
        h := h + 1;
      end;
    end;
    if k = 0 then
    begin
      if h > 0 then
      begin
        starty := j;
        k := 1;
      end;
    end;
    if k <> 0 then
    begin
      if h = 0 then
      begin
        if j > 30 then
        begin
          endy := j;
          break;
        end;
      end;
    end;
  end; //for do

  result := 0;

end;

function TfrmMyBrowssr.ImgOK(s, d: string): real;
var
  i, m: integer;
  k: real;
begin
  k := 0;
  if length(s) = 0 then
  begin
    result := k;
    exit;
  end;
  for i := 0 to length(s) do
  begin
    if s[i] = d[i] then
      m := m + 1;
  end;
  k := m / length(s) * 100;
  result := k;
end;

function TfrmMyBrowssr.DuTu(MyImage: TImage; w, h: integer): string;
var
  i, j: integer;
  k, m: real;
  kl: longint;
  rr, gg, bb: byte;
  res: byte;
  tmpImgstr, imgStr, tmpChr: string;
begin
//
  tmpImgstr := GetImg(MyImage);
  vtimg.First;
  m := 0;
  tmpChr := '';
  while not vtimg.Eof do
  begin
    imgStr := vtimg.fieldbyname('vtimg').AsString;
    k := imgOK(imgStr, tmpImgstr);
    if k > m then
    begin
      m := k;
      tmpChr := vtimg.fieldbyname('vtchr').AsString;
    end;
    vtimg.Next;
  end;
  result := tmpChr;
end;

function TfrmMyBrowssr.GetImg(MyImage: TImage): string;
var
  i, j, k, h: integer;
  kl: longint;
  rr, gg, bb: byte;
  res: byte;
  tmpImgstr: string;
begin
  tmpImgstr := '';
  for i := 0 to MyImage.Width - 1 do
  begin
    for j := 0 to MyImage.height - 1 do
    begin
      kl := ColorToRGB(MyImage.Canvas.Pixels[i, j]);
      rr := byte(kl);
      gg := byte(kl);
      bb := byte(kl);
      if (rr = 0) and (gg = 0) and (bb = 0) then
        tmpImgstr := tmpImgstr + '1'
      else
        tmpImgstr := tmpImgstr + '0';
    end;
  end;
  result := tmpImgstr;
end;

end.