如何用xml向http网址发送信息,在线等了,100分(100分)

  • 主题发起人 darlingpeng
  • 开始时间
D

darlingpeng

Unregistered / Unconfirmed
GUEST, unregistred user!
如何用xml向http网址发送信息,在线等了,100分
比如向这个地址发信息 https://localhost arch_voting.php?name=a
有哪位知道的,帮帮小弟了,在线等
 
什么意思? 不能说具体点吗?
 
to bfox,
我对delphi 这边怎么使用xml是一点都不懂,是不是要装xml控件?
再向 一个网址发信息,www.fasoft.cn
 
有没有知道的,给个回复
 
xml是没有这个功能的
 
要使用xml,用xmlDoc控件,d自带,不用安装
 
to linuxping,
这个 xmlDoc 在哪个控件包下,如何使用?
谢谢
 
to linuxping,
XMLDocument 在 internet 下,但是如何使用,请教下,能不能给出代码? 谢谢了
 
有没有知道,帮帮小弟了
 
TXMLDocument 仅仅是用来处理 XML 数据的,并没有发送到网络的功能。
 
WebService 不就可以了么?!
 
{*******************************************************}
{ }
{ 解析XML文件单元 }
{ }
{*******************************************************}

unit XMLReader;
interface
uses SysUtils, Variants, Classes, Dialogs, Forms,xmldom, XMLIntf, msxmldom, XMLDoc,Types,Graphics,SyncObjs;
const DefBkColor=clyellow;
DefFontColor=ClRed;
DefFontSize=8;
XML_MUTEX_NAME='wang_ping_1984_01_29';
type
TUrlCollection=class;
TUrlItem=class;
IUpdateFileXmlReader=Interface
procedure ChannelFiles(PlayType,Channel:string;var List,ListTime,ListURL:TStrings;IsLocal:Boolean=True);
procedure ChannelUpdateFiles(PlayType,Channel:string;var List,ListTime,ListURL:TStrings);
procedure AddFile(PlayType,Channel:string;FileName:string;URLFileName:string;LastModifyTime:string);
procedure FileUrls(PlayType,Channel,FileName:string;var URLs:TUrlCollection);
end;

ITopicFileXmlReader=Interface
procedure AllPlayTypes(List:TStrings);
procedure ChannelsOfPlayType(PlayTypeName:String;List:TStrings);
end;

TBaseXmlReader=class(TInterfacedObject)
private
FXmlDoc:TXMLDocument;
FPath:string;
procedure SetDocText(Text:string);
function GetDocText:string;
public
procedure SaveToFile;overload;
procedure EnumChildNodes(Node:IXMLNode;var Lst:TStrings);
//枚举一个节点下的所有子节点。
procedure EnumChildNodesAttr(Node:IXMLNode;AttrName:string;var Lst:TStrings);//枚举一个节点下的所有子节点的某一属性的值
function FindNode(ParentNode:IXMLNode;tagName:string):IXMLNode;overload;
//查找一个节点下的所有子节点中
function FindNode(ParentNode:IXMLNode;tagName:string;AttributeName,AttributeValue:WideString):IXMLNode;overload;
function FindNode(ParentNode:IXMLNode;tagName:string;
AttributeName1,AttributeValue1:WideString;
AttributeName2,AttributeValue2:WideString):IXMLNode;overload;
function FindNodeNext(Sibling:IXMLNode;tagName:string):IXMLNode;overload;
function FindNodeNext(Sibling:IXMLNode;tagName:string;AttributeName,AttributeValue:WideString):IXMLNode;overload;
function FindNodeNext(Sibling:IXMLNode;tagName:string;
AttributeName1,AttributeValue1:WideString;
AttributeName2,AttributeValue2:WideString):IXMLNode;overload;
public
constructor Create(APath:string);overload;
constructor Create;overload;
destructor Destroy;override;
procedure WriteToXML(APath:string;
AStr:String);
//将字符串写入到xml文件。原文件将被覆盖。
function FirstNode:IXMLNode;
function Root:IXMLNode;
function AddChild(Node:IXMLNode;ChildNodeName:WideString):IXMLNode;
// 添加一个子节点
procedure AddAttribute(Node:IXMLNode;AttributeName,AttributeValue:WideString);
// 给节点添加一个属性
procedure SetText(Node:IXMLNode;AText:WideString);
//给节点设置一个文本值。
function GetNodeAttributeValue(Node:IXMLNode;AttributeName:WideString):WideString;
function GetNodeText(Node:IXMLNode):WideString;
procedure SaveToFile(APath:string);overload;
//XmlDoc的内容保存到文件
property do
cText:string read GetDocText write SetDocText;
end;

TUpdateFileXmlReader=class(TInterfacedObject,IUpdateFileXmlReader)
private
FUpdateFile,FLocalFile:TBaseXmlReader;
FUpdateFilePath,FLocalFilePath:string;
public
constructor Create(AUpdateFilePath,ALocalFilePath:String);
destructor Destroy;override;
procedure ChannelFiles(PlayType,Channel:string;var List,ListTime,ListURL:TStrings;IsLocal:Boolean=True);
procedure ChannelUpdateFiles(PlayType,Channel:string;var List,ListTime,ListURL:TStrings);
procedure AddFile(PlayType,Channel:string;FileName:string;URLFileName:string;LastModifyTime:string);
procedure FileUrls(PlayType,Channel,FileName:string;var URLs:TUrlCollection);
//procedure Reload;
end;

TTopicFileXmlReader=class(TBaseXmlReader,ITopicFileXmlReader)
public
procedure AllPlayTypes(List:TStrings);
procedure ChannelsOfPlayType(PlayTypeName:String;List:TStrings);
end;

//-------------------------------------------------------------
TUrlItem=class(TCollectionItem)
protected
procedure AssignTo(Dest: TPersistent);override;
public
Text,Src:String;
Position:TRect;
Font:TFont;
BkColor:TColor;
constructor Create(Collection: TCollection);override;
destructor Destroy;override;
end;
TUrlItemClass=class of TUrlItem;
TUrlCollection=class(TCollection)
protected
procedure ParseUrl(APath:string);virtual;
public
constructor Create(APath:string);reintroduce;
end;

//---------------------------------------------
function ParserColor(C:String):TColor;
function PaserToHtml(AText:String):string;
//替换掉一些字符,使之成为html格式。
var
hXMLMutex:THandle;
implementation
uses StrUtils;
var
FCS:TCriticalSection;
function PaserToHtml(AText:String):string;
//替换掉一些字符,使之成为html格式。
begin
AText:= StringReplace(AText,'(','<',[rfReplaceAll , rfIgnoreCase]);
Result:= StringReplace(AText,')','>',[rfReplaceAll , rfIgnoreCase]);
end;
// #AAFFCC---->$AAFFCC
function ParserColor(C:String):TColor;
begin
if LeftStr(C,1)='#' then
AnsiReplaceStr(C,'#','$');
Result:=StrToIntDef(C,clWhite);
end;

{ TBaseXmlReader }
procedure TBaseXmlReader.AddAttribute(Node: IXMLNode;
AttributeName,
AttributeValue: WideString);
begin
FXMLDoc.Active:=True;
Node.Attributes[AttributeName]:=AttributeValue;
end;

function TBaseXmlReader.AddChild(Node: IXMLNode;
ChildNodeName: WideString): IXMLNode;
begin
FXMLDoc.Active:=True;
Result:=Node.AddChild(ChildNodeName);
end;

procedure TBaseXmlReader.SetText(Node: IXMLNode;
AText: WideString);
begin
FXMLDoc.Active:=True;
Node.Text:=AText;
end;

constructor TBaseXmlReader.Create(APath:string);
begin
FXMLDoc:=TXMLDocument.Create(Application);
FPath:=APath;
if not FileExists(APath) then
Abort;
FXmlDoc.LoadFromFile(APath);
try
FXMLDoc.Active:=True;
except
//;
end;
FXMLDoc.Encoding:='GB2312';
FXMLDoc.Options:=[doNodeAutoCreate,doNodeAutoIndent ,doAutoSave,doAttrNull];
FXmlDoc.ParseOptions:=FXmlDoc.ParseOptions+[poAsyncLoad];
if FXMLDoc.IsEmptyDoc then
begin
FXMLDoc.Active:=False;
FXMLDoc.XML.Text:='<?xml version="1.0" encoding="GB2312"?> <Root></Root> ';
FXMLDoc.Active:=True;
end;
end;

constructor TBaseXmlReader.Create;
begin
FXMLDoc:=TXMLDocument.Create(Application);
if FXMLDoc.IsEmptyDoc then
begin
FXMLDoc.Active:=False;
FXMLDoc.XML.Text:='<?xml version="1.0" encoding="GB2312"?><Root></Root> ';
FXMLDoc.Active:=True;
end;
FXMLDoc.Encoding:='GB2312';
FXMLDoc.Options:=[doNodeAutoCreate,doNodeAutoIndent ,doAutoSave];
end;

destructor TBaseXmlReader.Destroy;
begin
FXMLDoc.Active:=False;
FXMLDoc:=nil;
inherited;
end;

procedure TBaseXmlReader.WriteToXML(APath, AStr: String);
begin
SetDocText(AStr);
SaveToFile(APath);
FXmlDoc.LoadFromFile(APath);
end;

procedure TBaseXmlReader.SetDocText(Text: string);
begin
try
FXMLDoc.Active:=False;
FXMLDoc.XML.Text:=Text;
FXMLDoc.Active:=True;
Except
MessageDlg('错误的XML文件格式!', mtError,[mbYes],0);
Abort;
end;
end;

procedure TBaseXmlReader.SaveToFile(APath: string);
begin
//Encoding NOT Write!!!
FXMLDoc.NodeIndentStr:=#32#32;
FXMLDoc.Active:=True;
FXmlDoc.SaveToFile(APath);
end;

function TBaseXmlReader.GetNodeAttributeValue(Node: IXMLNode;
AttributeName:WideString): WideString;
begin
Result:=Node.Attributes[AttributeName];
//if AttributeName NOT Exist, Return Empty str .
end;

function TBaseXmlReader.GetNodeText(Node: IXMLNode): WideString;
begin
//if TextNodes NOT Found, Error Occur .
Result:=Node.Text;
end;

function TBaseXmlReader.GetDocText: string;
begin
FXMLDoc.Active:=True;
Result:=FXMLDoc.XML.Text;
end;

function TBaseXmlReader.FirstNode: IXMLNode;
begin
Result:=nil;
if root.HasChildNodes then
Result:=root.ChildNodes[0];
end;

function TBaseXmlReader.Root: IXMLNode;
begin
try
Result :=FXMLDoc.ChildNodes.Get(1);
except
Result:=nil;
end;
//if FirstNode Not Exsit , An Error occur.
end;

procedure TBaseXmlReader.EnumChildNodes(Node: IXMLNode;
var Lst: TStrings);
var
I:Integer;
begin
for I:=0 to Node.ChildNodes.Count-1do
Lst.Add(Node.ChildNodes.NodeName)
end;

function TBaseXmlReader.FindNode(ParentNode: IXMLNode;
tagName: string): IXMLNode;
begin
if ParentNode=nil then
Exit;
Result:=ParentNode.ChildNodes.FindNode(tagName);
end;

function TBaseXmlReader.FindNode(ParentNode: IXMLNode;
tagName: string;
AttributeName1, AttributeValue1, AttributeName2,
AttributeValue2: WideString): IXMLNode;
var
N:IXMLNode;
begin
Result:=Nil;
N:=FindNode(ParentNode,tagName);
if N=nil then
Exit;
while N<>nildo
begin
if (N.NodeName=tagName) AND(N.Attributes[AttributeName1]=AttributeValue1) and (N.Attributes[AttributeName2]=AttributeValue2) then
begin
Result:=N;
Exit;;
end;

N:=N.NextSibling;
end;
end;

function TBaseXmlReader.FindNode(ParentNode: IXMLNode;
tagName: string;
AttributeName, AttributeValue: WideString): IXMLNode;
var
N:IXMLNode;
begin
Result:=Nil;
N:=FindNode(ParentNode,tagName);
if N=nil then
Exit;
while N<>nildo
begin
//ShowMessage((WideCharToString(PWideChar(WideUpperCase(N.NodeName)))));
//ShowMessage(WideUpperCase(N.Attributes[AttributeName]));
if ((WideCharToString(PWideChar(WideUpperCase(N.NodeName))))=UpperCase(tagName)) AND (WideUpperCase(N.Attributes[AttributeName])=WideUpperCase(AttributeValue)) then
begin
Result:=N;
Exit;;
end;

//while (N<>nil) and (N.NodeName<>tagName)do
N:=N.NextSibling;
end;
end;

function TBaseXmlReader.FindNodeNext(Sibling: IXMLNode;
tagName: string): IXMLNode;
var
N:IXMLNode;
begin
Result:=Nil;
N:=Sibling.NextSibling;
if N=nil then
Exit;
while N<>nildo
begin
if UpperCase(N.NodeName)=UpperCase(tagName) then
begin
Result:=N;
Exit;;
end;
N:=N.NextSibling;
end;
end;

function TBaseXmlReader.FindNodeNext(Sibling: IXMLNode;
tagName: string;
AttributeName1, AttributeValue1, AttributeName2,
AttributeValue2: WideString): IXMLNode;
var
N:IXMLNode;
begin
Result:=Nil;
N:=FindNode(Sibling.ParentNode,tagName);
if N=nil then
Exit;
N:=N.NextSibling;
while (N<>nil) or (N.NodeName<>tagName) or (N.Attributes[AttributeName1]<>AttributeValue1) or (N.Attributes[AttributeName2]<>AttributeValue2)do
N:=N.NextSibling;
Result:=N;
end;

function TBaseXmlReader.FindNodeNext(Sibling: IXMLNode;
tagName: string;
AttributeName, AttributeValue: WideString): IXMLNode;
var
N:IXMLNode;
begin
Result:=Nil;
N:=FindNode(Sibling.ParentNode,tagName);
if N=nil then
Exit;
N:=N.NextSibling;
while (N<>nil) or (N.NodeName<>tagName) or (N.Attributes[AttributeName]<>AttributeValue)do
N:=N.NextSibling;
Result:=N;
end;

procedure TBaseXmlReader.EnumChildNodesAttr(Node: IXMLNode;AttrName:string;
var Lst: TStrings);
var
I:Integer;
begin
for I:=0 to Node.ChildNodes.Count-1do
Lst.Add(WideCharToString(PWideChar(VarToWideStr(Node.ChildNodes.Attributes[AttrName]))));
end;

procedure TBaseXmlReader.SaveToFile;
begin
FXmlDoc.SaveToFile(Self.FPath);
end;

{ TTopicFileXmlReader }
procedure TTopicFileXmlReader.AllPlayTypes(List: TStrings);
var
N:IXMLNode;
begin
Assert(Assigned(List),Format('类%S的方法%S的参数%S未赋值。',[Self.ClassName,'AllPlayTypes','List']));
List.Clear;
N:=Self.FirstNode;
if N=nil then
Exit;
while N<>nildo
begin
if N.HasAttribute('TypeName') then
List.Add(N.Attributes['TypeName']);
N:=Self.FindNodeNext(N,'PlayType');
end;
end;

procedure TTopicFileXmlReader.ChannelsOfPlayType(PlayTypeName: String;
List: TStrings);
var
N,C:IXMLNode;
begin
Assert(Assigned(List),Format('类%S的方法%S的参数%S未赋值。',[Self.ClassName,'ChannelsOfPlayType','List']));
List.Clear;
N:=Self.FirstNode;
if N=nil then
Exit;
while N<>nildo
begin
if N.HasAttribute('TypeName') and (UpperCase(N.Attributes['TypeName'])=UpperCase(PlayTypeName)) then
begin
C:=nil;
if N.HasChildNodes then
C:=N.ChildNodes[0];
while C<>nildo
begin
if C.HasAttribute('ChannelName') then
List.Add(C.Attributes['ChannelName']);
C:=Self.FindNodeNext(C,'Channel');
end;
end;

N:=Self.FindNodeNext(N,'PlayType');
end;
end;

{ TUrlItem }
procedure TUrlItem.AssignTo(Dest: TPersistent);
begin
if Dest is TUrlItem then
begin
TUrlItem(Dest).Text:=Self.Text;
TUrlItem(Dest).Src:=Self.Src;
TUrlItem(Dest).Position:=Self.Position;
TUrlItem(Dest).Font.Assign(Self.Font);
end
else
inherited;
end;

constructor TUrlItem.Create(Collection: TCollection);
begin
inherited;
Font:=TFont.Create;
Font.Color:=clRed;
BkColor:=clWhite;
Text:='';
Position.Left:=0;
Position.Top:=0;
Position.Right:=0;
Position.Bottom:=0;
Src:='';
end;

destructor TUrlItem.Destroy;
begin
if Font<>nil then
Font.Free;
inherited;
end;

{ TUrlCollection }
constructor TUrlCollection.Create(APath:string);
begin
inherited Create(TUrlItem);
//解析url
try
ParseUrl(APath);
except
end;

end;

procedure TUrlCollection.ParseUrl(APath:string);
var
FXmlReader:TBaseXmlReader;
First,Sec:IXMLNode;
Item:TUrlItem;
//Font:TFont;
begin
FXmlReader:=TBaseXmlReader.Create(APath);
try
First:=FXmlReader.FirstNode;
//urlinfo Node
if First=nil then
Exit;
while First<>nildo
begin
Item:=TUrlItem(Self.Add);
Sec:=FXmlReader.FindNode(First,'Position');
if Sec<>nil then
begin
if Sec.HasAttribute('Left') then
Item.Position.Left:=Sec.Attributes['Left'];
if Sec.HasAttribute('Top') then
Item.Position.Top:=Sec.Attributes['Top'];
if Sec.HasAttribute('Width') then
Item.Position.Right:=Sec.Attributes['Width'];
if Sec.HasAttribute('Height') then
Item.Position.Bottom:=Sec.Attributes['Height'];
end;

Sec:=FXmlReader.FindNode(First,'font');
if Sec<>nil then
begin
Item.Font.Size:=DefFontSize;
if Sec.HasAttribute('bkcolor') then
if ParserColor(Sec.Attributes['bkcolor'])=clwhite then
Item.BkColor:=DefBkColor
else
Item.BkColor:=ParserColor(Sec.Attributes['bkcolor']);
if Sec.HasAttribute('Fontcolor') then
if (ParserColor(Sec.Attributes['Fontcolor'])=clwhite) or (ParserColor(Sec.Attributes['Fontcolor'])=Item.BkColor) then
Item.Font.Color:=DefFontColor
else
Item.Font.Color:=ParserColor(Sec.Attributes['Fontcolor']);
end;

Sec:=FXmlReader.FindNode(First,'text');
if Sec<>nil then
if Sec.HasAttribute('data') then
Item.Text:=Sec.Attributes['data'];
Sec:=FXmlReader.FindNode(First,'link');
if Sec<>nil then
if Sec.HasAttribute('Src') then
Item.Src:=Sec.Attributes['Src'];
First:=FXmlReader.FindNodeNext(First,'URLInfo');
end;
finally
FXmlReader.Free;
end;
end;

{ TUpdateFileXmlReader }
procedure TUpdateFileXmlReader.AddFile(PlayType, Channel, FileName,
URLFileName, LastModifyTime: string);
var
nPlayType,nChannel,nFile:IXMLNode;
//I:Integer;
begin
if Trim(PlayType)='' then
Exit;
nPlayType:=FLocalFile.FindNode(FLocalFile.Root,'PlayType','TypeName',PlayType);
if nPlayType=nil then
begin
nPlayType:=FLocalFile.Root.AddChild('PlayType');
nPlayType.Attributes['TypeName']:=PlayType;
end;

if Trim(Channel)='' then
Exit;
nChannel:=FLocalFile.FindNode(nPlayType,'Channel','ChannelName',Channel);
if nChannel=nil then
begin
nChannel:=nPlayType.AddChild('Channel');
nChannel.Attributes['ChannelName']:=Channel;
end;

if Trim(FileName)='' then
Exit;
nFile:=FLocalFile.FindNode(nChannel,'File','FileName',FileName);
if nFile =nil then
nFile:=nChannel.AddChild('File');
nFile.Attributes['FileName']:=FileName;
nFile.Attributes['LastModifyTime']:=LastModifyTime;
nFile.Attributes['url']:=URLFileName;
end;


procedure TUpdateFileXmlReader.ChannelFiles(PlayType, Channel: string;
var List,ListTime,ListURL: TStrings;
IsLocal: Boolean);
var
xml:TBaseXmlReader;
nPlayType,nChannel{,nFile}:IXMLNode;
I:Integer;
begin
if IsLocal then
xml:=FLocalFile
else
Xml:=FUpdateFile;
List.Clear;
ListTime.Clear;ListURL.Clear;
nPlayType:=xml.FindNode(xml.Root,'PlayType','TypeName',PlayType);
if nPlayType=nil then
Exit;
nChannel:=xml.FindNode(nPlayType,'Channel','ChannelName',Channel);
if nChannel=nil then
Exit;
for I:=0 to nChannel.ChildNodes.Count-1do
begin
if nChannel.ChildNodes.HasAttribute('FileName') then
begin
List.Add(UpperCase(nChannel.ChildNodes.Attributes['FileName']));
if nChannel.ChildNodes.HasAttribute('LastModifyTime') then
ListTime.Add(UpperCase(nChannel.ChildNodes.Attributes['LastModifyTime']))
else
ListTime.Add('');
if nChannel.ChildNodes.HasAttribute('url') then
ListURL.Add(UpperCase(nChannel.ChildNodes.Attributes['url']))
else
ListURL.Add('');
end;
end;
end;

procedure TUpdateFileXmlReader.ChannelUpdateFiles(PlayType,
Channel: string;
var List,ListTime,ListURL: TStrings);
var
oList,oListTime,oListURL,nList,nListTime,nListURL:TStrings;
I,index:Integer;
oTime,nTime:TDateTime;
procedure FreeLists;
begin
FreeAndNil(nListURL);
FreeAndNil(nListTime);
FreeAndNil(nList);
FreeAndNil(oListURL);
FreeAndNil(oListTime);
FreeAndNil(oList);
end;
begin
oList:=TStringList.Create;
oListTime:=TStringList.Create;
oListURL:=TStringList.Create;
nList:=TStringList.Create;
nListTime:=TStringList.Create;
nListURL:=TStringList.Create;
List.Clear;ListTime.Clear;ListURL.Clear;
try
Self.ChannelFiles(PlayType,Channel,oList,oListTime,oListURL,True);
Self.ChannelFiles(PlayType,Channel,nList,nListTime,nListURL,False);
if oList.Count=0 then
//not such PlayType OR not such Channel.
begin
List.Assign(nList);
ListTime.Assign(nListTime);
ListURL.Assign(nListURL);
FreeLists;
Exit;
end;

for I:=0 to nList.Count-1do
begin
index:=oList.IndexOf(nList.Strings);
if index=-1 then
//not found.
begin
List.Add(nList);
ListTime.Add(nListTime);
ListURL.Add(nListURL);
end
else
//Found ,but Time is New .
begin
oTime:=StrToDateTimeDef(oListTime.Strings[index],StrToDateTime('2008-1-1 00:00:00')) ;
nTime:=StrToDateTimeDef(nListTime.Strings,StrToDateTime('2008-1-1 00:00:00')) ;
if oTime <nTime then
begin
List.Add(nList);
ListTime.Add(nListTime);
ListURL.Add(nListURL);
end;
end;
end;

finally
FreeLists;
end;
end;

constructor TUpdateFileXmlReader.Create(AUpdateFilePath,
ALocalFilePath: String);
begin
FCS.Enter;
inherited Create;
FUpdateFilePath:=AUpdateFilePath;
FLocalFilePath:=ALocalFilePath;
FUpdateFile:=TBaseXmlReader.Create(AUpdateFilePath);
FLocalFile:=TBaseXmlReader.Create(ALocalFilePath);
end;

destructor TUpdateFileXmlReader.Destroy;
begin
FreeAndNil(FLocalFile);
FreeAndNil(FUpdateFile);
FCS.Release;
inherited;
end;

procedure TUpdateFileXmlReader.FileUrls(PlayType, Channel,
FileName: string;
var URLs: TUrlCollection);
begin

end;

//procedure TUpdateFileXmlReader.Reload;
//begin
// try
// FUpdateFile.FXmlDoc.LoadFromFile(FUpdateFilePath);
// FLocalFile.FXmlDoc.LoadFromFile(FLocalFilePath);
// except
// end;
//end;

initialization
FCS:=TCriticalSection.Create;
finalization
FCS.Free;
end.
 
to linuxping
谢谢,我好好看看
欢迎大家继续讨论
 
多人接受答案了。
 

Similar threads

D
回复
0
查看
792
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
746
DelphiTeacher的专栏
D
顶部