Delphi中如何调用XML(200分)

  • 主题发起人 主题发起人 cmz
  • 开始时间 开始时间
C

cmz

Unregistered / Unconfirmed
GUEST, unregistred user!
Delphi中如何调用XML,B/S结构。最好附详细代码或方法
 
xmldocument看帮助!
 
//我以前做过的一个可以提取csdn的xml数据的源码。
//可以去http://iapollo.diy.163.com/mywork/delphi/xmlTRA.rar
//下载源文件看看。程序用到了ksSkin控件,xp效果的,没什么用。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, xmldom, StdCtrls, Provider, Xmlxform, DB, DBClient, Grids,
DBGrids, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, DBCtrls, KsHooks, KsForms, KsSkinForms, KsSkinEngine, KsEdits,
KsSkinEdits, KsControls, KsButtons, KsSkinButtons, KsLabels,
KsSkinLabels, KsSkinDBControls, KsGrids, KsSkinDBGrids, KsProgress,
KsSkinProgress;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
xmlt: TXMLTransformProvider;
IdHTTP1: TIdHTTP;
Memo1: TDBMemo;
DataSource2: TDataSource;
ClientDataSet2: TClientDataSet;
XMLTransformProvider1: TXMLTransformProvider;
DBMemo1: TDBMemo;
OpenDialog1: TOpenDialog;
SeSkinEngine1: TSeSkinEngine;
SeSkinForm1: TSeSkinForm;
Button1: TSeSkinButton;
Edit1: TSeSkinEdit;
Button2: TSeSkinButton;
SeSkinDBText1: TSeSkinDBText;
SeSkinDBGrid1: TSeSkinDBGrid;
SeSkinDBGrid2: TSeSkinDBGrid;
SeSkinButton1: TSeSkinButton;
SeSkinLabel1: TSeSkinLabel;
SeSkinButton2: TSeSkinButton;
SaveDialog1: TSaveDialog;
spb: TSeSkinProgressBar;
SeSkinLabel2: TSeSkinLabel;
procedure Button2Click(Sender: TObject);
procedure SeSkinButton1Click(Sender: TObject);
procedure SeSkinButton2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure IdHTTP1Workbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdHTTP1Work(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdHTTP1WorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
private
{ Private declarations }
public
{ Public declarations }
procedure refresh;
procedure setXMLfile(filename:String);
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.refresh;
begin
ClientDataSet1.Active:=false;
ClientDataSet1.Active:=true;
ClientDataSet2.Active:=false;
ClientDataSet2.Active:=true;
end;

procedure TForm1.setXMLfile(filename:String);
begin
xmlt.XMLDataFile:=filename;
XMLTransformProvider1.XMLDataFile:=filename;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if openDialog1.Execute then
setXMLfile(opendialog1.FileName);
refresh;
end;

procedure TForm1.SeSkinButton1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.SeSkinButton2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
ClientDataSet1.SaveToFile(SaveDialog1.FileName,dfXML);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
xmlpath:String;
begin
memo1.Clear;
xmlpath:='http_xml.xml';
memo1.Lines.Add(idhttp1.Get(Edit1.Text));
if fileExists(xmlpath) then
deleteFile(xmlpath);
memo1.Lines.SaveToFile(xmlpath);
setXMLfile(xmlpath);
refresh;
end;

procedure TForm1.IdHTTP1Workbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
spb.Position := 0;
spb.Max := AWorkcountMax;
end;

procedure TForm1.IdHTTP1Work(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
spb.Position := AWorkCount;
end;

procedure TForm1.IdHTTP1WorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
begin
spb.Position:=0;
end;

end.
 
XML格式的聊天程序:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, NMUDP, IdUDPServer, IdBaseComponent, IdComponent,
IdUDPBase, IdUDPClient, IdAntiFreezeBase, IdAntiFreeze, IDSOCKETHANDLE,
Grids, Menus,shellapi;
const MY_MESSAGE = WM_USER + 100;
type
TForm1 = class(TForm)
Sendword: TEdit;
sendbt: TButton;
NMUDP1: TNMUDP;
Label1: TLabel;
name: TEdit;
Label2: TLabel;
remotehost: TEdit;
speaklist: TStringGrid;
sendto: TEdit;
MainMenu1: TMainMenu;
F1: TMenuItem;
Save1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
receiveword: TLabel;
PopupMenu1: TPopupMenu;
Saveasfile1: TMenuItem;
Sendtothem1: TMenuItem;
EXIT2: TMenuItem;
procedure sendbtClick(Sender: TObject);
procedure NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer;
FromIP: String;
Port: Integer);
procedure FormCreate(Sender: TObject);
procedure speaklistDblClick(Sender: TObject);
procedure speaklistRowMoved(Sender: TObject;
FromIndex,
ToIndex: Integer);
procedure Saveasfile1Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure About1Click(Sender: TObject);
private
procedure OnIconNotify(var Message: TMessage);
message MY_MESSAGE;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Busy: Boolean;
implementation
{$R *.dfm}
procedure TForm1.OnIconNotify(var Message: TMessage);
begin
if not Busy then
begin
Busy :=true;
if Message.LParam=WM_LBUTTONDOWN then
begin
form1.Show;
if Application.MessageBox('Are you sure close?','Exit',MB_YESNO)=IDYES then
Close;
popupmenu1.Popup(10,10);
end;
Busy := false;
end;

end;

procedure TForm1.sendbtClick(Sender: TObject);
var
MyStream: TMemoryStream;
TmpStr: String;
begin
NMUDP1.ReportLevel := Status_Basic;
NMUDP1.RemoteHost := remotehost.Text;
//???Α#n+祇癳?+#t+ヘ夹?+#s+笆迭?弧+#w+弧?杠
TmpStr :='#n'+name.Text+'#t'+sendto.Text+'#s 弧?#w'+ sendword.Text;
MyStream := TMemoryStream.Create;
try
MyStream.Write(TmpStr[1], Length(tmpstr));
NMUDP1.SendStream(MyStream);
finally
MyStream.Free;
end;
sendword.SetFocus;
end;

procedure TForm1.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer;
FromIP: String;
Port: Integer);
var
MyStream: TMemoryStream;
TmpStr: String;
name:string;
BeSend:string;
postword:string;
s:integer;
t:integer;
w:integer;
begin
MyStream := TMemoryStream.Create;
try
NMUDP1.ReadStream(MyStream);
SetLength(TmpStr,NumberBytes);
MyStream.Read(TmpStr[1],NumberBytes);
//- ???Α秆絏:#n+祇癳?+#t+ヘ夹?+#s+笆迭?弧+#w+弧?杠
s:=pos('#s',tmpstr);
t:=pos('#t',tmpstr);
w:=pos('#w',tmpstr);
name:=copy(tmpstr,3,t-3);
besend:=copy(tmpstr,t+2,s-t-2);
postword:=copy(tmpstr,w+2,length(tmpstr)-w+1);
//-----------
speaklist.RowCount:=speaklist.RowCount+1;
speaklist.Cells[0,speaklist.rowcount-2]:=fromip;
speaklist.Cells[1,speaklist.RowCount-2]:=name;
//speaklist.Cells[2,speaklist.RowCount-2]:=besend;
speaklist.cells[2,speaklist.RowCount-2]:='癸-'+besend+'-弧:'+postword;
receiveword.Caption:=name+'癸 -'+besend+'- 弧 :'+postword;
beep();
//sendmessage(speaklist.Handle,WM_VSCROLL,SB_BOTTOM,0);
finally
MyStream.Free;
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
nid: TNotifyIconData;
begin
//hide taskbar 夹肈
//SetWindowLong(application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
busy:=false;
nid.cbSize := sizeof(nid);
// nid??????
nid.Wnd := Handle;
// ?????
nid.uID:=4567;
nid.hIcon := Application.Icon.Handle;
// ????????,?????
nid.szTip := 'LANICQ--- Design by 璖狥キ;MiTAC LTD. JUN.2002';
// ?????
nid.uCallbackMessage := MY_MESSAGE;
// ??????
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
// ????????
if not Shell_NotifyIcon(NIM_ADD,@nid) then
begin
ShowMessage('Failed!');
Application.Terminate;
end;
{??????????TOOL??,??????????}
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

procedure TForm1.speaklistDblClick(Sender: TObject);
var
i:integer;
//t:string;
begin
i:=speaklist.Selection.Top;
remotehost.Text:=speaklist.Cells[0,i];
sendto.Text:=speaklist.Cells[1,i];

end;

procedure TForm1.speaklistRowMoved(Sender: TObject;
FromIndex,
ToIndex: Integer);
begin
speaklist.Canvas.Brush.Color:=234567;
end;

procedure TForm1.Saveasfile1Click(Sender: TObject);
var
t:string;
i:integer;
begin

for i:=0 to speaklist.RowCount-1 do
begin

//t:=t+speaklist.Cols.Text;
end;
end;

procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
var
nid: TNotifyIconData;
begin
nid.cbSize := sizeof(nid);
// nid??????
nid.cbSize := sizeof(nid);
// nid??????
nid.uID :=4567;
//????,???????????
nid.Wnd := Handle;
//?????
Shell_NotifyIcon(NIM_DELETE,@nid);
//?????
Shell_NotifyIcon(NIM_DELETE,@nid);
//?????
end;

procedure TForm1.About1Click(Sender: TObject);
begin
SHOWMESSAGE('LANICQ--- Design by 璖狥キ;MiTAC LTD. JUN.2002');
end;

end.
 
谢谢Boycott,Fanciex.大恩不言谢,请接分
 
后退
顶部