本文共 7104 字,大约阅读时间需要 23 分钟。
//Tyrion unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.WebBrowser, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, FMX.Controls.Presentation, FMX.StdCtrls, FMX.ScrollBox, FMX.Memo, FMX.TabControl, FMX.Edit, FMX.DateTimeCtrls, FMX.ListBox,IdGlobal, FMX.Layouts, System.Actions, FMX.ActnList, FMX.Gestures ; type TForm1 = class(TForm) Button1: TButton; IdHTTP1: TIdHTTP; WebBrowser1: TWebBrowser; TabControl1: TTabControl; TabItem1: TTabItem; TabItem2: TTabItem; ToolBar1: TToolBar; TabItem3: TTabItem; Edit1: TEdit; Panel1: TPanel; Label1: TLabel; Label2: TLabel; Edit2: TEdit; Label3: TLabel; DateEdit1: TDateEdit; Label4: TLabel; Label5: TLabel; TimeEdit1: TTimeEdit; ComboBox1: TComboBox; ListBox1: TListBox; ListBoxItem1: TListBoxItem; ListBoxItem2: TListBoxItem; ListBoxItem3: TListBoxItem; ListBoxItem4: TListBoxItem; ToolBar2: TToolBar; Button2: TButton; ToolBar3: TToolBar; Button3: TButton; Edit3: TEdit; Label6: TLabel; Edit4: TEdit; Label7: TLabel; WebBrowser2: TWebBrowser; Label8: TLabel; Edit5: TEdit; WebBrowser3: TWebBrowser; GestureManager1: TGestureManager; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); procedure TabControl1Gesture(Sender: TObject; const [Ref] EventInfo: TGestureEventInfo; var Handled: Boolean); private { Private declarations } function CheckValues: boolean; procedure sbPriorClick(Sender: TObject); procedure sbNextClick(Sender: TObject); public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} {$R *.LgXhdpiTb.fmx ANDROID} procedure TForm1.Button1Click(Sender: TObject); var ls: TStringList; lstr: string; begin inherited; // idHttp1.Request.CustomHeaders.Text := // 'Accept: image/gif, image/jpeg, image/pjpeg, application/x-ms-application, application/xaml+xml, application/x-ms-xbap, */*' + #13#10 // +'Referer: http://www.china95.net/PAipan/bazi/' + #13#10 // +'Accept-Language: zh-Hans-CN,zh-Hans;q=0.8,en-US;q=0.5,en;q=0.3' + #13#10 // +'Content-Type: application/x-www-form-urlencoded' + #13#10 // +'User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 10.0; WOW64; Trident/7.0; .NET4.0C; .NET4.0E; .NET CLR 2.0.50727; .NET CLR 3.0.30729; .NET CLR 3.5.30729)' + #13#10 // +'Accept-Encoding: gzip, deflate' + #13#10 // +'Host: www.china95.net' + #13#10 // +'Content-Length: 184' + #13#10 // +'DNT: 1' + #13#10 // +'Connection: Keep-Alive' + #13#10 // +'Cache-Control: no-cache'; CheckValues; ls := TStringList.Create; ls.Add('name=' + edit1.Text); ls.Add('area=' + edit2.Text); if combobox1.ItemIndex = 0 then ls.Add('sex=1') else ls.Add('sex=2'); ls.Add('year=' + formatdatetime('yyyy',dateedit1.Date)); ls.Add('month=' + formatdatetime('mm',dateedit1.Date)); ls.Add('date='+ formatdatetime('dd',dateedit1.Date)); ls.Add('hour=' + formatdatetime('hh',timeedit1.DateTime)); ls.Add('minute=' + formatdatetime('nn',timeedit1.DateTime)); ls.Add('jingdu=120'); ls.Add('jingdufen=0'); ls.Add('taiyang=0'); ls.Add('quanpai=1'); ls.Add('submit=在线排八字盘'); idhttp1.Request.CharSet := 'utf-8'; idhttp1.Request.ContentEncoding := 'utf-8'; lstr := idhttp1.Post('http://www.china95.net/PAipan/bazi/bazi_show.asp',ls,IndyTextEncoding(TEncoding.ANSI)); FreeAndNil(ls); lstr := Copy(lstr,Pos('<td><b>姓名',lstr) - Length('<td><b>姓名'),Length(lstr)); lstr := Copy(lstr,1,Pos('<br><br><p></td>',lstr) + Length('<br><br><p></td>')) ; lstr := StringReplace(lstr,'元亨利贞网四柱八字在线排盘系统','',[rfReplaceAll]); lstr := StringReplace(lstr,'http://bbs.china95.net','',[rfReplaceAll]); webbrowser1.LoadFromStrings(lstr,''); end; procedure TForm1.Button2Click(Sender: TObject); var ls: TStringList; lstr: string; begin // idHttp1.Request.CustomHeaders.Text := // 'Accept: text/html, application/xhtml+xml, */*' + #13#10 // +'Referer: http://www.jjdzc.com/xm_xm.html' + #13#10 // +'Accept-Language: zh-CN' + #13#10 // +'Content-Type: application/x-www-form-urlencoded' + #13#10 // +'User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 10.0; WOW64; Trident/7.0; .NET4.0C; .NET4.0E; .NET CLR 2.0.50727; .NET CLR 3.0.30729; .NET CLR 3.5.30729)' + #13#10 // +'Accept-Encoding: gzip, deflate' + #13#10 // +'Host: www.jjdzc.com' + #13#10 // +'DNT: 1' + #13#10 // +'Connection: Keep-Alive' + #13#10 // +'Cache-Control: no-cache'; ls := TStringList.Create; ls.Add('ming=' + edit4.Text); ls.Add('type=2'); ls.Add('xing='+ edit3.Text); lstr := idhttp1.Post('http://www.jjdzc.com/xm.php',ls); FreeAndNil(ls); lstr := Copy(lstr,Pos('<h4 class="cut_tit">总评及建议</h4>',lstr) - Length('<h4 class="cut_tit">总评及建议</h4>'),Length(lstr)); lstr := Copy(lstr,1,Pos('按此操作一切后果自负!',lstr) + Length('按此操作一切后果自负!') - 1) ; // lstr := StringReplace(lstr,'元亨利贞网四柱八字在线排盘系统','',[rfReplaceAll]); // lstr := StringReplace(lstr,'http://bbs.china95.net','',[rfReplaceAll]); webbrowser2.LoadFromStrings(lstr,''); end; procedure TForm1.Button3Click(Sender: TObject); var lstr: string; begin idHttp1.Request.CustomHeaders.Text := 'Accept: text/html, application/xhtml+xml, */*' + #13#10 +'Referer: http://mobile.9om.com/' + #13#10 +'Accept-Language: zh-CN' + #13#10 +'Content-Type: application/x-www-form-urlencoded' + #13#10 +'User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 10.0; WOW64; Trident/7.0; .NET4.0C; .NET4.0E; .NET CLR 2.0.50727; .NET CLR 3.0.30729; .NET CLR 3.5.30729)' + #13#10 +'Accept-Encoding: gzip, deflate' + #13#10 +'Host: mobile.9om.com' + #13#10 +'DNT: 1' + #13#10 +'Connection: Keep-Alive' + #13#10 +'Cache-Control: no-cache' +#13#10 +'cookie display=1'; idhttp1.HandleRedirects := true; lstr := idhttp1.Get('http://mobile.9om.com/?lang=zh-cn&q=' + edit5.Text); lstr := Copy(lstr,Pos('<div class=detail>',lstr) + Length('<div class=detail>') ,Length(lstr)); lstr := Copy(lstr,1,Pos('</span></div><div',lstr) -1 ) ; webbrowser3.LoadFromStrings(lstr,''); end; function TForm1.CheckValues: boolean; begin result := false; if trim(edit1.Text) = '' then raise exception.Create('请输入姓名'); if trim(edit2.Text) = '' then raise exception.Create('请输入地区'); if combobox1.ItemIndex < 0 then raise exception.Create('请选择性别'); result := true; end; procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); begin if Key = vkHardwareBack then begin if TabControl1.TabIndex > 0 then begin TabControl1.TabIndex := TabControl1.TabIndex - 1 mod TabControl1.TabCount; Key := 0; end; end; end; procedure TForm1.sbNextClick(Sender: TObject); begin if tabcontrol1.ActiveTab.Index < tabcontrol1.TabCount - 1 then tabcontrol1.Next(); end; procedure TForm1.sbPriorClick(Sender: TObject); begin if tabcontrol1.ActiveTab.Index > 0 then tabcontrol1.Previous(); end; procedure TForm1.TabControl1Gesture(Sender: TObject; const [Ref] EventInfo: TGestureEventInfo; var Handled: Boolean); begin case EventInfo.GestureID of sgiRight: begin tabcontrol1.Previous(); Handled:=True; end; sgiLeft: begin tabcontrol1.Next(); Handled:=True; end; end; end; end.转载地址:http://obegz.baihongyu.com/