需要用到工具：
1. Delphi7：开发工具，你懂的。
2.HttpWatch：http请求监控软件，可以查看浏览器具体发出去和收到的数据包。
需要用到的类
1.TAdvStringGrid：我用这个Grid主要是用来显示进度条。当然，你也可以用别的
2.TidHttp：网络请求就靠它了，当然你也可以自己去组织HTTP协议，本人比较懒，用的现成的。
3.TIdCookieManager：管理会话用的Session及Cookie
4.TIdSSLIOHandlerSocketOpenSSL：https开头的，你懂，这里需要两个Dll（libeay32.dll, ssleay32.dll）
5.TThread：多线程，多个账号同时抢
6.其它的控件就不说了。TButton,TForm之类的。
下边，把这个线程类贴出来，界面实现就不贴了，自己动手吧。
unit Http;
interface
uses
Classes, idHTTP, SysUtils, Types, IdIOHandler, IdIOHandlerSocket, IdTStrings,
IdSSLOpenSSL, IdCookieManager, StrUtils, Graphics, Windows;
type
TUser = packed record
ID : Integer;
UserName : string;
IDNO : string;
Account : string;
Password : string;
Skuid : string;
Store : string;
end;
THttp = class(TThread)
private
{ Private declarations }
FUser : TUser; //每个线程有一个TUser的对象，里边包含这个线程需要用到的账号的所有信息：身份证号、姓名、登陆账号、登陆密码。。。。。
FImage : TMemoryStream; //这个东西用来存验证码的图片，苹果的验证码机器不好识别，所以需要存到这里，等人工输入
FVCode : string;
FDate : string;
FTime : string;
FThreadID : Integer;
FTempMsg : String;
FStep : Integer;
http : TidHttp;
cookie: TIdCookieManager;
ssl : TIdSSLIOHandlerSocketOpenSSL;
RedirectUrl : string;
procedure AppleReserv;//线程开始时就执行这个
procedure Getcookie; //需要提前输入一些会话信息
function GetMethod(URL: String; Max: Integer): String;//HTTP中的GET
function PostMethod(PostUrl: String; PostData: TIdStrings;
max: Integer): String; //HTTP中的POST
function GetURLList(Data: String): TStringList; //取得网页中的所有连接，网上现成的函数，借用一下
procedure InitHttp;//初始化HTTP
procedure UpdateCookie(CookieName, Value: string); //更新COOKIE
procedure httpRedirect(Sender: TObject; var dest: String;
var NumRedirect: Integer; var Handled: Boolean;
var VMethod: TIdHTTPMethod); //有时候需要把重定向的连接记录下来
procedure UpdateUI; //更新界面显示
function Split(Data, Node: String): TStringList;//分割字符串
procedure UpdateStep(msg : string; step : Integer);//更新进度条
procedure ShowError; //显示错误信息
function DeleteHtmlTag(HtmlSourch : string) : string; //删除HTML标签，提取网页内容
protected
procedure Execute; override;
public
property VCode : string read FVCode write FVCode;
property Image : TMemoryStream read FImage;
property TempMsg : string read FTempMsg;
property ThreadID : Integer read FThreadID write FThreadID;
constructor Create(CreateSuspended : Boolean; id : Integer; User : TUser); overload;
end;
//编码转换
function DecodeUtf8Str(const S: UTF8String): WideString;
//取指定标签的某属性值
function ExtractHtmlTagValues(const HtmlText: string; TagName, AttribName: string; var Values: TStringList): integer;
//用已知的属性值取另外一个属性值
function GetAttributeByName(const HtmlText: string; TagName, AttribName, KnownAttrName, KnowAttrValue: string): string;
implementation
uses
Main;
{ THttp }
constructor THttp.Create(CreateSuspended: Boolean; id : Integer; User : TUser);
begin
FThreadID := id;
FUser := User;
FStep := 0;
InitHttp;
inherited Create(CreateSuspended);
FreeOnTerminate := True;
end;
procedure THttp.Execute;
begin
{ Place thread code here }
try
AppleReserv;
except
on e : Exception do
begin
FTempMsg := e.Message;
Synchronize(ShowError);
end;
end;
end;
//初始化TidHttp
procedure THttp.InitHttp;
begin
http := TidHttp.Create;
cookie := TIdCookieManager.Create(nil);
http.CookieManager := cookie;
http.AllowCookies := True;
http.HandleRedirects := True;
http.HTTPOptions := [hoKeepOrigProtocol];
http.ProtocolVersion := pv1_1;
http.OnRedirect := httpRedirect;
//http.ProxyParams.ProxyServer := '127.0.0.1'; //可以选择试用代理服务器
//http.ProxyParams.ProxyPort := 8000;
http.Request.SetHeaders;
http.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
http.Request.AcceptEncoding := 'identity';
http.Request.AcceptCharSet := 'GB2312,utf-8;q=0.7,*;q=0.7';
http.Request.AcceptLanguage := 'zh-cn,zh;q=0.5';
http.Request.CustomHeaders.Add('Keep-Alive: 115');
http.Request.CustomHeaders.Add('Connection: keep-alive');
http.Request.UserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 6.1; zh-CN; rv:1.9.2.17) Gecko/20110420 Firefox/3.6.17'; //我模拟的Firefox的浏览器，你可以选择别的。
end;
function THttp.GetMethod(URL: String; Max: Integer): String;
var
RespData: TStringStream;
begin
RespData := TStringStream.Create('');
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
ssl.SSLOptions.Method := sslvSSLv3;
try
try
http.IOHandler := ssl;
http.Get(URL, RespData);
Result := RespData.DataString;
except
Dec(Max);
if Max = 0 then
begin
Result := '';
Exit;
end;
Result := GetMethod(URL, Max);
end;
finally
FreeAndNil(RespData);
FreeAndNil(ssl);
end;
end;
function THttp.PostMethod(PostUrl: String; PostData: TIdStrings; max: Integer): String;
var
RespData : TMemoryStream;
begin
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
ssl.SSLOptions.Method := sslvSSLv3;
RespData := TMemoryStream.Create;
try
try
if http = nil then Exit;
http.IOHandler := ssl;
Http.Post(PostUrl, PostData, RespData);
SetLength(Result, RespData.Size);
RespData.Position := 0;
//RespData.Read(Pointer(Result)^,RespData.Size)\
Result := PChar(RespData.Memory);
except
Dec(Max);
if Max = 0 then
begin
Result := '';
Exit;
end;
Result := PostMethod(PostUrl, PostData, Max);
end;
finally
http.Disconnect;
FreeAndNil(ssl);
FreeAndNil(RespData);
end;
end;
procedure THttp.Getcookie;
begin
try
//svi
cookie.AddCookie('dfa_cookie=applecnglobal', '.apple.com');
cookie.AddCookie('s_cc=true', '.apple.com');
cookie.AddCookie('s_invisit_us=retail%3Dtrue%3B', '.apple.com');
cookie.AddCookie('s_orientation=%5B%5BB%5D%5D', '.apple.com');
cookie.AddCookie('s_orientationHeight=8', '.apple.com');
cookie.AddCookie('s_pathLength=retail%3D1%2C', '.apple.com');
cookie.AddCookie('s_ppv=Reserve%2520%2526%2520Wrap%2520-%2520Choose%2520a%2520store%2520%2528CN%2529%2C100%2C100%2C8%2C', '.apple.com');
cookie.AddCookie('s_pv=Reserve%20%26%20Wrap%20-%20Choose%20a%20store%20(CN)', '.apple.com');
cookie.AddCookie('s_ria=Flash%2010%7C', '.apple.com');
cookie.AddCookie('s_sq=%5B%5BB%5D%5D', '.apple.com');
cookie.AddCookie('s_vnum_us=ch%3Dretail%26vn%3D1%3B', '.apple.com');
except
end;
end;
procedure THttp.UpdateCookie(CookieName, Value : string);
var
i : integer;
begin
cookie.CookieCollection.Cookie[CookieName, '.apple.com'].Value := Value;
Exit;
for i := 0 to cookie.CookieCollection.Count -1 do
begin
if cookie.CookieCollection.Items[i].CookieName = CookieName then
begin
cookie.CookieCollection.Delete(i);
break;
end;
end;
cookie.AddCookie(CookieName + '=' + Value, '.apple.com');
end;
procedure THttp.AppleReserv;
var
Param : TIdStrings;
tmplist : TStringList;
NextLink, result, sno, tmpstr : string;
i, n, tmpcnt : integer;
label e;
begin
UpdateStep('正在连接....', 0);
Getcookie;
tmpcnt := 0;
n := 0;
while (1=1) do
begin
result := GetMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wa/reserveProduct?lang=zh&country=CN', 2);
result := UTF8Decode(result);
tmpstr := result;
i := Pos('<form method="post" id="TheForm" name="TheForm" action="/WebObjects/ProductReservation.woa/wo/', tmpstr);
if i > 0 then
begin
tmpstr := Copy(tmpstr, i + 94, 3);
i := Pos('.', tmpstr);
tmpstr := Copy(tmpstr, 1, i-1);
n := StrToInt(tmpstr);
Break;
end;
Inc(tmpcnt);
if tmpcnt = 10 then Exit;
end;
UpdateStep('选择店铺', 1);
Param := TStringList.Create;
try
Param.Add('=[object Object]');
Param.Add('0.1.0.1.3.0.7.1.10.5.7=Y');
Param.Add('0.1.0.1.3.0.7.1.10.5.57=true');
Param.Add('productImage=');
Param.Add('selectedStatePortURI=');
Param.Add('selectedStorePortURI=');
Param.Add('userSelectedPortURI=' + STORE_HEAD + FUser.Store);
tmpcnt := 0;
while 1=1 do
begin
result := PostMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + IntToStr(n) + '.0.1.0.1.3.0.7.1.10.5', Param, 1);
result := UTF8Decode(result);
if Pos('在左侧选择产品以将其添加到您的预订中。您需要在来 Apple Store 零售店取货时付款。', result) > 0 then
Break;
Inc(tmpcnt);
if tmpcnt = 10 then Exit;
end;
UpdateStep('选择产品', 2);
UpdateCookie('s_pathLength', 'retail%3D2%2C');
UpdateCookie('s_ppv', 'Reserve%2520%2526%2520Wrap%2520-%2520Choose%2520a%2520Product%2520%2528CN%2529%2C100%2C100%2C8%2C');
UpdateCookie('s_pv', 'Reserve%20%26%20Wrap%20-%20Choose%20a%20Product%20(CN)');
Param.Clear;
tmpcnt := 0;
while 1=1 do
begin
result := PostMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wa/GianduiaAction/renderCart?lang=zh&country=CN', Param, 1);
result := UTF8Decode(result);
if Pos('很抱歉，您最多只能预订 -1 件物品。', result) > 0 then
Break;
Inc(tmpcnt);
if tmpcnt = 10 then Exit;
end;
UpdateStep('加载购物车', 3);
http.Request.Referer := 'http://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + IntToStr(n) + '.0.1.0.1.3.0.7.1.10.5';
tmpcnt := 0;
while 1=1 do
begin
//iphone4
result := GetMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + IntToStr(n + 2) + '.0.1.0.1.3.0.7.9.10.1.15.1.1.1.1.1', 1);
//ipad2
//result := GetMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + IntToStr(n + 2) + '.0.1.0.1.3.0.7.9.10.1.15.0.1.1.1.1', 1);
result := UTF8Decode(result);
if Pos('在左侧选择产品以将其添加到您的预订中。您需要在来 Apple Store 零售店取货时付款。', result) > 0 then
Break;
Inc(tmpcnt);
if tmpcnt = 10 then Exit;
end;
UpdateStep('加入购物车', 4);
UpdateCookie('s_pathLength', 'retail%3D3%2C');
UpdateCookie('s_ppv', 'Reserve%2520%2526%2520Wrap%2520-%2520Product%2520detail%2520-%2520iPhone%2520%2528CN%2529%2C100%2C100%2C8%2C');
UpdateCookie('s_pv', 'Reserve%20%26%20Wrap%20-%20Product%20detail%20-%20iPhone%20(CN)');
Param.Clear;
Param.Add('country=CN');
Param.Add('lang=zh');
Param.Add('planID=null');
Param.Add('skuID=' + FUser.Skuid); //i
http.Request.Referer := 'http://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + IntToStr(n + 2) + '.0.1.0.1.3.0.7.9.10.1.15.1.1.1.1.1';
tmpcnt := 0;
while 1=1 do
begin
result := PostMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wa/GianduiaAction/addToCart', Param, 1);
result := UTF8Decode(result);
if Pos('您最多只能预订 5 件产品。', result) > 0 then
Break;
Inc(tmpcnt);
if tmpcnt = 10 then Exit;
end;
UpdateStep('修改订购数量', 5);
Param.Clear;
Param.Add('cartItemID=0');
Param.Add('country=CN');
Param.Add('lang=zh');
Param.Add('qty=5');
Param.Add('test=5');
tmpcnt := 0;
while 1=1 do
begin
result := PostMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wa/GianduiaAction/updateCart', Param, 1);
result := UTF8Decode(result);
if Pos('您最多只能预订 5 件产品。', result) > 0 then
Break;
Inc(tmpcnt);
if tmpcnt = 10 then Exit;
end;
UpdateStep('开始预订', 6);
//iphone4
http.Request.Referer := 'http://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + IntToStr(n + 2) + '.0.1.0.1.3.0.7.9.10.1.15.1.1.1.1.1';
//ipad2
//http.Request.Referer := 'http://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + IntToStr(n + 2) + '.0.1.0.1.3.0.7.9.10.1.15.0.1.1.1.1';
tmpcnt := 0;
while 1=1 do
begin
result := GetMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wa/GianduiaAction/createReservation?lang=zh&country=CN', 1);
result := UTF8Decode(result);
if Pos('登录', result) > 0 then
Break;
Inc(tmpcnt);
if tmpcnt = 10 then Exit;
end;
UpdateStep('登录', 7);
tmpstr := result;
i := Pos('<form method="post" id="TheForm" name="TheForm" action="/WebObjects/ProductReservation.woa/wo/', tmpstr);
if i > -1 then
tmpstr := Copy(tmpstr, i + 94, 3);
i := Pos('.', tmpstr);
sno := Copy(tmpstr, 1, i-1);
http.Request.Referer := RedirectUrl;
UpdateCookie('s_pathLength', 'retail%3D4%2C');
UpdateCookie('s_ppv', 'Reserve%2520%2526%2520Wrap%2520-%2520Apple%2520ID%2520Sign-in%2520%2528CN%2529%2C100%2C100%2C8%2C');
UpdateCookie('s_pv', 'Reserve%20%26%20Wrap%20-%20Apple%20ID%20Sign-in%20(CN)');
Param.Clear;
Param.Add('0.1.0.1.3.0.7.1.10.1.7.20.0.5.1.1.1.4=' + FUser.Account);
Param.Add('0.1.0.1.3.0.7.1.10.1.7.20.0.5.1.1.1.20=' + FUser.Password);
Param.Add('0.1.0.1.3.0.7.1.10.1.7.20.0.5.1.1.1.30=true');
tmpcnt := 0;
while 1=1 do
begin
result := PostMethod('https://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + sno + '.0.1.0.1.3.0.7.1.10.1', Param, 1);
result := DecodeUtf8Str(result);
if Pos('中华人民共和国居民身份证或护照', result) > 0 then
Break;
Inc(tmpcnt);
if tmpcnt = 4 then
begin
UpdateStep('登录失败', 7);
Exit;
end;
end;
e: UpdateStep('选择订购时间', 8);
FVCode := 'http://reserve.apple.com' + GetAttributeByName(result, 'img', 'src', 'id', 'captchaImage');
//<form method="post" id="TheForm" name="TheForm" action="/WebObjects/ProductReservation.woa/wo/14.1.1.0.1.3.0.7.1.10.1">
NextLink := 'http://reserve.apple.com' + GetAttributeByName(result, 'form', 'action', 'id', 'TheForm');
(*
tmpstr := result;
i := Pos('<form method="post" id="TheForm" name="TheForm" action="/WebObjects/ProductReservation.woa/wo/', tmpstr);
if i > -1 then
tmpstr := Copy(tmpstr, i + 94, 3);
i := Pos('.', tmpstr);
sno := Copy(tmpstr, 1, i-1);
*)
Param.Clear;
Param.Add('country=CN');
Param.Add('lang=zh');
tmpcnt := 0;
FDate := '';
FTime := '';
while 1=1 do
begin
Inc(tmpcnt);
if tmpcnt > 2 then
begin
UpdateStep('不在订购时间', 8);
Exit;
end;
result := PostMethod('http://reserve.apple.com/WebObjects/ProductReservation.woa/wa/GianduiaAction/fetchPickupDateTimeDetail', Param, 1);
result := UTF8Decode(result);
tmplist := TStringList.Create;
try
tmplist := Split(result, 'x-coredata://cust/PickupDay/');
if tmplist.Count > 1 then
FDate := Copy(tmplist.Strings[1], 1, Pos('''', tmplist.Strings[1]))
else
Continue;
tmplist.Clear;
tmplist := Split(result, 'x-coredata://cust/TimeSlot/');
if tmplist.Count > 1 then
FTime := Copy(tmplist.Strings[2], 1, Pos('''', tmplist.Strings[2]))
else
Continue;
finally
tmplist.Free;
end;
if (FDate <> '') and (FTime <> '') then
Break;
end;
UpdateStep('获取验证码', 8);
FTempMsg := FVCode;
FImage := TMemoryStream.Create;
try
FImage.Position := 0;
http.Get(FVCode, FImage);
FImage.Position := 0;
UpdateStep('等待输入验证码', 9);
Suspend;
finally
FImage.Free;
end;
UpdateStep('提交预订信息', 9);
Param.Clear;
Param.Add('=[object Object]');
Param.Add('=[object Object]');
Param.Add('=' + FUser.IDNO);
Param.Add('1.1.0.1.3.0.7.1.10.1.51.1.7=' + FVCode);
Param.Add('1.1.0.1.3.0.7.1.10.1.53=true');
Param.Add('captchaNotifier=');
Param.Add('captchaTextEntered=' + FVCode);
Param.Add('govtIDCheckEnabled=Y');
Param.Add('selectedDate=ID');
Param.Add('selectedGovtID=' + FUser.IDNO);
Param.Add('selectedPickupStore=' + FUser.Store);
Param.Add('selectedTime=' + TIME_HEAD + FTime);
Param.Add('showDates=Y');
Param.Add('userSelectedDate=');
Param.Add('userSelectedDateOne=' + FDate);
Param.Add('userSelectedDateTwo=');
while 1=1 do
begin
//result := PostMethod('https://reserve.apple.com/WebObjects/ProductReservation.woa/wo/' + sno + '.0.1.0.1.3.0.7.1.10.1', Param, 1);
//result := sno; //14.1.1.0.1.3.0.7.1.10.1
result := PostMethod(NextLink, Param, 1);
FTempMsg := result;
Synchronize(ShowError);
if Pos('您已完成预订。', result) > 0 then
begin
tmpcnt := Pos('<h4>取货地点和时间</h4>', result);
tmpstr := Copy(result, tmpcnt, Pos('<h4>您預訂的產品：</h4>', result) - tmpcnt);
tmplist := TStringList.Create;
try
tmplist.Text := DeleteHtmlTag(tmpstr);
for i := tmplist.Count - 1 downto 0 do
begin
if Trim(tmplist.Strings[i]) = '' then
tmplist.Delete(i)
else
tmplist.Strings[i] := Trim(tmplist.Strings[i]);
end;
tmpstr := tmplist.Text;
Break
finally
tmplist.Free;
end;
end else
goto e; //没有预定成功，返回第八步继续
end;
UpdateStep(tmpstr, 10);
finally
Param.Free;
end;
end;
procedure THttp.UpdateUI;
begin
Form1.grid.Ints[6, FThreadID] := FStep * 10;
Form1.grid.Rows[FThreadID].Strings[5] := FTempMsg;
end;
function THttp.Split(Data, Node: String): TStringList;
var
Count, i, j: Integer;
function GetFieldCount(Data, Node: String): Integer;
var
i: Integer;
begin
Result := -1;
i := Pos(Node, Data);
if i = 0 then Exit;
Result := 0;
while i <> 0 do
begin
Inc(Result);
Delete(Data, 1, i + Length(Node) - 1);
i := Pos(Node, Data);
end;
end;
begin
Result := TStringList.Create;
Count := GetFieldCount(Data, Node);
for i := 0 to Count - 1 do
begin
j := Pos(Node, Data);
Result.Add(Copy(Data, 1, j - 1));
Delete(Data, 1, j + Length(Node) - 1);
end;
Result.Add(Data);
end;
procedure THttp.httpRedirect(Sender: TObject; var dest: String;
var NumRedirect: Integer; var Handled: Boolean;
var VMethod: TIdHTTPMethod);
begin
http.Request.Referer := '';
RedirectUrl := dest;
end;
function DecodeUtf8Str(const S: UTF8String): WideString;
var lenSrc, lenDst : Integer;
begin
lenSrc := Length(S);
if(lenSrc=0)then Exit;
lenDst := MultiByteToWideChar(CP_UTF8, 0, Pointer(S), lenSrc, nil, 0);
SetLength(Result, lenDst);
MultiByteToWideChar(CP_UTF8, 0, Pointer(S), lenSrc, Pointer(Result), lenDst);
end;
function THttp.DeleteHtmlTag(HtmlSourch : string) : string;
var
i:integer;
s:string;
begin
s:=HtmlSourch;
i:=pos('<',s);
while i > 0 do
begin
delete(s, i, pos( '>', s) - i + 1);
i:=pos('<', s);
end;
Result := s;
end;
function GetAttributeByName(const HtmlText: string; TagName, AttribName, KnownAttrName, KnowAttrValue: string): string;
function FindFirstCharAfterSpace(const Line: string; StartPos: integer): Integer;
var i: integer;
begin
Result := -1;
for i := StartPos to Length(Line) do
begin
if (Line[i] <> ' ') then
begin
Result := i;
exit;
end;
end;
end;
function FindFirstSpaceAfterChars(const Line: string; StartPos: integer): Integer;
begin
Result := PosEx(' ', Line, StartPos);
end;
function FindFirstSpaceBeforeChars(const Line: string; StartPos: integer): Integer;
var i: integer;
begin
Result := 1;
for i := StartPos downto 1 do
begin
if (Line[i] = ' ') then
begin
Result := i;
exit;
end;
end;
end;
var
InnerTag: string;
LastPos, LastInnerPos: Integer;
SPos, LPos, RPos: Integer;
AttribValue: string;
ClosingChar: char;
TempAttribName: string;
IsSearched : Boolean;
SearchedValue : string;
begin
Result := '';
LastPos := 1;
while (true) do
begin
// find outer tags '<' & '>'
LPos := PosEx('<', HtmlText, LastPos);
if (LPos <= 0) then break;
RPos := PosEx('>', HtmlText, LPos+1);
if (RPos <= 0) then
LastPos := LPos + 1
else
LastPos := RPos + 1;
// get inner tag
InnerTag := Copy(HtmlText, LPos+1, RPos-LPos-1);
InnerTag := Trim(InnerTag); // remove spaces
if (Length(InnerTag) < Length(TagName)) then continue;
IsSearched := False;
SearchedValue := '';
// check tag name
if (SameText(Copy(InnerTag, 1, Length(TagName)), TagName)) then
begin
// found tag
AttribValue := '';
LastInnerPos := Length(TagName)+1;
while (LastInnerPos < Length(InnerTag)) do
begin
// find first '=' after LastInnerPos
RPos := PosEx('=', InnerTag, LastInnerPos);
if (RPos <= 0) then break;
// this way you can check for multiple attrib names and not a specific attrib
SPos := FindFirstSpaceBeforeChars(InnerTag, RPos);
TempAttribName := Trim(Copy(InnerTag, SPos, RPos-SPos));
if (true) then
begin
// found correct tag
LPos := FindFirstCharAfterSpace(InnerTag, RPos+1);
if (LPos <= 0) then
begin
LastInnerPos := RPos + 1;
continue;
end;
LPos := FindFirstCharAfterSpace(InnerTag, LPos); // get to first char after '='
if (LPos <= 0) then continue;
if ((InnerTag[LPos] <> '"') and (InnerTag[LPos] <> '''')) then
begin
// AttribValue is not between '"' or ''' so get it
RPos := FindFirstSpaceAfterChars(InnerTag, LPos+1);
if (RPos <= 0) then
AttribValue := Copy(InnerTag, LPos, Length(InnerTag)-LPos+1)
else
AttribValue := Copy(InnerTag, LPos, RPos-LPos+1);
end else
begin
// get url between '"' or '''
ClosingChar := InnerTag[LPos];
RPos := PosEx(ClosingChar, InnerTag, LPos+1);
if (RPos <= 0) then
AttribValue := Copy(InnerTag, LPos+1, Length(InnerTag)-LPos-1)
else
AttribValue := Copy(InnerTag, LPos+1, RPos-LPos-1)
end;
if (SameText(TempAttribName, KnownAttrName)) and (AttribValue <> '') then
begin
if AttribValue = KnowAttrValue then
begin
IsSearched := True;
if SearchedValue <> '' then
begin
Result := SearchedValue;
Break;
end;
end else
Continue;
end;
if (SameText(TempAttribName, AttribName)) and (AttribValue <> '') then
begin
if IsSearched then
begin
Result := AttribValue;
Break;
end else
SearchedValue := AttribValue;
end;
end;
if (RPos <= 0) then
LastInnerPos := Length(InnerTag)
else
LastInnerPos := RPos+1;
end;
end;
end;
end;
function ExtractHtmlTagValues(const HtmlText: string; TagName, AttribName: string; var Values: TStringList): integer;
function FindFirstCharAfterSpace(const Line: string; StartPos: integer): Integer;
var i: integer;
begin
Result := -1;
for i := StartPos to Length(Line) do
begin
if (Line[i] <> ' ') then
begin
Result := i;
exit;
end;
end;
end;
function FindFirstSpaceAfterChars(const Line: string; StartPos: integer): Integer;
begin
Result := PosEx(' ', Line, StartPos);
end;
function FindFirstSpaceBeforeChars(const Line: string; StartPos: integer): Integer;
var i: integer;
begin
Result := 1;
for i := StartPos downto 1 do
begin
if (Line[i] = ' ') then
begin
Result := i;
exit;
end;
end;
end;
var
InnerTag: string;
LastPos, LastInnerPos: Integer;
SPos, LPos, RPos: Integer;
AttribValue: string;
ClosingChar: char;
TempAttribName: string;
begin
Result := 0;
LastPos := 1;
while (true) do
begin
// find outer tags '<' & '>'
LPos := PosEx('<', HtmlText, LastPos);
if (LPos <= 0) then break;
RPos := PosEx('>', HtmlText, LPos+1);
if (RPos <= 0) then
LastPos := LPos + 1
else
LastPos := RPos + 1;
// get inner tag
InnerTag := Copy(HtmlText, LPos+1, RPos-LPos-1);
InnerTag := Trim(InnerTag); // remove spaces
if (Length(InnerTag) < Length(TagName)) then continue;
// check tag name
if (SameText(Copy(InnerTag, 1, Length(TagName)), TagName)) then
begin
// found tag
AttribValue := '';
LastInnerPos := Length(TagName)+1;
while (LastInnerPos < Length(InnerTag)) do
begin
// find first '=' after LastInnerPos
RPos := PosEx('=', InnerTag, LastInnerPos);
if (RPos <= 0) then break;
// this way you can check for multiple attrib names and not a specific attrib
SPos := FindFirstSpaceBeforeChars(InnerTag, RPos);
TempAttribName := Trim(Copy(InnerTag, SPos, RPos-SPos));
if (true) then
begin
// found correct tag
LPos := FindFirstCharAfterSpace(InnerTag, RPos+1);
if (LPos <= 0) then
begin
LastInnerPos := RPos + 1;
continue;
end;
LPos := FindFirstCharAfterSpace(InnerTag, LPos); // get to first char after '='
if (LPos <= 0) then continue;
if ((InnerTag[LPos] <> '"') and (InnerTag[LPos] <> '''')) then
begin
// AttribValue is not between '"' or ''' so get it
RPos := FindFirstSpaceAfterChars(InnerTag, LPos+1);
if (RPos <= 0) then
AttribValue := Copy(InnerTag, LPos, Length(InnerTag)-LPos+1)
else
AttribValue := Copy(InnerTag, LPos, RPos-LPos+1);
end else
begin
// get url between '"' or '''
ClosingChar := InnerTag[LPos];
RPos := PosEx(ClosingChar, InnerTag, LPos+1);
if (RPos <= 0) then
AttribValue := Copy(InnerTag, LPos+1, Length(InnerTag)-LPos-1)
else
AttribValue := Copy(InnerTag, LPos+1, RPos-LPos-1)
end;
if (SameText(TempAttribName, AttribName)) and (AttribValue <> '') then
begin
Values.Add(AttribValue);
inc(Result);
end;
end;
if (RPos <= 0) then
LastInnerPos := Length(InnerTag)
else
LastInnerPos := RPos+1;
end;
end;
end;
end;
//表单元素的值
function GetValByName(S, Sub: string) : string;
var
EleS,EleE,iPos: Integer;
ELeStr,ValSt: String;
St,Ct : Integer;
function FindEleRange(str: string ; front : boolean; posi : integer): Integer;
var
i: integer;
begin
if Front then
begin
for i:=posi-1 downto 1 do
if Str[i]='<' then
begin
Result := i;
break;
end;
end else
begin
for i := posi+1 to length(Str) do
if Str[i]='>' then
begin
Result := i;
break;
end;
end;
end;
function FindEnd (str : string; posi : integer) : Integer;
var
i: integer;
begin
for i:=posi to length(str) do
begin
if (str[i] ='"') or (str[i] ='''') or (str[i] =' ') then
begin
result := i-1;
break;
end;
end;
end;
begin
iPos := Pos('name="'+lowercase(Sub)+'"',lowercase(S));
if iPos = 0 then iPos := Pos('name='+lowercase(Sub),lowercase(S));
if iPos = 0 then iPos := Pos('name='''+lowercase(Sub)+'''',lowercase(S));
if iPos = 0 then exit;
EleS := FindEleRange(S,TRUE,iPos);
EleE := FindEleRange(S,FALSE,iPos);
EleStr := Copy(S,EleS,EleE-EleS+1);
ValSt := 'value="';
iPos := Pos(ValSt,EleStr);
if iPos = 0 then
begin
ValSt := 'value=''';
iPos := Pos(ValSt,EleStr);
end;
if iPos = 0 then
begin
ValSt := 'value=';
iPos := Pos(ValSt,EleStr);
end;
St := iPos+length(ValSt);
Ct := FindEnd(EleStr,St)-St+1;
Result := Copy(EleStr,St,Ct);
end;
//三、如何取得网页中的所有连接，对代码做修改你也可以实现查找所有图片等等
function THttp.GetURLList(Data: String): TStringList;
var
i: Integer;
List: TStringList;
tmp: String;
function Split(Data, Node: String): TStringList;
var
Count, i, j: Integer;
function GetFieldCount(Data, Node: String): Integer;
var
i: Integer;
begin
Result := -1;
i := Pos(Node, Data);
if i = 0 then Exit;
Result := 0;
while i <> 0 do
begin
Inc(Result);
Delete(Data, 1, i + Length(Node) - 1);
i := Pos(Node, Data);
end;
end;
begin
Result := TStringList.Create;
Count := GetFieldCount(Data, Node);
for i := 0 to Count - 1 do
begin
j := Pos(Node, Data);
Result.Add(Copy(Data, 1, j - 1));
Delete(Data, 1, j + Length(Node) - 1);
end;
Result.Add(Data);
end;
begin
Result := TStringList.Create;
try
List := split(Data, 'href=');
for i := 1 to List.Count - 1 do
begin
tmp := List[i];
tmp := Copy(tmp, 0, Pos('</a>', tmp) - 1);
tmp := Copy(tmp, 0, Pos('>', tmp) - 1);
if Pos(' ', tmp) <> 0 then
tmp := Copy(tmp, 0, Pos(' ', tmp) - 1);
tmp := StringReplace(tmp, Char(34), '', [rfReplaceAll, rfIgnoreCase]);
tmp := StringReplace(tmp, Char(39), '', [rfReplaceAll, rfIgnoreCase]);
// TVarCompareResult
// error if not Compare(CI.Key, tmp) then Continue;
if Copy(tmp, 1, 7) <> 'http://' then
begin
if Copy(tmp, 1, 1) = '.' then tmp := StringReplace(tmp, '.', '', []);
if Copy(tmp, 1, 1) = '.' then tmp := StringReplace(tmp, '.', '', []);
try
tmp := 'http://' + http.URL.Host + ':' + http.URL.Port + http.URL.Path + tmp;
except
end;
end;
if Result.IndexOf(tmp) <> -1 then Continue;
Result.Add(tmp);
end;
FreeAndNil(List);
except
end;
end;
procedure THttp.UpdateStep(msg: string; step: Integer);
begin
if Terminated then
begin
FTempMsg := '终止';
FStep := step;
Synchronize(UpdateUI);
Suspend;
Terminate;
end else
begin
FTempMsg := msg;
FStep := step;
Synchronize(UpdateUI);
end;
end;
procedure THttp.ShowError;
begin
Form1.Memo1.Lines.Add( '（' + IntToStr(FUser.ID) + '）' + FUser.UserName + '：' + TempMsg);
end;
end.
扫一扫
2392
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
