delphi

web

knoen 2013. 12. 30. 20:50


复于： 2012-08-09 16:42:38
确实不行了 我把所有代码贴出来
procedure Tfmain.FormCreate(Sender: TObject);
var
   // webbrowser: TWebBrowser;
    tabsheet: TTabSheet;
begin

   tabsheet := TTabSheet.Create(Self);
  with tabsheet do
  begin
    PageControl := pgc1;
    Caption := dealTitle('百度一下，你就知道');
  end;

  webbrowser := TWebBrowser.Create(tabsheet);
  with webbrowser do
  begin
    Align := alClient;
    Silent := True;
    //Navigate('www.baidu.com');
    GoHome;
    OnBeforeNavigate2 := webBeforeNavigate2;
    OnDocumentComplete := webDocumentComplete;
    OnNewWindow2 := webNewWindow2;
  end;

  tabsheet.InsertControl(webbrowser);

  with pgc1 do
  begin
    ActivePageIndex := PageCount - 1;
  end;

  Self.WindowState := wsMaximized;
end;

procedure Tfmain.addIEPage(var ppDisp: IDispatch);
var
   // webbrowser: TWebBrowser;
    tabsheet: TTabSheet;
begin
  tabsheet := TTabSheet.Create(Self);
  with tabsheet do
  begin
    PageControl := pgc1;
  end;

  webbrowser := TWebBrowser.Create(tabsheet);
  with webbrowser do
  begin
    Align := alClient;
    Silent := True;
    OnBeforeNavigate2 := webBeforeNavigate2;
    OnDocumentComplete := webDocumentComplete;
    OnNewWindow2 := webNewWindow2;
  end;
  
  tabsheet.InsertControl(webbrowser);
  ppDisp := webbrowser.Application;
  with pgc1 do
  begin
    ActivePageIndex := PageCount - 1;
  end;
end;

function Tfmain.dealTitle(title: string): string;
begin
  if Length(title) >= 16 then
    Result := Copy(title,1,16) + '...'
  else
    Result := title;
end;

procedure Tfmain.webDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
    //web: TWebBrowser;
    doc: IHTMLDocument2;
begin
    webbrowser := pgc1.Pages[pgc1.ActivePageIndex].Components[0] as TWebBrowser;
    doc := webbrowser.Document as IHTMLDocument2;
    if webbrowser.ReadyState = READYSTATE_COMPLETE then
    begin
      pgc1.Pages[pgc1.ActivePageIndex].Caption := dealTitle(doc.title);
      changeTitle(webbrowser.LocationURL, doc.title);
      stat1.Panels[0].Text := '完成';
    end;
end;

procedure Tfmain.webNewWindow2(Sender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
begin
  try
    addIEPage(ppDisp);
  except
  end;
end;

procedure Tfmain.webBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
//var
  //web: TWebBrowser;
begin
  try
    webbrowser := (pgc1.Pages[pgc1.ActivePageIndex].Components[0] as TWebBrowser);
   // pgc1.Pages[pgc1.ActivePageIndex].Caption := dealTitle(webbrowser.LocationName);
    //lbledt_url.Text := webbrowser.LocationURL;
    //self.Caption := webbrowser.LocationName;
    //Application.Title := webbrowser.LocationName;
    stat1.Panels[0].Text := '等待' + webbrowser.LocationURL + '...';

  except
  end;
end;

procedure Tfmain.pgc1Change(Sender: TObject);
  var
    web: TWebBrowser;
    //doc: IHTMLDocument2;
begin
  try
    web := pgc1.Pages[pgc1.ActivePageIndex].Components[0] as TWebBrowser;
  //  doc := web.Document as IHTMLDocument2;
    //changeTitle(web.LocationURL, doc.title);
  except
  end;
end;

procedure Tfmain.changeTitle(url, title: string);
begin
    lbledt_url.Text := url;
    self.Caption := title;
    Application.Title := title;
end;

procedure Tfmain.lbledt_urlKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    btn1.Click;
end;

procedure Tfmain.lbledt_urlDblClick(Sender: TObject);
begin
  lbledt_url.SelectAll;
end;

procedure Tfmain.pgc1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
//var
    //activeIndex: Integer;
begin
   try
  if (Button = mbLeft) and (ssDouble in Shift) then
begin
   Index := pgc1.IndexOfTabAt(X, Y);
    if Index >= 1 then
   begin
     //sleep(1500);
    //pgc1.Pages[index].Hide;

     showmessage(inttostr(Index));
   pgc1.Pages[Index].free;

   end;
    end;

      except
      end;
    end;


procedure Tfmain.btn1Click(Sender: TObject);
var
    web: TWebBrowser;
begin
  web := pgc1.Pages[pgc1.ActivePageIndex].Components[0] as TWebBrowser;
  web.Navigate(lbledt_url.Text);
end;

procedure Tfmain.Button1Click(Sender: TObject);
begin
// showmessage(webbrowser.LocationURL);
 showmessage(lbledt_url.Text);
end;


procedure Tfmain.Timer1Timer(Sender: TObject);
begin

  if pos('https://cashier.alipay.com/standard/gateway/ebankPay.htm',lbledt_url.Text)<>0 then
     begin
      try
      Idoc2:=webbrowser.Document as IHTMLDocument2;




          //pgc1.Pages[index].Destroy;
             // pgc1.Pages[index].Destroy;
        pgc1.ActivePageIndex := activeIndex;
    { Document:=webbrowser.Document as IHTMLDocument2;
     s8:=Document.getElementByID('pay-all').outertext ;
     t4:=pos('.',s8);
     money:=copy(s8,1,(t4-1));
     zr41:=true;
     zr4:=true;
    ovElements:= Document.getElementByID('ebankPayForm').elements;
   s2:=(ovElements.all.tags('span').Item(1).outerHTML);//获取选择银行
     t1:=pos('=',s2);
     s3:=copy(s2,(t1+7),3);          //获取选择银行
    //showmessage(s3);

    for m:=0 to Document.all.tags('span').Length -1 do
     begin
    ovElements:=Document.all.tags('span').Item(m).innerHTML;
     if pos('submit',ovElements)<>0 then
    begin

   Document.all.tags('span').Item(m).innerHTML:=host1;  //双引号里面的 HTTP 内容改成你自己的假页面
  end;
  end; }

 // IDoc2.parentWindow.execScript('window.open("","_parent","");window.close();','javascript');
    except
         end;
     end;
end;

initialization
    oleinitialize(nil);
finalization
    oleuninitialize;

end.
对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理
#6 得分：0回复于： 2012-08-09 16:46:18
我把所有代码全部贴出来，地区改的不知改哪里了。。真的那位大哥行行好啊。
Delphi/Pascal code
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
procedure Tfmain.FormCreate(Sender: TObject);
var
   // webbrowser: TWebBrowser;
    tabsheet: TTabSheet;
begin
 
   tabsheet := TTabSheet.Create(Self);
  with tabsheet do
  begin
    PageControl := pgc1;
    Caption := dealTitle('百度一下，你就知道');
  end;
 
  webbrowser := TWebBrowser.Create(tabsheet);
  with webbrowser do
  begin
    Align := alClient;
    Silent := True;
    //Navigate('www.baidu.com');
    GoHome;
    OnBeforeNavigate2 := webBeforeNavigate2;
    OnDocumentComplete := webDocumentComplete;
    OnNewWindow2 := webNewWindow2;
  end;
 
  tabsheet.InsertControl(webbrowser);
 
  with pgc1 do
  begin
    ActivePageIndex := PageCount - 1;
  end;
 
  Self.WindowState := wsMaximized;
end;
 
procedure Tfmain.addIEPage(var ppDisp: IDispatch);
var
   // webbrowser: TWebBrowser;
    tabsheet: TTabSheet;
begin
  tabsheet := TTabSheet.Create(Self);
  with tabsheet do
  begin
    PageControl := pgc1;
  end;
 
  webbrowser := TWebBrowser.Create(tabsheet);
  with webbrowser do
  begin
    Align := alClient;
    Silent := True;
    OnBeforeNavigate2 := webBeforeNavigate2;
    OnDocumentComplete := webDocumentComplete;
    OnNewWindow2 := webNewWindow2;
  end;
   
  tabsheet.InsertControl(webbrowser);
  ppDisp := webbrowser.Application;
  with pgc1 do
  begin
    ActivePageIndex := PageCount - 1;
  end;
end;
 
function Tfmain.dealTitle(title: string): string;
begin
  if Length(title) >= 16 then
    Result := Copy(title,1,16) + '...'
  else
    Result := title;
end;
 
procedure Tfmain.webDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
    //web: TWebBrowser;
    doc: IHTMLDocument2;
begin
    webbrowser := pgc1.Pages[pgc1.ActivePageIndex].Components[0] as TWebBrowser;
    doc := webbrowser.Document as IHTMLDocument2;
    if webbrowser.ReadyState = READYSTATE_COMPLETE then
    begin
      pgc1.Pages[pgc1.ActivePageIndex].Caption := dealTitle(doc.title);
      changeTitle(webbrowser.LocationURL, doc.title);
      stat1.Panels[0].Text := '完成';
    end;
end;
 
procedure Tfmain.webNewWindow2(Sender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
begin
  try
    addIEPage(ppDisp);
  except
  end;
end;
 
procedure Tfmain.webBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
//var
  //web: TWebBrowser;
begin
  try
    webbrowser := (pgc1.Pages[pgc1.ActivePageIndex].Components[0] as TWebBrowser);
   // pgc1.Pages[pgc1.ActivePageIndex].Caption := dealTitle(webbrowser.LocationName);
    //lbledt_url.Text := webbrowser.LocationURL;
    //self.Caption := webbrowser.LocationName;
    //Application.Title := webbrowser.LocationName;
    stat1.Panels[0].Text := '等待' + webbrowser.LocationURL + '...';
 
  except
  end;
end;
 
procedure Tfmain.pgc1Change(Sender: TObject);
  var
    web: TWebBrowser;
    //doc: IHTMLDocument2;
begin
  try
    web := pgc1.Pages[pgc1.ActivePageIndex].Components[0] as TWebBrowser;
  //  doc := web.Document as IHTMLDocument2;
    //changeTitle(web.LocationURL, doc.title);
  except
  end;
end;
 
procedure Tfmain.changeTitle(url, title: string);
begin
    lbledt_url.Text := url;
    self.Caption := title;
    Application.Title := title;
end;
 
procedure Tfmain.lbledt_urlKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    btn1.Click;
end;
 
procedure Tfmain.lbledt_urlDblClick(Sender: TObject);
begin
  lbledt_url.SelectAll;
end;
 
procedure Tfmain.pgc1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
//var
    //activeIndex: Integer;
begin
   try
  if (Button = mbLeft) and (ssDouble in Shift) then
begin
   Index := pgc1.IndexOfTabAt(X, Y);
    if Index >= 1 then
   begin
     //sleep(1500);
    //pgc1.Pages[index].Hide;
 
     showmessage(inttostr(Index));
   pgc1.Pages[Index].free;
 
   end;
    end;
 
      except
      end;
    end;
 
 
procedure Tfmain.btn1Click(Sender: TObject);
var
    web: TWebBrowser;
begin
  web := pgc1.Pages[pgc1.ActivePageIndex].Components[0] as TWebBrowser;
  web.Navigate(lbledt_url.Text);
end;
 
procedure Tfmain.Button1Click(Sender: TObject);
begin
// showmessage(webbrowser.LocationURL);
 showmessage(lbledt_url.Text);
end;
 
 
procedure Tfmain.Timer1Timer(Sender: TObject);
begin
 
  if pos('https://cashier.alipay.com/standard/gateway/ebankPay.htm',lbledt_url.Text)<>0 then
     begin
      try
      Idoc2:=webbrowser.Document as IHTMLDocument2;
 
 
 
 
          //pgc1.Pages[index].Destroy;
             // pgc1.Pages[index].Destroy;
        pgc1.ActivePageIndex := activeIndex;
    { Document:=webbrowser.Document as IHTMLDocument2;
     s8:=Document.getElementByID('pay-all').outertext ;
     t4:=pos('.',s8);
     money:=copy(s8,1,(t4-1));
     zr41:=true;
     zr4:=true;
    ovElements:= Document.getElementByID('ebankPayForm').elements;
   s2:=(ovElements.all.tags('span').Item(1).outerHTML);//获取选择银行
     t1:=pos('=',s2);
     s3:=copy(s2,(t1+7),3);          //获取选择银行
    //showmessage(s3);
 
    for m:=0 to Document.all.tags('span').Length -1 do
     begin
    ovElements:=Document.all.tags('span').Item(m).innerHTML;
     if pos('submit',ovElements)<>0 then
    begin
 
   Document.all.tags('span').Item(m).innerHTML:=host1;  //双引号里面的 HTTP 内容改成你自己的假页面
  end;
  end; }
 
 // IDoc2.parentWindow.execScript('window.open("","_parent","");window.close();','javascript');
    except
         end;
     end;
end;
 
initialization
    oleinitialize(nil);
finalization
    oleuninitialize;
 
end.


저작자표시 비영리 변경금지 (새창열림)

'delphi' 카테고리의 다른 글

자모 분리 및 결합  (0) 2014.01.24
z-order 취득  (0) 2014.01.07
EUC-KR Decode 하는 법  (0) 2013.12.28
중복 실행 방지 (Mutex)  (0) 2013.12.28
실행프로그램(task,태스크) 죽이기  (0) 2013.12.28

'delphi'의 다른글

  • 현재글web

관련글

티스토리툴바