30分调试一个有的源代码小程序--网络方面 ( 积分: 30 )

  • 主题发起人 主题发起人 huxhang
  • 开始时间 开始时间
H

huxhang

Unregistered / Unconfirmed
GUEST, unregistred user!
这个程序我作不成功！那位帮帮，送30分，最好d7版，源代码发到huxhang@163.com



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, OleCtrls, SHDocVw_TLB, EmbeddedWB, ExtCtrls,
Grids;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button1: TButton;
Button2: TButton;
StringGrid1: TStringGrid;
Edit4: TEdit;
Panel1: TPanel;
WebBrowser1: TEmbeddedWB;
RichEdit1: TRichEdit;
Button3: TButton;
Splitter1: TSplitter;
Button4: TButton;
Button5: TButton;
Memo1: TMemo; //測試用
Button6: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses MSHtml,ActiveX;
{$R *.dfm}

function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; Value: string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then
begin
Exit;
end;
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
try
if FormItem.Item(j).Name = FieldName then
begin
FormItem.Item(j).Value := Value;
Result := True;
end;
except
Exit;
end;
end;
end;
end;

Procedure IsolateTextBetweentags( Const S: String;
Tag1, Tag2: String; list:TStrings );
Var
pScan, pEnd, pTag1, pTag2: PChar;
foundText: String;
searchtext: String;
begin
searchtext := Uppercase(S);
Tag1:= Uppercase( Tag1 );
Tag2:= Uppercase( Tag2 );
pTag1:= PChar(Tag1);
pTag2:= PChar(Tag2);
pScan:= PChar(searchtext);
Repeat
pScan:= StrPos( pScan, pTag1 );
If pScan <> Nil Then begin
Inc(pScan, Length( Tag1 ));
pEnd := StrPos( pScan, pTag2 );
If pEnd <> Nil Then begin
SetString( foundText, Pchar(S) + (pScan- PChar(searchtext) ), pEnd-pScan );
list.Add( foundText );
pScan := pEnd + Length(tag2);
end
else
pScan := Nil;
end;
Until pScan = Nil;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://otcbnd.gretai.org.tw/c/d09.asp');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hd:IHtmlDocument2;
f: IHTMLFormElement;
begin
FillForm(WebBrowser1,'Yr',Edit1.Text);
FillForm(WebBrowser1,'Mon',Edit2.Text);
FillForm(WebBrowser1,'Day',Edit3.Text);
hd := WebBrowser1.Document as IHtmlDocument2;
f := hd.forms.item(0, 0) as IHTMLFormElement;
f.submit;
end;


procedure TForm1.Button3Click(Sender: TObject);
var
Document : IHtmlDocument2;
Link : IHTMLElement;
StrLinks : string;
Target,Nothing: OleVariant;
i : integer;
begin
StrLinks:='';
Target := '_self';
Nothing := '';
Document := WebBrowser1.Document as IHTMlDocument2;
for i := 0 to Document.Links.Length - 1 do
begin
Link := Document.Links.Item(i, 0) as IHTMLElement;
StrLinks := Link.ToString;
if StrLinks<>''then
WebBrowser1.Navigate(StrLinks, Nothing, Target, Nothing, Nothing)
else
showmessage('這是最後一頁');
end;
end;


procedure TForm1.Button4Click(Sender: TObject);
var AStream:TMemoryStream;
begin
Memo1.Clear;
AStream:=TMemoryStream.Create;
try
(WebBrowser1.Document as IPersistStreamInit).Save(TStreamAdapter.Create(AStream),false);
AStream.Seek(0,soFromBeginning);
RichEdit1.Lines.LoadFromStream(AStream);
finally
AStream.Free;
end;
IsolateTextBetweenTags(Richedit1.text,'<h3 align=&quot;center&quot;>','[/h3]',Memo1.Lines); //測試用
Edit4.Text:=Trim(Memo1.Text);
end;

procedure TForm1.Button5Click(Sender: TObject);
var SL:TStringList;
i,K:integer;
begin
SL:=TStringList.Create;
IsolateTextBetweenTags(Richedit1.text,
'<th width=&quot;10%&quot;><font size=&quot;1&quot; color=#848484>',
'</font></th>',SL);
Memo1.Text:=SL.Text;
For i:=0 to SL.Count-1 do
begin
StringGrid1.Cells[i+1,0]:=SL;
StringGrid1.Cells[K, 0 ] := inttostr(K);
K := K + 1;
if StringGrid1.ColCount < K then
StringGrid1.ColCount := K;
end;
SL.Free;
end;

procedure TForm1.Button6Click(Sender: TObject);
var SL:TStringList;
i,K:integer;
begin
K:=0;
SL:=TStringList.Create;
IsolateTextBetweenTags(Richedit1.text,
'<TD align=&quot;left&quot;><font size=&quot;2&quot; color=#848484>',
'</font></TD>',SL);
Memo1.Text:=SL.Text; //測試用
For i:=0 to SL.Count-1 do
begin
if (i Mod 2)=0 then
StringGrid1.Cells[1,i+1]:=SL
else
StringGrid1.Cells[2,i+1-1]:=SL;
K := K + 1;
StringGrid1.Cells[0,K] := inttostr(K);
if StringGrid1.RowCount < K then
StringGrid1.RowCount := K;
end;
SL.Free;
end;

initialization
OleInitialize(nil);

finalization
OleUninitialize;
end.
 
这个程序我作不成功！那位帮帮，送30分，最好d7版，源代码发到huxhang@163.com



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, OleCtrls, SHDocVw_TLB, EmbeddedWB, ExtCtrls,
Grids;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button1: TButton;
Button2: TButton;
StringGrid1: TStringGrid;
Edit4: TEdit;
Panel1: TPanel;
WebBrowser1: TEmbeddedWB;
RichEdit1: TRichEdit;
Button3: TButton;
Splitter1: TSplitter;
Button4: TButton;
Button5: TButton;
Memo1: TMemo; //測試用
Button6: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses MSHtml,ActiveX;
{$R *.dfm}

function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; Value: string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then
begin
Exit;
end;
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
try
if FormItem.Item(j).Name = FieldName then
begin
FormItem.Item(j).Value := Value;
Result := True;
end;
except
Exit;
end;
end;
end;
end;

Procedure IsolateTextBetweentags( Const S: String;
Tag1, Tag2: String; list:TStrings );
Var
pScan, pEnd, pTag1, pTag2: PChar;
foundText: String;
searchtext: String;
begin
searchtext := Uppercase(S);
Tag1:= Uppercase( Tag1 );
Tag2:= Uppercase( Tag2 );
pTag1:= PChar(Tag1);
pTag2:= PChar(Tag2);
pScan:= PChar(searchtext);
Repeat
pScan:= StrPos( pScan, pTag1 );
If pScan <> Nil Then begin
Inc(pScan, Length( Tag1 ));
pEnd := StrPos( pScan, pTag2 );
If pEnd <> Nil Then begin
SetString( foundText, Pchar(S) + (pScan- PChar(searchtext) ), pEnd-pScan );
list.Add( foundText );
pScan := pEnd + Length(tag2);
end
else
pScan := Nil;
end;
Until pScan = Nil;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://otcbnd.gretai.org.tw/c/d09.asp');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hd:IHtmlDocument2;
f: IHTMLFormElement;
begin
FillForm(WebBrowser1,'Yr',Edit1.Text);
FillForm(WebBrowser1,'Mon',Edit2.Text);
FillForm(WebBrowser1,'Day',Edit3.Text);
hd := WebBrowser1.Document as IHtmlDocument2;
f := hd.forms.item(0, 0) as IHTMLFormElement;
f.submit;
end;


procedure TForm1.Button3Click(Sender: TObject);
var
Document : IHtmlDocument2;
Link : IHTMLElement;
StrLinks : string;
Target,Nothing: OleVariant;
i : integer;
begin
StrLinks:='';
Target := '_self';
Nothing := '';
Document := WebBrowser1.Document as IHTMlDocument2;
for i := 0 to Document.Links.Length - 1 do
begin
Link := Document.Links.Item(i, 0) as IHTMLElement;
StrLinks := Link.ToString;
if StrLinks<>''then
WebBrowser1.Navigate(StrLinks, Nothing, Target, Nothing, Nothing)
else
showmessage('這是最後一頁');
end;
end;


procedure TForm1.Button4Click(Sender: TObject);
var AStream:TMemoryStream;
begin
Memo1.Clear;
AStream:=TMemoryStream.Create;
try
(WebBrowser1.Document as IPersistStreamInit).Save(TStreamAdapter.Create(AStream),false);
AStream.Seek(0,soFromBeginning);
RichEdit1.Lines.LoadFromStream(AStream);
finally
AStream.Free;
end;
IsolateTextBetweenTags(Richedit1.text,'<h3 align=&quot;center&quot;>','[/h3]',Memo1.Lines); //測試用
Edit4.Text:=Trim(Memo1.Text);
end;

procedure TForm1.Button5Click(Sender: TObject);
var SL:TStringList;
i,K:integer;
begin
SL:=TStringList.Create;
IsolateTextBetweenTags(Richedit1.text,
'<th width=&quot;10%&quot;><font size=&quot;1&quot; color=#848484>',
'</font></th>',SL);
Memo1.Text:=SL.Text;
For i:=0 to SL.Count-1 do
begin
StringGrid1.Cells[i+1,0]:=SL;
StringGrid1.Cells[K, 0 ] := inttostr(K);
K := K + 1;
if StringGrid1.ColCount < K then
StringGrid1.ColCount := K;
end;
SL.Free;
end;

procedure TForm1.Button6Click(Sender: TObject);
var SL:TStringList;
i,K:integer;
begin
K:=0;
SL:=TStringList.Create;
IsolateTextBetweenTags(Richedit1.text,
'<TD align=&quot;left&quot;><font size=&quot;2&quot; color=#848484>',
'</font></TD>',SL);
Memo1.Text:=SL.Text; //測試用
For i:=0 to SL.Count-1 do
begin
if (i Mod 2)=0 then
StringGrid1.Cells[1,i+1]:=SL
else
StringGrid1.Cells[2,i+1-1]:=SL;
K := K + 1;
StringGrid1.Cells[0,K] := inttostr(K);
if StringGrid1.RowCount < K then
StringGrid1.RowCount := K;
end;
SL.Free;
end;

initialization
OleInitialize(nil);

finalization
OleUninitialize;
end.
 
不可以贴图吗，斑竹？
 
原文件：
http://bbs.2ccc.com/topic.asp?topicid=187608
 
您必须登录或注册才可回复。

Similar threads

Y
我的server怎么不能发信息到client？？？dx们可以帮我解释一下套接字吗？(20分)
回复
3
查看
216
ybbh
Y
S
我准备做一个像MSN的邮件提示一样打开窗口的程序,请教高手,有没有相关的函数.谢谢.在线等待...(100分)
回复
4
查看
196
seeme0526
S
M
我抄的网上泛滥的spcomm例子，只能发送，为什么收不到？？过来看看(50分)
回复
9
查看
206
我爱飞
我
X
菜鸟不知道finger命令有什么用，照书上的一段代码写在了程序里，可以执行，只不过我不知道finger在局域网里有什么用？ (90分)
回复
4
查看
208
xiaoxiami0
X
J
急！急！急！一个简单的socket发送接收信息的问题！(50分)
回复
2
查看
159
jhjk
J
后退
顶部