mybrowser.pas

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

unit MyBrowser;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, RzStatus, ExtCtrls, RzPanel, RzButton, MSHTML,
  sndkey32, ActiveX, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, StdCtrls, RzEdit, Mask, IdCookieManager, DB, MemDS,
  VirtualTable, IniFiles, urlmon, wininet, Jpeg, ScktComp, Sockets, StrUtils;

const
  PostStr1 =
    'POST /share/vote_up/8691 HTTP/1.1' + #13#10 +
    'Host: www.inker.com.cn' + #13#10 +
    'User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; zh-CN; rv:1.8.1.4) Gecko/20070515 Firefox/2.0.0.4' + #13#10 +
    'Accept: text/javascript, text/html, application/xml, text/xml, */*' + #13#10 +
    'Accept-Language: zh-cn,zh;q=0.5' + #13#10 +
    'Accept-Encoding: gzip,deflate' + #13#10 +
    'Accept-Charset: gb2312,utf-8;q=0.7,*;q=0.7' + #13#10 +
    'Keep-Alive: 300' + #13#10 +
    'Connection: keep-alive' + #13#10 +
    'X-Requested-With: XMLHttpRequest' + #13#10 +
    'X-Prototype-Version: 1.5.1_rc4' + #13#10 +
    'Content-Type: application/x-www-form-urlencoded; charset=UTF-8' + #13#10 +
    'Referer: http://www.inker.com.cn/share/info/8691' + #13#10 +
    'Content-Length: 0';

  PostStr2 =
    'Pragma: no-cache' + #13#10 +
    'Cache-Control: no-cache';

  PostStr3 =
    'POST /share/vote_up/8691 HTTP/1.1' + #13#10 +
    'Accept: text/javascript, text/html, application/xml, text/xml, */*' + #13#10 +
    'Accept-Language: zh-cn' + #13#10 +
    'x-prototype-version: 1.5.1_rc4' + #13#10 +
    'Referer: http://www.inker.com.cn/share/info/8691' + #13#10 +
    'x-requested-with: XMLHttpRequest' + #13#10 +
    'Content-Type: application/x-www-form-urlencoded; charset=UTF-8' + #13#10 +
    'Accept-Encoding: gzip, deflate' + #13#10 +
    'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30)' + #13#10 +
    'Host: www.inker.com.cn' + #13#10 +
    'Content-Length: 0' + #13#10 +
    'Connection: Keep-Alive' + #13#10 +
    'Cache-Control: no-cache';

type
  TfrmMyBrowssr = class(TForm)
    RzPanel1: TRzPanel;
    RzPanel2: TRzPanel;
    RzStatusPane1: TRzStatusPane;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    Timer1: TTimer;
    Timer2: TTimer;
    RzNumericEdit1: TRzNumericEdit;
    vtMail: TVirtualTable;
    MyWebBrowser: TWebBrowser;
    vtImg: TVirtualTable;
    TcpClient1: TTcpClient;
    img: TImage;
    tmpImg: TImage;
    procedure RzBitBtn2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure MyWebBrowserDocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    startx, starty, endx, endy, Tuflag: integer;
    PostStr: string;
    flag, MaxCS, MinCS, ispre: integer;
    EndFlag, regErrFlag, MaxFlag: boolean;
    mailname, mailser, mailaddr: string;
    lo: tbitmap;
    procedure MyTP;
    function GetEMail: string;
    function DownloadFile(Source, Dest: string): Boolean;
    procedure CopyIECache(filename: string);
    procedure DeleteIECache;
    function ReadImg: string;
    function DuZM_W(x: integer; plo: tbitmap): integer;
    function DuZM_Y(sx, ex, y: integer; plo: tbitmap): integer;
    function ImgOK(s, d: string): real;
    function DuTu(MyImage: TImage; w, h: integer): string;
    function GetImg(MyImage: TImage): string;
  public
    { Public declarations }
  end;

var
  frmMyBrowssr: TfrmMyBrowssr;

implementation

{$R *.dfm}

procedure TfrmMyBrowssr.CopyIECache(filename: string);
var
  lpEntryInfo: PInternetCacheEntryInfo;
  hCacheDir: LongWord;
  dwEntrySize: LongWord;
  strtmp: string;
begin
  dwEntrySize := 0;
  FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
  GetMem(lpEntryInfo, dwEntrySize);
  if (dwEntrySize > 0) then lpEntryInfo^.dwStructSize := dwEntrySize;
  hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
  if (hCacheDir <> 0) then begin
    repeat
//     strtmp:=lpEntryInfo^.lpszLocalFileName;
//     strtmp:=ExtractFileExt(lpEntryInfo^.lpszLocalFileName);
      if (pos('code_image', lpEntryInfo^.lpszLocalFileName) > 0) and
        (sametext(ExtractFileExt(lpEntryInfo^.lpszLocalFileName), '.jpg')) then
      begin
        copyfile(pchar(lpEntryInfo^.lpszLocalFileName), pchar(ExtractFilePath(application.ExeName) + '\CodeImg\temp.jpg'), false);
      end;

      FreeMem(lpEntryInfo, dwEntrySize);
      dwEntrySize := 0;
      FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
      GetMem(lpEntryInfo, dwEntrySize);
      if (dwEntrySize > 0) then lpEntryInfo^.dwStructSize := dwEntrySize;
    until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
  end;
  FreeMem(lpEntryInfo, dwEntrySize);
  FindCloseUrlCache(hCacheDir);
end;

procedure TfrmMyBrowssr.DeleteIECache;
var
  lpEntryInfo: PInternetCacheEntryInfo;
  hCacheDir: LongWord;
  dwEntrySize: LongWord;
begin
  dwEntrySize := 0;
  FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
  GetMem(lpEntryInfo, dwEntrySize);
  if (dwEntrySize > 0) then lpEntryInfo^.dwStructSize := dwEntrySize;
  hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
  if (hCacheDir <> 0) then begin
    repeat
      if ((pos('inker.com', lpEntryInfo^.lpszLocalFileName) > 0) and
        (sametext('.txt', ExtractFileExt(lpEntryInfo^.lpszLocalFileName))) or
        ((pos('code_image', lpEntryInfo^.lpszLocalFileName) > 0) and
        (sametext('.jpg', ExtractFileExt(lpEntryInfo^.lpszLocalFileName))))) then
        DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
      FreeMem(lpEntryInfo, dwEntrySize);
      dwEntrySize := 0;
      FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
      GetMem(lpEntryInfo, dwEntrySize);
      if (dwEntrySize > 0) then lpEntryInfo^.dwStructSize := dwEntrySize;
    until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
  end;
  FreeMem(lpEntryInfo, dwEntrySize);
  FindCloseUrlCache(hCacheDir);
end;

function TfrmMyBrowssr.DownloadFile(Source, Dest: string): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
  except
    Result := False;
  end;
end;

procedure TfrmMyBrowssr.RzBitBtn2Click(Sender: TObject);
begin
  close;
end;

procedure TfrmMyBrowssr.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := false;
  Timer2.Enabled := True;
  if MaxCS = 5 then
  begin
    PostMessage(handle, WM_SYSCOMMAND, SC_MINIMIZE, 0); // 发送最小化消息
    MaxCs := 0;
    MinCs := 0;
    MaxFlag := false;
  end;
  if MinCs = 200 then
  begin
    PostMessage(handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0); // 发送最大化消息
    MinCs := 0;
    MaxCs := 0;
    MaxFlag := True;
  end;
  MyTP;
  if MaxFlag then
    MaxCS := MaxCS + 1
  else
    MinCs := MinCs + 1;
{
}
end;




procedure TfrmMyBrowssr.RzBitBtn1Click(Sender: TObject);
begin
  Timer1.Enabled := True;
//  MyTP;
end;

procedure TfrmMyBrowssr.Timer2Timer(Sender: TObject);
begin
  Timer2.Enabled := False;
  flag := 1;
  Timer1.Enabled := True;
end;

procedure TfrmMyBrowssr.MyTP;
begin
  EndFlag := False;
{  flag := -1;
  if MyWebBrowser<>nil then
     MyWebBrowser.Free;
  MyWebBrowser:=TWebBrowser.Create(Self);
//  MyWebBrowser.Navigate('about:blank');
  MyWebBrowser.Align := alClient;//  WebBrowser.Name := 'FireFox ' + formatdatetime('yyyymmddhhmmss',now);
  MyWebBrowser.ParentWindow:=RzPanel2.Handle;//self.Handle;
  MyWebBrowser.OnDocumentComplete := WebBrowserDocumentComplete;//********ADD*******//
//  MyWebBrowser.Visible :=true;
  MyWebBrowser.Width:=RzPanel2.Width;
  MyWebBrowser.Height:=RzPanel2.Height;
  MyWebBrowser.Top:=0;
}
  flag := -1;
  DeleteIECache;
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail]');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][0].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][1].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][2].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][3].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][4].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][5].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][6].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][7].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][8].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][9].txt');

  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail]');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][0].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][1].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][2].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][3].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][4].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][5].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][6].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][7].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][8].txt');
  deletefile('C:\Documents and Settings\Administrator\Cookies\[e-mail][9].txt');


  flag := 1;
  regerrflag := false;
  mailaddr := '';
  MyWebBrowser.Navigate('http://www.inker.com.cn/user/register');
  MyWebBrowser.Visible := True;

end;

function TfrmMyBrowssr.GetEMail: string;
var
  str: string;
begin

  str := mailname + formatdatetime('yyyymmddhhmmss', now) + mailser;
  if not vtMail.Eof then
  begin
    if vtMail.FieldByName('isreg').AsString = '0' then
    begin
      str := vtMail.FieldByName('Email').AsString;
      vtMail.Edit;
      vtMail.FieldByName('isreg').AsString := '1';
      vtMail.Post;
    end;
    vtMail.Next;
  end;

  result := str;
end;

procedure TfrmMyBrowssr.FormCreate(Sender: TObject);
var
  tmp, msl: TStringList;
  j, i: integer;
  AppIni: TIniFile;
begin
  AppIni := TIniFile.Create(ExtractFilePath(application.ExeName) + 'var.ini');
  mailname := AppIni.readstring('var', 'mailname', 'CC');
  mailser := AppIni.readstring('var', 'mailser', '@sina.com');
  ispre := AppIni.ReadInteger('var', 'ispre', 1);
  AppIni.Free;


  vtMail.Open;
  if FileExists(ExtractFilePath(application.ExeName) + 'email.vtd') then
    vtMail.LoadFromFile(ExtractFilePath(application.ExeName) + 'email.vtd');
  if FileExists(ExtractFilePath(application.ExeName) + 'mail.txt') then
  begin
    msl := TStringList.Create;
    try
      tmp := TStringList.Create;
      try
        msl.LoadFromFile(ExtractFilePath(application.ExeName) + 'mail.txt');

        for j := 0 to msl.Count - 1 do
        begin
          vtMail.Append;
          vtMail.Edit;
          vtMail.FieldByName('Email').AsString := msl.Strings[j];
          vtMail.FieldByName('isreg').AsString := '0';
        end;

        for i := 65 to 90 do
        begin
          for j := 0 to msl.Count - 1 do
          begin
            vtMail.Append;
            vtMail.Edit;
            vtMail.FieldByName('Email').AsString := chr(i) + msl.Strings[j];
            vtMail.FieldByName('isreg').AsString := '0';
          end;
        end;
        for j := 0 to msl.Count - 1 do
        begin
          vtMail.Append;
          vtMail.Edit;
          vtMail.FieldByName('Email').AsString := msl.Strings[j];
          vtMail.FieldByName('isreg').AsString := '0';
        end;
        for i := 1 to 100 do
        begin
          for j := 0 to msl.Count - 1 do
          begin
            vtMail.Append;
            vtMail.Edit;
            vtMail.FieldByName('Email').AsString := copy(msl.Strings[j], 1, pos('@', msl.Strings[j]) - 1) + inttostr(i) + trim(copy(msl.Strings[j], pos('@', msl.Strings[j]), 100));
            vtMail.FieldByName('isreg').AsString := '0';
          end;
        end;
        for i := 65 to 90 do
        begin
          for j := 0 to msl.Count - 1 do
          begin
            vtMail.Append;
            vtMail.Edit;
            vtMail.FieldByName('Email').AsString := copy(msl.Strings[j], 1, pos('@', msl.Strings[j]) - 1) + chr(i) + trim(copy(msl.Strings[j], pos('@', msl.Strings[j]), 100));
            vtMail.FieldByName('isreg').AsString := '0';
          end;
        end;

        vtMail.Post;
//    Closefile(BackFlie);
//   s := GetCurrentDir+ '\bb.dat';
        RenameFile(ExtractFilePath(application.ExeName) + 'mail.txt', ExtractFilePath(application.ExeName) + 'mail' + formatdatetime('yyyymmddhhmmss', now) + '.txt');
      finally
        tmp.Free;
      end;
    finally
      msl.Free;
    end;
  end;

  vtMail.First;

  vtImg.Open;
  vtImg.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'img.vtd');

  lo := tbitmap.create;
  lo.Width := Img.Width;
  lo.height := Img.height;
  MaxFlag := true;
end;

procedure TfrmMyBrowssr.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
//  if MyWebBrowser <> nil then
//    MyWebBrowser.Free;
  lo.Free;
  vtMail.Edit;
  vtMail.Post;
  vtMail.SaveToFile(ExtractFilePath(application.ExeName) + 'email.vtd');
  vtImg.Close;
end;

procedure TfrmMyBrowssr.FormShow(Sender: TObject);
begin
  if vtMail.RecordCount = 0 then ShowMessage('没有邮箱可用');

  vtMail.Filter := 'isreg=0';
  vtMail.Filtered := True;
end;

procedure TfrmMyBrowssr.MyWebBrowserDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  HtmlDoc: IHTMLDocument2;
  i: Integer;
  InputText: IHTMLInputTextElement;
  SelectText: IHTMLSelectElement;
  TypeElement: variant;
  TextArea: IHTMLTextAreaElement;
  o: OleVariant;
  iOIPAO: IOleInPlaceActiveObject;
  HTMLOptionButtonElement: IHTMLOptionButtonElement;
  HtrTMLFormElement: IHTMLFormElement;
  strTemp: string;
  LoginInfo: TStrings;
  Cookie: string;
  PostInfo, PageInfo: TStrings;
  Response: TStringStream;
  sss: Tstringlist;
  j, x, y: integer;
  kl: longint;
  rr, gg, bb: byte;
  res: byte;
  cookstr: widestring;