?? 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\administrator@inker.com.txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[0].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[1].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[2].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[3].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[4].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[5].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[6].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[7].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[8].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@inker.com[9].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com.txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[0].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[1].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[2].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[3].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[4].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[5].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[6].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[7].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[8].txt');
deletefile('C:\Documents and Settings\Administrator\Cookies\administrator@www.inker.com[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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -