Well im already looking what changes I need to make. I plan to make sure
the current code I produce is clean of closed source. If cource I will
donate the code :-) Its independed of the data set.
Heres the code I have now. I have produced a first plugin in Lazarus for
osF. This is still basic but it works fine.
It would be nice to have the nesteld dataset in the memdataset to (it
wrote the recursion)
Heres the code I have with jans XML parce im sure it will be almost the
same with other parcers,
And yes its independen of the mem-dataset anny data set should work.
procedure CreateFieldDefs(AFieldsNode : TJanXmlNode2;aFieldDefs:
TFieldDefs);
var
i : Integer ;
FieldType : String ;
begin
if AFieldsNode <> nil then
begin
AFieldDefs.Clear ;
for i := 0 to AFieldsNode.nodes.Count -1 do
begin
FieldType :=
LowerCase(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['fieldtype'
]) ;
if FieldType = 'i2' then
begin
AFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftSmallint);
end else
if FieldType = 'i4' then
begin
AFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftInteger);
end else
if FieldType = 'string' then
begin
AFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftString,StrToIntDef(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attr
ibute['WIDTH'],0));
end else
if FieldType = 'r8' then
begin
AFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftFloat);
end else
if FieldType = 'datetime' then
begin
AFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftDateTime);
end else
if FieldType = 'date' then
begin
aFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftDate);
end else
if FieldType = 'sqldatetime' then
begin
aFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftTimeStamp);
end else
if FieldType = 'bin.hex' then
begin
if
TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['SUBTYPE'] =
'Graphics' then
aFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftGraphic)
else
aFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftMemo)
end else
if FieldType = 'nested' then
begin
AFieldDefs.Add(TJanXmlNode2(AFieldsNode.nodes.Items[i]).attribute['attrn
ame'],ftDataSet) ;
CreateFieldDefs(TJanXmlNode2(AFieldsNode.nodes.Items[i]).getChildByPath(
'FIELDS'),aFieldDefs.Items[aFieldDefs.Count-1].ChildDefs);
end ;
end;
end; // End fieldsnode <> nil
end;
procedure LoadXMLFromString(AXml: String;
aToDataset: TDataSet);
var
ajanXMLParser2 : TjanXMLParser2 ;
AFieldsNode : TJanXmlNode2 ;
ARowsNode : TJanXmlNode2 ;
i : Integer ;
begin
aToDataset.Close ;
ajanXMLParser2 := TjanXMLParser2.create ;
try
ajanXMLParser2.xml := AXml ;
AFieldsNode := ajanXMLParser2.getChildByPath('METADATA/FIELDS') ;
if AFieldsNode <> nil then
begin
// create fielddefs
CreateFieldDefs(AFieldsNode,aToDataset.FieldDefs);
aToDataset.Open ;
ARowsNode := ajanXMLParser2.getChildByPath('ROWDATA') ;
// load data
if ARowsNode <> nil then
InsertData(ARowsNode,aToDataset);
end;
finally
ajanXMLParser2.free ;
end;
end;
procedure InsertData(ARowNode: TJanXmlNode2; aDataSet: TDataSet);
var
rows,i : Integer ;
AttribField : TField ;
function GetDate(ADateString : String ) : TDateTime ;
var
Year,Month,Day,Hour,Minutes,Seconds,Miliseconds : Word ;
begin
Result := 0 ;
if ADateString <> '' then
begin
Year := StrToIntDef(copy(ADateString,1,4),0);
Month := StrToIntDef(copy(ADateString,5,2),0);
Day := StrToIntDef(copy(ADateString,7,2),0);
// todo : time
Hour := StrToIntDef(copy(ADateString,10,2),0);
Minutes := StrToIntDef(copy(ADateString,13,2),0);
Seconds := StrToIntDef(copy(ADateString,16,2),0);
result :=
EncodeDateTime(Year,Month,Day,Hour,Minutes,Seconds,Miliseconds);
end;
end;
begin
for rows := 0 to ARowNode.nodes.Count -1 do
begin
aDataSet.Append ;
for i := 0 to TJanXmlNode2(ARowNode.nodes[rows]).attributecount
-1 do
begin
AttribField :=
aDataSet.FindField(TJanXmlNode2(ARowNode.nodes[rows]).attributename[i])
;
if AttribField <> nil then
begin
case AttribField.DataType of
ftString,ftSmallint,
ftInteger,ftWord : AttribField.value :=
TJanXmlNode2(ARowNode.nodes[rows]).attribute[i] ;
ftDate,ftDateTime : AttribField.value :=
GetDate(TJanXmlNode2(ARowNode.nodes[rows]).attribute[i]) ;
ftFloat : AttribField.value :=
StrToFloat(StringReplace(TJanXmlNode2(ARowNode.nodes[rows]).attribute[i]
,'.',DecimalSeparator,[]));
ftmemo : AttribField.value :=
TJanXmlNode2(ARowNode.nodes[rows]).attribute[i] ;
ftGraphic : AttribField.value :=
TJanXmlNode2(ARowNode.nodes[rows]).attribute[i] ;
end; // end case
end;
end;
// nesteled data
for i := 0 to TJanXmlNode2(ARowNode.nodes[rows]).nodes.Count -1
do
begin
AttribField :=
aDataSet.FindField(TJanXmlNode2(TJanXmlNode2(ARowNode.nodes[rows]).nodes
[i]).name) ;
if (AttribField <> nil) and (AttribField.DataType =
ftDataSet) then
begin
InsertData(TJanXmlNode2(TJanXmlNode2(ARowNode.nodes[rows]).nodes[i]),TDa
taSetField(AttribField).NestedDataSet);
end;
end;
aDataSet.Post ;
end;
end;
function DataSetToXmlString(aToDataset: TDataset): String;
var
ajanXMLParser2 : TjanXMLParser2 ;
AFieldsNode : TJanXmlNode2 ;
ARowsNode : TJanXmlNode2 ;
i : Integer ;
begin
ajanXMLParser2 := TjanXMLParser2.create ;
try
ajanXMLParser2.name := 'DATAPACKET' ;
ajanXMLParser2.attribute['Version'] := '2.0' ;
AFieldsNode := ajanXMLParser2.forceChildByPath('METADATA/FIELDS')
;
if AFieldsNode <> nil then
begin
// create fielddefs
ExportFields(AFieldsNode,aToDataset.Fields);
ARowsNode := ajanXMLParser2.forceChildByPath('ROWDATA') ;
// Save data
if ARowsNode <> nil then
ExportData(ARowsNode,aToDataset,'');
end;
Result := ajanXMLParser2.xml ;
finally
ajanXMLParser2.free ;
end;
end;
procedure ExportData(ARowsNode: TJanXmlNode2; aDataSet:
TDataSet;RowName:String);
var
i : Integer ;
TheRowNode : TJanXmlNode2 ;
begin
aDataSet.First ;
while not aDataSet.Eof do
begin
TheRowNode := ARowsNode.addChildByName('ROW'+RowName) ;
for i := 0 to aDataSet.FieldCount -1 do
begin
if not aDataSet.Fields[i].IsNull then
begin
case aDataSet.Fields[i].DataType of
ftDate :
TheRowNode.attribute[aDataSet.Fields[i].FieldName] :=
FormatDateTime('yyyymmdd hh:nn:ss:zzzz',aDataSet.Fields[i].AsDateTime);
ftDateTime :
TheRowNode.attribute[aDataSet.Fields[i].FieldName] :=
FormatDateTime('yyyymmdd hh:nn:ss:zzzz',aDataSet.Fields[i].AsDateTime);
ftDataSet : begin
ExportData(TheRowNode.addChildByName(aDataSet.Fields[i].FieldName),TData
SetField(aDataSet.Fields[i]).NestedDataSet,aDataSet.Fields[i].FieldName)
;
end;
else
TheRowNode.attribute[aDataSet.Fields[i].FieldName] :=
aDataSet.Fields[i].AsString ;
end ; // end case
end;
end;
aDataSet.Next ;
end; // end wile not eof
end;
procedure ExportFields(AFieldsNode: TJanXmlNode2;
aFieldDefs: TFields);
var
i : Integer ;
TheFieldNode : TJanXmlNode2 ;
begin
for i := 0 to aFieldDefs.Count -1 do
begin
theFieldNode := AFieldsNode.addChildByName('FIELD') ;
theFieldNode.attribute['attrname'] := aFieldDefs[i].FieldName ;
case aFieldDefs[i].DataType of
ftSmallint : theFieldNode.attribute['fieldtype'] := 'i2' ;
ftInteger : theFieldNode.attribute['fieldtype'] := 'i4' ;
ftString : begin
theFieldNode.attribute['fieldtype'] := 'string' ;
theFieldNode.attribute['WIDTH'] :=
IntToStr(aFieldDefs[i].Size) ;
end;
ftFloat : theFieldNode.attribute['fieldtype'] := 'r8' ;
ftDateTime : theFieldNode.attribute['fieldtype'] := 'Datetime'
;
ftDate : theFieldNode.attribute['fieldtype'] := 'date' ;
ftTimeStamp : theFieldNode.attribute['fieldtype'] :=
'SQLdatetime' ;
ftGraphic : begin
theFieldNode.attribute['fieldtype'] := 'bin.hex' ;
theFieldNode.attribute['SUBTYPE'] := 'Graphics' ;
end;
ftMemo : begin
theFieldNode.attribute['fieldtype'] := 'bin.hex' ;
theFieldNode.attribute['SUBTYPE'] := 'text' ;
end;
ftDataSet : begin
theFieldNode.attribute['fieldtype'] := 'nested' ;
ExportFields(theFieldNode.forceChildByPath('FIELDS'),TDataSetField(aFiel
dDefs[i]).NestedDataSet.Fields);
end;
end ;// end case ;;
end; // End for i
end;
Met vriendelijke groet,
Pieter Valentijn
Delphidreams
http://www.delphidreams.nl
-----Oorspronkelijk bericht-----
Van: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] Namens Michael
Van Canneyt
Verzonden: maandag 27 november 2006 21:42
Aan: [email protected]
Onderwerp: RE: [lazarus] LazDoc support inside IDE
On Mon, 27 Nov 2006, Pieter Valentijn wrote:
> Yes exactly :-)
> Im a button man ,I gess I missed the shortcuts, excelent I realy use
> them.
>
> I have writen a Midas compatible export for the Mem dataset. I tried
> to convert the memdataset from the Jedi library but the blob pointers
> (char in Delphi) are not working.
The export would be something which would be a valuable addition to the
FCL. Any chance of you donating the code ? In principle, I'd expect this
to be indepent of the dataset, though ?
>
> I use the XML parcer from Jan Verhoeven Im sure I can port the code to
> lazarus. I use the client dataset to stream records in XML to and from
> clients. One of my most used programs is the osCommerce import that
> hase a link with a speacial PHP file. That file you can give SQL and
> it can return you a Datapacket. So not its also cut loss from the
> client dataset. I will try to see if I can get this all to compile on
> Lazarus and send you guys the outcome.
> Is there already a native Delphi XML parcer in Lazarus?
Yes. Use the DOM and xmlread or xmlwrite units.
Are you trying to port osFinancials to Lazarus ?
Michael.
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
