1
0
mirror of synced 2024-11-16 20:13:50 +00:00
x2xmldatabinding/Units/DelphiXMLDataBindingGenerator.pas

1656 lines
55 KiB
ObjectPascal
Raw Normal View History

2008-02-20 06:52:00 +00:00
unit DelphiXMLDataBindingGenerator;
interface
uses
Classes,
2008-04-14 19:28:57 +00:00
Contnrs,
2008-02-20 06:52:00 +00:00
XMLSchema,
2008-03-09 20:36:27 +00:00
X2UtHashes,
DelphiXMLDataBindingResources,
2008-02-20 06:52:00 +00:00
XMLDataBindingGenerator,
XMLDataBindingHelpers;
2008-04-14 19:28:57 +00:00
2008-02-20 06:52:00 +00:00
type
2008-04-14 19:20:55 +00:00
TGetFileNameEvent = procedure(Sender: TObject; const SchemaName: String; var Path, FileName: String) of object;
2008-02-20 06:52:00 +00:00
2008-04-14 19:28:57 +00:00
TXMLSchemaList = class(TObjectList)
private
function GetItem(Index: Integer): TXMLDataBindingSchema;
procedure SetItem(Index: Integer; const Value: TXMLDataBindingSchema);
public
constructor Create;
2008-04-14 19:28:57 +00:00
property Items[Index: Integer]: TXMLDataBindingSchema read GetItem write SetItem; default;
end;
2008-02-20 06:52:00 +00:00
TDelphiXMLDataBindingGenerator = class(TXMLDataBindingGenerator)
private
2008-04-14 19:28:57 +00:00
FProcessedItems: TX2OIHash;
FUnitNames: TX2OSHash;
FOnGetFileName: TGetFileNameEvent;
2008-02-20 06:52:00 +00:00
protected
procedure GenerateDataBinding; override;
2008-04-14 19:28:57 +00:00
procedure GenerateOutputFile(ASchemaList: TXMLSchemaList; const ASourceFileName, AUnitName: String);
function GenerateUsesClause(ASchemaList: TXMLSchemaList): String;
2008-02-20 06:52:00 +00:00
2008-03-09 20:36:27 +00:00
function DelphiSafeName(const AName: String): String;
function TranslateItemName(AItem: TXMLDataBindingItem): String; override;
2008-02-20 06:52:00 +00:00
function DoGetFileName(const ASchemaName: String): String;
2008-03-09 20:36:27 +00:00
function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean;
2008-04-14 19:28:57 +00:00
function GetDataTypeName(AProperty: TXMLDataBindingProperty; AInterfaceName: Boolean): String;
2008-02-26 21:53:11 +00:00
function TranslateDataType(ADataType: IXMLTypeDef): String;
function CreateNewGUID: String;
2008-02-26 21:53:11 +00:00
2008-04-14 19:28:57 +00:00
procedure WriteUnitHeader(AStream: TStreamHelper; const ASourceFileName, AFileName: String);
procedure WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
procedure WriteEnumerationConversions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
procedure WriteImplementationUses(AStream: TStreamHelper; ASchemaList: TXMLSchemaList);
procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem);
2008-04-14 19:28:57 +00:00
procedure WriteAfterConstruction(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
function WriteInlineCollectionFields(AStream: TStreamHelper; AItem: TXMLDataBindingInterface): Boolean;
2008-03-09 20:36:27 +00:00
procedure WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection);
procedure WriteSchemaInterface(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
procedure WriteSchemaInterfaceProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
2008-04-14 19:28:57 +00:00
function WriteSchemaInterfaceCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection): Boolean;
function WriteSchemaInterfaceProperty(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; AProperty: TXMLDataBindingProperty; ASection: TDelphiXMLSection; AMember: TDelphiXMLMember; ANewLine: Boolean): Boolean;
2008-03-09 20:36:27 +00:00
procedure WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection);
procedure WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration);
procedure WriteValidate(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
2008-04-14 19:28:57 +00:00
function GetDelphiNodeType(AProperty: TXMLDataBindingProperty): TDelphiNodeType;
function GetDelphiElementType(AProperty: TXMLDataBindingProperty): TDelphiElementType;
function DataTypeConversion(const ADestination, ASource: String; ADataType: IXMLTypeDef; AAccessor: TDelphiAccessor; ANodeType: TDelphiNodeType; const ATargetNamespace: string; const ALinesBefore: String = ''): String;
function XMLToNativeDataType(const ADestination, ASource: String; ADataType: IXMLTypeDef; ANodeType: TDelphiNodeType; const ATargetNamespace: string; const ALinesBefore: String = ''): String;
function NativeDataTypeToXML(const ADestination, ASource: String; ADataType: IXMLTypeDef; ANodeType: TDelphiNodeType; const ATargetNamespace: string; const ALinesBefore: String = ''): String;
2008-03-09 20:36:27 +00:00
property ProcessedItems: TX2OIHash read FProcessedItems;
2008-04-14 19:28:57 +00:00
property UnitNames: TX2OSHash read FUnitNames;
2008-02-20 06:52:00 +00:00
public
property OnGetFileName: TGetFileNameEvent read FOnGetFileName write FOnGetFileName;
end;
2008-04-14 19:28:57 +00:00
2008-02-20 06:52:00 +00:00
implementation
uses
SysUtils,
X2UtNamedFormat;
2008-02-20 06:52:00 +00:00
2008-03-09 20:36:27 +00:00
2008-02-20 06:52:00 +00:00
{ TDelphiXMLDataBindingGenerator }
procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding;
2008-04-14 19:28:57 +00:00
var
schemaList: TXMLSchemaList;
schemaIndex: Integer;
schema: TXMLDataBindingSchema;
unitName: String;
2008-02-20 06:52:00 +00:00
begin
schemaList := TXMLSchemaList.Create;
2008-04-14 19:28:57 +00:00
try
case OutputType of
otSingle:
begin
for schemaIndex := 0 to Pred(SchemaCount) do
schemaList.Add(Schemas[schemaIndex]);
unitName := DoGetFileName(Schemas[0].SchemaName);
GenerateOutputFile(schemaList, SourceFileName, unitName);
end;
otMultiple:
begin
FUnitNames := TX2OSHash.Create;
2008-04-14 19:28:57 +00:00
try
for schemaIndex := 0 to Pred(SchemaCount) do
begin
schema := Schemas[schemaIndex];
FUnitNames[schema] := DoGetFileName(schema.SchemaName);
end;
for schemaIndex := 0 to Pred(SchemaCount) do
begin
schema := Schemas[schemaIndex];
schemaList.Clear;
2008-04-14 19:28:57 +00:00
schemaList.Add(schema);
unitName := FUnitNames[schema];
GenerateOutputFile(schemaList, schema.SourceFileName, unitName);
end;
finally
FreeAndNil(FUnitNames);
end;
end;
end;
finally
FreeAndNil(schemaList);
2008-02-20 06:52:00 +00:00
end;
end;
2008-04-14 19:28:57 +00:00
procedure TDelphiXMLDataBindingGenerator.GenerateOutputFile(ASchemaList: TXMLSchemaList; const ASourceFileName, AUnitName: String);
2008-02-20 06:52:00 +00:00
var
2008-04-14 19:28:57 +00:00
unitStream: TStreamHelper;
usesClause: String;
2008-02-20 06:52:00 +00:00
begin
2008-04-14 19:28:57 +00:00
usesClause := '';
if OutputType = otMultiple then
usesClause := GenerateUsesClause(ASchemaList);
unitStream := TStreamHelper.Create(TFileStream.Create(AUnitName, fmCreate), soOwned);
2008-02-20 06:52:00 +00:00
try
2008-04-14 19:28:57 +00:00
WriteUnitHeader(unitStream, ASourceFileName, AUnitName);
2008-04-14 19:28:57 +00:00
unitStream.WriteNamedFmt(UnitInterface,
['UsesClause', usesClause]);
WriteSection(unitStream, dxsForward, ASchemaList);
2008-03-09 20:36:27 +00:00
FProcessedItems := TX2OIHash.Create;
2008-03-09 20:36:27 +00:00
try
FProcessedItems.Clear;
2008-04-14 19:28:57 +00:00
WriteSection(unitStream, dxsInterface, ASchemaList);
FProcessedItems.Clear;
2008-04-14 19:28:57 +00:00
WriteSection(unitStream, dxsClass, ASchemaList);
2008-03-09 20:36:27 +00:00
finally
FreeAndNil(FProcessedItems);
2008-02-20 06:52:00 +00:00
end;
2008-04-14 19:28:57 +00:00
WriteDocumentFunctions(unitStream, dxsInterface, ASchemaList);
WriteEnumerationConversions(unitStream, dxsInterface, ASchemaList);
2008-02-26 21:53:11 +00:00
unitStream.Write(UnitImplementation);
WriteImplementationUses(unitStream, ASchemaList);
2008-04-14 19:28:57 +00:00
WriteDocumentFunctions(unitStream, dxsImplementation, ASchemaList);
WriteEnumerationConversions(unitStream, dxsImplementation, ASchemaList);
2008-04-14 19:28:57 +00:00
WriteSection(unitStream, dxsImplementation, ASchemaList);
2008-02-20 06:52:00 +00:00
unitStream.Write(unitFooter);
2008-02-20 06:52:00 +00:00
finally
FreeAndNil(unitStream);
end;
end;
2008-04-14 19:28:57 +00:00
function TDelphiXMLDataBindingGenerator.GenerateUsesClause(ASchemaList: TXMLSchemaList): String;
var
includedSchemas: TObjectList;
procedure AddSchema(ASchema: TXMLDataBindingSchema);
begin
if Assigned(ASchema) and
(includedSchemas.IndexOf(ASchema) = -1) and
(ASchemaList.IndexOf(ASchema) = -1) then
includedSchemas.Add(ASchema);
end;
var
schemaIndex: Integer;
schema: TXMLDataBindingSchema;
itemIndex: Integer;
interfaceItem: TXMLDataBindingInterface;
propertyIndex: Integer;
propertyItem: TXMLDataBindingProperty;
includeIndex: Integer;
2008-02-20 06:52:00 +00:00
begin
2008-04-14 19:28:57 +00:00
Result := '';
includedSchemas := TObjectList.Create(False);
try
{ Determine which items are used }
for schemaIndex := 0 to Pred(ASchemaList.Count) do
begin
schema := ASchemaList[schemaIndex];
for itemIndex := 0 to Pred(schema.ItemCount) do
begin
if schema.Items[itemIndex].ItemType = itInterface then
begin
interfaceItem := TXMLDataBindingInterface(schema.Items[itemIndex]);
if Assigned(interfaceItem.CollectionItem) then
AddSchema(interfaceItem.CollectionItem.Schema);
for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do
begin
propertyItem := interfaceItem.Properties[propertyIndex];
if propertyItem.PropertyType = ptItem then
AddSchema(TXMLDataBindingItemProperty(propertyItem).Item.Schema);
end;
end;
end;
end;
{ Build uses clause }
if includedSchemas.Count > 0 then
begin
for includeIndex := 0 to Pred(includedSchemas.Count) do
begin
schema := TXMLDataBindingSchema(includedSchemas[includeIndex]);
Result := Result + ' ' + ChangeFileExt(ExtractFileName(FUnitNames[schema]), '') + ',' + CrLf;
end;
Result := Result + CrLf;
end;
finally
FreeAndNil(includedSchemas);
end;
2008-02-20 06:52:00 +00:00
end;
function TDelphiXMLDataBindingGenerator.GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean;
2008-03-09 20:36:27 +00:00
var
mappingIndex: Integer;
2008-04-14 19:28:57 +00:00
dataTypeName: String;
2008-03-09 20:36:27 +00:00
2008-02-26 21:53:11 +00:00
begin
2008-03-09 20:36:27 +00:00
Assert(not ADataType.IsComplex, 'Complex DataTypes not supported');
Assert(ADataType.Enumerations.Count = 0, 'Enumerations not supported');
Result := False;
2008-02-26 21:53:11 +00:00
2008-03-09 20:36:27 +00:00
if (ADataType.NamespaceURI = SXMLSchemaURI_1999) or
(ADataType.NamespaceURI = SXMLSchemaURI_2000_10) or
(ADataType.NamespaceURI = SXMLSchemaURI_2001) then
2008-02-26 21:53:11 +00:00
begin
2008-03-09 20:36:27 +00:00
dataTypeName := ADataType.Name;
for mappingIndex := Low(SimpleTypeMapping) to High(SimpleTypeMapping) do
if SimpleTypeMapping[mappingIndex].SchemaName = dataTypeName then
2008-03-09 20:36:27 +00:00
begin
ATypeMapping := SimpleTypeMapping[mappingIndex];
Result := True;
2008-03-09 20:36:27 +00:00
Break;
end;
end;
end;
2008-04-14 19:28:57 +00:00
function TDelphiXMLDataBindingGenerator.GetDataTypeName(AProperty: TXMLDataBindingProperty; AInterfaceName: Boolean): String;
var
item: TXMLDataBindingItem;
begin
case AProperty.PropertyType of
ptSimple:
if AProperty.IsRepeating then
begin
if AInterfaceName then
Result := ItemInterface
else
Result := ItemClass;
end else
Result := TranslateDataType(TXMLDataBindingSimpleProperty(AProperty).DataType);
2008-04-14 19:28:57 +00:00
ptItem:
begin
item := TXMLDataBindingItemProperty(AProperty).Item;
if (item.ItemType = itEnumeration) or (not AInterfaceName) then
Result := PrefixClass
else
Result := PrefixInterface;
Result := Result + item.TranslatedName;
end;
end;
end;
function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String;
var
typeMapping: TTypeMapping;
2008-04-14 19:28:57 +00:00
begin
Result := 'Variant';
if GetDataTypeMapping(ADataType, typeMapping) then
Result := typeMapping.DelphiName;
2008-03-09 20:36:27 +00:00
end;
function TDelphiXMLDataBindingGenerator.DelphiSafeName(const AName: String): String;
var
2008-04-18 14:36:17 +00:00
charIndex: Integer;
2008-03-09 20:36:27 +00:00
wordIndex: Integer;
begin
Result := AName;
2008-04-18 14:36:17 +00:00
{ Remove unsafe characters }
for charIndex := Length(Result) downto 1 do
2008-02-26 21:53:11 +00:00
begin
2008-04-18 14:36:17 +00:00
if not (Result[charIndex] in SafeChars) then
Delete(Result, charIndex, 1);
end;
if Length(Result) > 0 then
begin
{ Number as the first character is not allowed }
if Result[1] in ['0'..'9'] then
2008-03-09 20:36:27 +00:00
Result := '_' + Result;
2008-04-18 14:36:17 +00:00
{ Check for reserved words }
for wordIndex := Low(ReservedWords) to High(ReservedWords) do
begin
if SameText(Result, ReservedWords[wordIndex]) then
2008-04-18 14:36:17 +00:00
begin
Result := '_' + Result;
Break;
end;
2008-02-26 21:53:11 +00:00
end;
end;
end;
2008-03-09 20:36:27 +00:00
function TDelphiXMLDataBindingGenerator.TranslateItemName(AItem: TXMLDataBindingItem): String;
begin
Result := DelphiSafeName(inherited TranslateItemName(AItem));
case AItem.ItemType of
itEnumerationMember:
Result := DelphiSafeName(TXMLDataBindingEnumerationMember(AItem).Enumeration.TranslatedName) + '_' + Result;
2008-03-09 20:36:27 +00:00
end;
end;
2008-04-14 19:28:57 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const ASourceFileName, AFileName: String);
2008-02-20 06:52:00 +00:00
begin
AStream.WriteNamedFmt(UnitHeader,
2008-04-14 19:28:57 +00:00
['SourceFileName', ASourceFileName,
'UnitName', ChangeFileExt(ExtractFileName(AFileName), ''),
'DateTime', DateTimeToStr(Now)]);
2008-03-09 20:36:27 +00:00
end;
2008-04-14 19:28:57 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
2008-03-09 20:36:27 +00:00
var
schemaIndex: Integer;
schema: TXMLDataBindingSchema;
itemIndex: Integer;
begin
2008-04-14 19:28:57 +00:00
for schemaIndex := 0 to Pred(ASchemaList.Count) do
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
schema := ASchemaList[schemaIndex];
AStream.WriteLnNamedFmt(SectionComments[ASection],
['SchemaName', schema.SchemaName]);
2008-03-09 20:36:27 +00:00
for itemIndex := 0 to Pred(schema.ItemCount) do
WriteSchemaItem(AStream, schema.Items[itemIndex], ASection);
AStream.WriteLn;
end;
end;
2008-04-14 19:28:57 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
2008-03-09 20:36:27 +00:00
var
schemaIndex: Integer;
schema: TXMLDataBindingSchema;
itemIndex: Integer;
item: TXMLDataBindingItem;
interfaceItem: TXMLDataBindingInterface;
hasItem: Boolean;
nameSpace: String;
2008-03-09 20:36:27 +00:00
begin
hasItem := False;
nameSpace := '';
2008-03-09 20:36:27 +00:00
// #ToDo1 -oMvR: 6-4-2012: bij de Hyundai XSD's wordt hiermee TargetNamespace incorrect de laatste schema namespace
2008-04-14 19:28:57 +00:00
for schemaIndex := 0 to Pred(ASchemaList.Count) do
2008-02-20 06:52:00 +00:00
begin
2008-04-14 19:28:57 +00:00
schema := ASchemaList[schemaIndex];
if Length(schema.TargetNamespace) > 0 then
nameSpace := schema.TargetNamespace;
2008-03-09 20:36:27 +00:00
for itemIndex := 0 to Pred(schema.ItemCount) do
2008-02-20 06:52:00 +00:00
begin
2008-03-09 20:36:27 +00:00
item := schema.Items[itemIndex];
2008-02-20 06:52:00 +00:00
2008-03-09 20:36:27 +00:00
if item.ItemType = itInterface then
2008-02-20 06:52:00 +00:00
begin
2008-03-09 20:36:27 +00:00
interfaceItem := TXMLDataBindingInterface(item);
if item.DocumentElement then
2008-02-26 21:53:11 +00:00
begin
2008-03-09 20:36:27 +00:00
if not hasItem then
begin
if ASection = dxsInterface then
AStream.Write(' ');
2008-03-17 12:17:55 +00:00
2008-03-09 20:36:27 +00:00
AStream.WriteLn('{ Document functions }');
hasItem := True;
end;
with TNamedFormatStringList.Create do
2008-03-17 12:17:55 +00:00
try
case ASection of
dxsInterface: Add(DocumentFunctionsInterface);
dxsImplementation: Add(DocumentFunctionsImplementation);
2008-03-17 12:17:55 +00:00
end;
2008-03-09 20:36:27 +00:00
AStream.Write(Format(['SourceName', interfaceItem.Name,
'Name', interfaceItem.TranslatedName]));
2008-03-17 12:17:55 +00:00
finally
Free;
2008-03-17 12:17:55 +00:00
end;
2008-03-09 20:36:27 +00:00
AStream.WriteLn;
2008-02-26 21:53:11 +00:00
end;
end;
2008-02-20 06:52:00 +00:00
end;
end;
if (ASection = dxsInterface) and hasItem then
2008-03-09 20:36:27 +00:00
begin
AStream.WriteLn('const');
AStream.WriteLnFmt(' TargetNamespace = ''%s'';', [nameSpace]);
AStream.WriteLn;
AStream.WriteLn;
2008-03-09 20:36:27 +00:00
end;
end;
2008-04-14 19:28:57 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConversions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
2008-02-20 06:52:00 +00:00
var
2008-04-14 19:28:57 +00:00
enumerations: TObjectList;
schemaIndex: Integer;
schema: TXMLDataBindingSchema;
itemIndex: Integer;
item: TXMLDataBindingItem;
enumerationItem: TXMLDataBindingEnumeration;
sourceCode: TNamedFormatStringList;
indent: String;
2008-02-20 06:52:00 +00:00
begin
2008-04-14 19:28:57 +00:00
if not (ASection in [dxsInterface, dxsImplementation]) then
Exit;
enumerations := TObjectList.Create(False);
try
2008-04-14 19:28:57 +00:00
for schemaIndex := 0 to Pred(ASchemaList.Count) do
2008-02-20 06:52:00 +00:00
begin
2008-04-14 19:28:57 +00:00
schema := ASchemaList[schemaIndex];
2008-03-09 20:36:27 +00:00
for itemIndex := 0 to Pred(schema.ItemCount) do
2008-02-26 21:53:11 +00:00
begin
item := schema.Items[itemIndex];
2008-03-09 20:36:27 +00:00
if item.ItemType = itEnumeration then
enumerations.Add(item);
2008-02-26 21:53:11 +00:00
end;
2008-02-20 06:52:00 +00:00
end;
2008-04-14 19:28:57 +00:00
if enumerations.Count > 0 then
begin
2008-04-14 19:28:57 +00:00
if ASection = dxsInterface then
begin
{ Enumeration value arrays }
AStream.WriteLn('const');
for itemIndex := 0 to Pred(enumerations.Count) do
WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(enumerations[itemIndex]));
end;
{ Conversion helpers }
if ASection = dxsInterface then
AStream.Write(' ');
AStream.WriteLn('{ Enumeration conversion helpers }');
for itemIndex := Pred(enumerations.Count) downto 0 do
begin
enumerationItem := TXMLDataBindingEnumeration(enumerations[itemIndex]);
indent := '';
if ASection = dxsInterface then
indent := ' ';
sourceCode := TNamedFormatStringList.Create;
2008-04-14 19:28:57 +00:00
try
sourceCode.Add(indent + 'function StringTo%<ItemName>:s(const AValue: WideString): %<DataType>:s;');
if ASection = dxsImplementation then
begin
sourceCode.Add('var');
sourceCode.Add(' enumValue: %<DataType>:s;');
sourceCode.AddLn;
sourceCode.Add('begin');
sourceCode.Add(' Result := %<DataType>:s(-1);');
sourceCode.Add(' for enumValue := Low(%<DataType>:s) to High(%<DataType>:s) do');
sourceCode.Add(' if %<ItemName>:sValues[enumValue] = AValue then');
sourceCode.Add(' begin');
sourceCode.Add(' Result := enumValue;');
sourceCode.Add(' break;');
sourceCode.Add(' end;');
sourceCode.Add('end;');
sourceCode.AddLn;
end;
AStream.Write(sourceCode.Format(['ItemName', enumerationItem.TranslatedName,
'DataType', PrefixClass + enumerationItem.TranslatedName]));
finally
FreeAndNil(sourceCode);
end;
end;
2008-04-14 19:28:57 +00:00
AStream.WriteLn;
end;
finally
FreeAndNil(enumerations);
2008-02-20 06:52:00 +00:00
end;
2008-03-09 20:36:27 +00:00
end;
2008-02-20 06:52:00 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteImplementationUses(AStream: TStreamHelper; ASchemaList: TXMLSchemaList);
begin
{ In ye olde days this is where we checked if XMLDataBindingUtils was required. With the
introduction of the IXSDValidate, this is practically always the case. }
AStream.WriteLn('uses');
AStream.WriteLn(' SysUtils;');
AStream.WriteLn;
end;
2008-03-09 20:36:27 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem);
var
2008-04-14 19:28:57 +00:00
documentation: String;
lineIndex: Integer;
lines: TStringList;
2008-03-09 20:36:27 +00:00
begin
if not AItem.HasDocumentation then
exit;
lines := TStringList.Create;
2008-03-09 20:36:27 +00:00
try
2008-04-14 19:28:57 +00:00
documentation := AItem.Documentation;
{ Replace dangerous characters }
documentation := StringReplace(documentation, '{', '(', [rfReplaceAll]);
documentation := StringReplace(documentation, '}', ')', [rfReplaceAll]);
lines.Text := WrapText(documentation, 76);
2008-03-09 20:36:27 +00:00
AStream.WriteLn(' {');
for lineIndex := 0 to Pred(lines.Count) do
AStream.WriteLn(' ' + lines[lineIndex]);
AStream.WriteLn(' }');
finally
FreeAndNil(lines);
end;
end;
2008-02-26 21:53:11 +00:00
2008-02-20 06:52:00 +00:00
2008-03-09 20:36:27 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection);
begin
case AItem.ItemType of
itInterface: WriteSchemaInterface(AStream, TXMLDataBindingInterface(AItem), ASection);
itEnumeration: WriteSchemaEnumeration(AStream, TXMLDataBindingEnumeration(AItem), ASection);
2008-02-20 06:52:00 +00:00
end;
end;
2008-03-09 20:36:27 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterface(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
var
parent: String;
2008-02-20 06:52:00 +00:00
begin
2008-03-09 20:36:27 +00:00
if ASection in [dxsInterface, dxsClass] then
begin
{ Ensure the base item is completely defined first, Delphi doesn't allow
inheritance with just a forward declaration. }
if ProcessedItems.Exists(AItem) then
exit;
if Assigned(AItem.BaseItem) then
WriteSchemaInterface(AStream, AItem.BaseItem, ASection);
ProcessedItems[AItem] := 1;
end;
2008-02-26 21:53:11 +00:00
case ASection of
dxsForward:
AStream.WriteLnNamedFmt(InterfaceItemForward,
['Name', AItem.TranslatedName]);
2008-04-14 19:28:57 +00:00
2008-02-26 21:53:11 +00:00
dxsInterface:
begin
2008-03-09 20:36:27 +00:00
if Assigned(AItem.BaseItem) then
2008-03-17 12:17:55 +00:00
parent := PrefixInterface + AItem.BaseItem.TranslatedName
2008-04-14 19:28:57 +00:00
else if AItem.IsCollection then
parent := CollectionInterface
2008-03-09 20:36:27 +00:00
else
parent := ItemInterface;
2008-04-14 19:28:57 +00:00
2008-03-09 20:36:27 +00:00
WriteDocumentation(AStream, AItem);
AStream.WriteLnNamedFmt(InterfaceItemInterface,
['Name', AItem.TranslatedName,
'ParentName', parent]);
AStream.WriteLn(' ' + CreateNewGUID);
2008-03-09 20:36:27 +00:00
WriteSchemaInterfaceProperties(AStream, AItem, ASection);
2008-02-26 21:53:11 +00:00
AStream.WriteLn(' end;');
AStream.WriteLn;
2008-02-26 21:53:11 +00:00
end;
2008-04-14 19:28:57 +00:00
2008-02-26 21:53:11 +00:00
dxsClass:
begin
2008-03-09 20:36:27 +00:00
if Assigned(AItem.BaseItem) then
2008-03-17 12:17:55 +00:00
parent := PrefixClass + AItem.BaseItem.TranslatedName
2008-04-14 19:28:57 +00:00
else if AItem.IsCollection then
parent := CollectionClass
2008-03-09 20:36:27 +00:00
else
parent := ItemClass;
2008-04-14 19:28:57 +00:00
if AItem.CanValidate then
parent := parent + ', ' + XSDValidateInterface;
AStream.WriteLnNamedFmt(InterfaceItemClass,
['Name', AItem.TranslatedName,
'ParentName', parent]);
2008-03-09 20:36:27 +00:00
WriteSchemaInterfaceProperties(AStream, AItem, ASection);
2008-02-26 21:53:11 +00:00
AStream.WriteLn(' end;');
AStream.WriteLn;
2008-02-26 21:53:11 +00:00
end;
2008-04-14 19:28:57 +00:00
2008-02-26 21:53:11 +00:00
dxsImplementation:
begin
2008-03-09 20:36:27 +00:00
WriteSchemaInterfaceProperties(AStream, AItem, ASection);
2008-02-26 21:53:11 +00:00
end;
end;
end;
2008-04-14 19:28:57 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteAfterConstruction(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
var
hasPrototype: Boolean;
2008-03-09 20:36:27 +00:00
procedure WritePrototype;
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
if not hasPrototype then
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
case ASection of
dxsClass:
begin
AStream.WriteLn(' public');
AStream.WriteLn(' procedure AfterConstruction; override;');
end;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
dxsImplementation:
begin
AStream.WriteLnFmt('procedure TXML%s.AfterConstruction;', [AItem.TranslatedName]);
AStream.WriteLn('begin');
2008-03-09 20:36:27 +00:00
end;
end;
2008-04-14 19:28:57 +00:00
hasPrototype := True;
2008-03-09 20:36:27 +00:00
end;
end;
2008-02-26 21:53:11 +00:00
var
2008-04-14 19:28:57 +00:00
itemProperty: TXMLDataBindingItemProperty;
propertyIndex: Integer;
propertyItem: TXMLDataBindingProperty;
2008-02-26 21:53:11 +00:00
begin
2008-04-14 19:28:57 +00:00
if not (ASection in [dxsClass, dxsImplementation]) then
2008-03-09 20:36:27 +00:00
Exit;
2008-02-26 21:53:11 +00:00
2008-04-14 19:28:57 +00:00
if (ASection = dxsClass) and
(not AItem.IsCollection) then
WriteInlineCollectionFields(AStream, AItem);
2008-02-26 21:53:11 +00:00
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
hasPrototype := False;
2008-04-14 19:28:57 +00:00
for propertyIndex := 0 to Pred(AItem.PropertyCount) do
2008-02-20 06:52:00 +00:00
begin
2008-04-14 19:28:57 +00:00
propertyItem := AItem.Properties[propertyIndex];
if (not AItem.IsCollection) and Assigned(propertyItem.Collection) then
2008-03-09 20:36:27 +00:00
begin
WritePrototype;
2008-03-12 06:31:09 +00:00
{ Inline collection }
if ASection = dxsImplementation then
2008-04-14 19:28:57 +00:00
begin
if propertyItem.PropertyType = ptItem then
begin
if propertyItem.HasTargetNamespace then
AStream.WriteLnNamedFmt(' RegisterChildNode(''%<ItemSourceName>:s'', %<ItemClass>:s, ''%<Namespace>:s'');',
['ItemSourceName', propertyItem.Name,
'ItemClass', GetDataTypeName(propertyItem, False),
'Namespace', propertyItem.TargetNamespace])
else
AStream.WriteLnNamedFmt(' RegisterChildNode(''%<ItemSourceName>:s'', %<ItemClass>:s);',
['ItemSourceName', propertyItem.Name,
'ItemClass', GetDataTypeName(propertyItem, False)]);
end;
AStream.WriteLnNamedFmt(' %<FieldName>:s := CreateCollection(%<CollectionClass>:s, %<ItemInterface>:s, ''%<ItemSourceName>:s'') as %<CollectionInterface>:s;',
['FieldName', PrefixField + propertyItem.TranslatedName,
'CollectionClass', PrefixClass + propertyItem.Collection.TranslatedName,
'CollectionInterface', PrefixInterface + propertyItem.Collection.TranslatedName,
'ItemInterface', GetDataTypeName(propertyItem, True),
'ItemSourceName', propertyItem.Name]);
end;
end;
if propertyItem.PropertyType = ptItem then
begin
itemProperty := TXMLDataBindingItemProperty(propertyItem);
if (not AItem.IsCollection) or
(propertyItem <> AItem.CollectionItem) then
2008-03-09 20:36:27 +00:00
begin
{ Item property }
if Assigned(itemProperty.Item) and
(itemProperty.Item.ItemType = itInterface) then
begin
case ASection of
dxsClass:
2008-04-14 19:28:57 +00:00
WritePrototype;
dxsImplementation:
begin
WritePrototype;
if propertyItem.HasTargetNamespace then
AStream.WriteLnNamedFmt(' RegisterChildNode(''%<SourceName>:s'', TXML%<Name>:s, ''%<Namespace>:s'');',
['SourceName', propertyItem.Name,
'Name', itemProperty.Item.TranslatedName,
'Namespace', propertyItem.TargetNamespace])
else
AStream.WriteLnNamedFmt(' RegisterChildNode(''%<SourceName>:s'', TXML%<Name>:s);',
['SourceName', propertyItem.Name,
'Name', itemProperty.Item.TranslatedName]);
end;
end;
2008-04-14 19:28:57 +00:00
end;
end;
end;
end;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
if AItem.IsCollection then
begin
WritePrototype;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
if ASection = dxsImplementation then
begin
WritePrototype;
if AItem.CollectionItem.HasTargetNamespace then
AStream.WriteLnNamedFmt(' RegisterChildNode(''%<SourceName>:s'', %<DataClass>:s, ''%<Namespace>:s'');',
['SourceName', AItem.CollectionItem.Name,
'DataClass', GetDataTypeName(AItem.CollectionItem, False),
'Namespace', AItem.CollectionItem.TargetNamespace])
else
AStream.WriteLnNamedFmt(' RegisterChildNode(''%<SourceName>:s'', %<DataClass>:s);',
['SourceName', AItem.CollectionItem.Name,
'DataClass', GetDataTypeName(AItem.CollectionItem, False)]);
2008-04-14 19:28:57 +00:00
AStream.WriteLn;
AStream.WriteLnFmt(' ItemTag := ''%s'';', [AItem.CollectionItem.Name]);
AStream.WriteLnFmt(' ItemInterface := %s;', [GetDataTypeName(AItem.CollectionItem, True)]);
AStream.WriteLn;
end;
end;
2008-04-14 19:28:57 +00:00
if hasPrototype and (ASection = dxsImplementation) then
begin
AStream.WriteLn(' inherited;');
AStream.WriteLn('end;');
AStream.WriteLn;
end;
end;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
function TDelphiXMLDataBindingGenerator.WriteInlineCollectionFields(AStream: TStreamHelper; AItem: TXMLDataBindingInterface): Boolean;
var
propertyIndex: Integer;
collectionProperty: TXMLDataBindingProperty;
2008-03-17 12:17:55 +00:00
2008-04-14 19:28:57 +00:00
begin
Result := False;
2008-03-17 12:17:55 +00:00
2008-04-14 19:28:57 +00:00
for propertyIndex := 0 to Pred(AItem.PropertyCount) do
if AItem.Properties[propertyIndex].IsRepeating then
begin
collectionProperty := AItem.Properties[propertyIndex];
2008-03-17 12:17:55 +00:00
2008-04-14 19:28:57 +00:00
if Assigned(collectionProperty.Collection) then
begin
if not Result then
begin
AStream.WriteLn(' private');
Result := True;
2008-03-09 20:36:27 +00:00
end;
2008-04-14 19:28:57 +00:00
AStream.WriteLnNamedFmt(' %<PropertyName>:s: %<DataInterface>:s;',
['PropertyName', PrefixField + collectionProperty.TranslatedName,
'DataInterface', PrefixInterface + collectionProperty.Collection.TranslatedName]);
2008-03-09 20:36:27 +00:00
end;
end;
end;
2008-04-14 19:28:57 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
var
propertyIndex: Integer;
itemProperty: TXMLDataBindingProperty;
hasMembers: Boolean;
firstMember: Boolean;
member: TDelphiXMLMember;
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
if ASection = dxsForward then
2008-03-17 12:17:55 +00:00
Exit;
2008-04-14 19:28:57 +00:00
if ASection in [dxsClass, dxsImplementation] then
WriteAfterConstruction(AStream, AItem, ASection);
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
if ASection = dxsClass then
AStream.WriteLn(' protected');
2008-03-09 20:36:27 +00:00
WriteValidate(AStream, AItem, ASection);
2008-04-14 19:28:57 +00:00
hasMembers := WriteSchemaInterfaceCollectionProperties(AStream, AItem, ASection);
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do
begin
firstMember := True;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
for propertyIndex := 0 to Pred(AItem.PropertyCount) do
begin
itemProperty := AItem.Properties[propertyIndex];
if WriteSchemaInterfaceProperty(AStream, AItem, itemProperty, ASection, member,
hasMembers and firstMember and (ASection in [dxsInterface, dxsClass])) then
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
firstMember := False;
hasMembers := True;
2008-03-09 20:36:27 +00:00
end;
2008-04-14 19:28:57 +00:00
end;
2008-02-26 21:53:11 +00:00
end;
2008-03-09 20:36:27 +00:00
end;
2008-02-26 21:53:11 +00:00
2008-04-14 19:28:57 +00:00
function TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection): Boolean;
var
2008-04-14 19:28:57 +00:00
dataIntfName: String;
dataTypeName: String;
dataClassName: String;
collectionItem: TXMLDataBindingItem;
2008-03-17 12:17:55 +00:00
sourceCode: TNamedFormatStringList;
typeDef: IXMLTypeDef;
typeMapping: TTypeMapping;
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
Result := False;
if not AItem.IsCollection then
Exit;
2008-03-09 20:36:27 +00:00
case AItem.CollectionItem.PropertyType of
ptSimple:
begin
dataTypeName := TranslateDataType(TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType);
dataClassName := ItemClass;
dataIntfName := ItemInterface;
end;
ptItem:
begin
2008-04-14 19:28:57 +00:00
collectionItem := TXMLDataBindingItemProperty(AItem.CollectionItem).Item;
if collectionItem.ItemType = itEnumeration then
begin
// #ToDo1 (MvR) 17-3-2008: DataType and conversions for enumerations
dataTypeName := PrefixInterface + collectionItem.TranslatedName;
dataClassName := PrefixClass + collectionItem.TranslatedName;
dataIntfName := dataTypeName;
end else
begin
dataTypeName := PrefixInterface + collectionItem.TranslatedName;
dataClassName := PrefixClass + collectionItem.TranslatedName;
dataIntfName := dataTypeName;
end;
end;
end;
2008-03-09 20:36:27 +00:00
sourceCode := TNamedFormatStringList.Create;
2008-03-17 12:17:55 +00:00
try
case ASection of
dxsInterface,
dxsClass:
begin
sourceCode.Add(' function Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
case AItem.CollectionItem.PropertyType of
ptSimple:
begin
sourceCode.Add(' function Add(%<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
sourceCode.Add(' function Insert(Index: Integer; %<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
end;
ptItem:
begin
sourceCode.Add(' function Add: %<DataType>:s;');
sourceCode.Add(' function Insert(Index: Integer): %<DataType>:s;');
end;
end;
2008-03-17 12:17:55 +00:00
end;
2008-04-14 19:28:57 +00:00
2008-03-17 12:17:55 +00:00
dxsImplementation:
begin
case AItem.CollectionItem.PropertyType of
ptSimple:
begin
typeDef := TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType;
sourceCode.Add('function TXML%<Name>:s.Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
if GetDataTypeMapping(typeDef, typeMapping) and (typeMapping.Conversion = tcString) then
sourceCode.Add(XMLToNativeDataType('Result', 'List[Index].Text', typeDef, dntCustom, AItem.CollectionItem.TargetNamespace))
else
sourceCode.Add(XMLToNativeDataType('Result', 'List[Index].NodeValue', typeDef, dntCustom, AItem.CollectionItem.TargetNamespace));
sourceCode.AddLn;
sourceCode.Add('function TXML%<Name>:s.Add(%<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
2008-04-14 19:28:57 +00:00
sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%<ItemName>:s', typeDef, dntCustom,
' Result := AddItem(-1);'));
sourceCode.AddLn;
sourceCode.Add('function TXML%<Name>:s.Insert(Index: Integer; %<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
2008-04-14 19:28:57 +00:00
sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%<ItemName>:s', typeDef, dntCustom,
' Result := AddItem(Index);'));
sourceCode.AddLn;
end;
2008-03-17 12:17:55 +00:00
ptItem:
begin
sourceCode.Add('function TXML%<Name>:s.Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
sourceCode.Add('begin');
sourceCode.Add(' Result := (List[Index] as %<DataType>:s);');
sourceCode.Add('end;');
sourceCode.AddLn;
sourceCode.Add('function TXML%<Name>:s.Add: %<DataType>:s;');
sourceCode.Add('begin');
sourceCode.Add(' Result := (AddItem(-1) as %<DataType>:s);');
sourceCode.Add('end;');
sourceCode.AddLn;
sourceCode.Add('function TXML%<Name>:s.Insert(Index: Integer): %<DataType>:s;');
sourceCode.Add('begin');
sourceCode.Add(' Result := (AddItem(Index) as %<DataType>:s);');
sourceCode.Add('end;');
sourceCode.AddLn;
end;
end;
2008-03-17 12:17:55 +00:00
end;
end;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
if ASection = dxsInterface then
begin
sourceCode.AddLn;
sourceCode.Add(' property %<ItemName>:s[Index: Integer]: %<DataType>:s read Get_%<ItemName>:s; default;');
end;
Result := (sourceCode.Count > 0);
if Result then
AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName,
'ItemName', AItem.CollectionItem.TranslatedName,
'ItemSourceName', AItem.CollectionItem.Name,
'DataType', dataTypeName,
'DataClass', dataClassName,
'DataInterface', dataIntfName]));
finally
FreeAndNil(sourceCode);
end;
end;
function TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceProperty(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; AProperty: TXMLDataBindingProperty; ASection: TDelphiXMLSection; AMember: TDelphiXMLMember; ANewLine: Boolean): Boolean;
procedure WriteNewLine;
begin
if ANewLine then
AStream.WriteLn;
end;
var
sourceCode: TNamedFormatStringList;
writeOptional: Boolean;
2008-04-21 15:24:33 +00:00
writeNil: Boolean;
2008-04-14 19:28:57 +00:00
writeTextProp: Boolean;
propertyItem: TXMLDataBindingItem;
dataTypeName: String;
value: String;
propertyItemName: String;
fieldName: String;
writeStream: Boolean;
typeMapping: TTypeMapping;
2008-04-14 19:28:57 +00:00
begin
Result := False;
if AProperty = AItem.CollectionItem then
Exit;
2008-04-21 15:24:33 +00:00
2008-04-14 19:28:57 +00:00
{ If the property has a collection, it's Count property will be enough
to check if an item is present, no need to write a HasX method. }
2008-04-21 15:24:33 +00:00
writeOptional := False;
writeNil := AProperty.IsNillable;
2008-04-21 15:24:33 +00:00
if AMember in [dxmPropertyGet, dxmPropertyDeclaration] then
writeOptional := not Assigned(AProperty.Collection) and
AProperty.IsOptional;
2008-04-14 19:28:57 +00:00
writeStream := False;
if (AMember = dxmPropertyGet) and (AProperty.PropertyType = ptSimple) then
begin
if GetDataTypeMapping(TXMLDataBindingSimpleProperty(AProperty).DataType, typeMapping) then
writeStream := (typeMapping.Conversion = tcBase64);
end;
2008-04-14 19:28:57 +00:00
dataTypeName := '';
propertyItem := nil;
fieldName := '';
{ Get data type }
writeTextProp := False;
if Assigned(AProperty.Collection) then
begin
dataTypeName := PrefixInterface + AProperty.Collection.TranslatedName;
fieldName := PrefixField + AProperty.TranslatedName;
end else
begin
case AProperty.PropertyType of
ptSimple:
dataTypeName := TranslateDataType(TXMLDataBindingSimpleProperty(AProperty).DataType);
ptItem:
2008-03-17 12:17:55 +00:00
begin
2008-04-14 19:28:57 +00:00
propertyItem := TXMLDataBindingItemProperty(AProperty).Item;
if Assigned(propertyItem) then
begin
if propertyItem.ItemType = itEnumeration then
begin
dataTypeName := PrefixClass;
writeTextProp := True;
end else
dataTypeName := PrefixInterface;
dataTypeName := dataTypeName + propertyItem.TranslatedName;
end;
2008-03-17 12:17:55 +00:00
end;
2008-04-14 19:28:57 +00:00
end;
end;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
if Length(dataTypeName) = 0 then
Exit;
sourceCode := TNamedFormatStringList.Create;
2008-04-14 19:28:57 +00:00
try
case ASection of
dxsInterface,
2008-03-17 12:17:55 +00:00
dxsClass:
begin
2008-04-14 19:28:57 +00:00
{ Interface declaration }
case AMember of
dxmPropertyGet:
begin
WriteNewLine;
if writeOptional then
sourceCode.Add(PropertyIntfMethodGetOptional);
2008-04-21 15:24:33 +00:00
if writeNil then
sourceCode.Add(PropertyIntfMethodGetNil);
2008-04-14 19:28:57 +00:00
if writeTextProp then
sourceCode.Add(PropertyIntfMethodGetText);
if writeStream then
sourceCode.Add(PropertyIntfMethodStream);
2008-04-14 19:28:57 +00:00
sourceCode.Add(PropertyIntfMethodGet);
end;
dxmPropertySet:
if not AProperty.IsReadOnly then
begin
WriteNewLine;
if writeNil then
sourceCode.Add(PropertyIntfMethodSetNil);
2008-04-14 19:28:57 +00:00
if writeTextProp then
sourceCode.Add(PropertyIntfMethodSetText);
sourceCode.Add(PropertyIntfMethodSet);
end;
dxmPropertyDeclaration:
if ASection = dxsInterface then
begin
WriteNewLine;
if writeOptional then
sourceCode.Add(PropertyInterfaceOptional);
if AProperty.IsReadOnly then
begin
if writeNil then
sourceCode.Add(PropertyInterfaceNilReadOnly);
2008-04-14 19:28:57 +00:00
if writeTextProp then
sourceCode.Add(PropertyInterfaceTextReadOnly);
sourceCode.Add(PropertyInterfaceReadOnly);
end else
begin
if writeNil then
sourceCode.Add(PropertyInterfaceNil);
2008-04-14 19:28:57 +00:00
if writeTextProp then
sourceCode.Add(PropertyInterfaceText);
sourceCode.Add(PropertyInterface);
end;
end;
end;
end;
dxsImplementation:
begin
{ Implementation }
case AMember of
dxmPropertyGet:
begin
WriteNewLine;
2008-04-21 15:24:33 +00:00
2008-04-14 19:28:57 +00:00
if writeOptional then
if AProperty.IsAttribute then
sourceCode.Add(PropertyImplMethodGetOptionalAttr)
else
sourceCode.Add(PropertyImplMethodGetOptional[GetDelphiElementType(AProperty)]);
2008-04-14 19:28:57 +00:00
2008-04-21 15:24:33 +00:00
if writeNil then
sourceCode.Add(PropertyImplMethodGetNil[GetDelphiElementType(AProperty)]);
2008-04-21 15:24:33 +00:00
2008-04-14 19:28:57 +00:00
if writeTextProp then
if AProperty.IsAttribute then
sourceCode.Add(PropertyImplMethodGetTextAttr)
else
sourceCode.Add(PropertyImplMethodGetText[GetDelphiElementType(AProperty)]);
2008-04-14 19:28:57 +00:00
if writeStream then
sourceCode.Add(PropertyImplMethodStream[GetDelphiElementType(AProperty)]);
2008-04-14 19:28:57 +00:00
sourceCode.Add('function TXML%<Name>:s.Get%<PropertyName>:s: %<DataType>:s;');
case AProperty.PropertyType of
ptSimple:
if Assigned(AProperty.Collection) then
begin
sourceCode.Add('begin');
sourceCode.Add(' Result := %<FieldName>:s;');
sourceCode.Add('end;');
end else
sourceCode.Add(XMLToNativeDataType('Result',
'%<PropertySourceName>:s',
TXMLDataBindingSimpleProperty(AProperty).DataType,
GetDelphiNodeType(AProperty),
AProperty.TargetNamespace));
2008-04-14 19:28:57 +00:00
ptItem:
begin
if Assigned(AProperty.Collection) then
begin
sourceCode.Add('begin');
sourceCode.Add(' Result := %<FieldName>:s;');
sourceCode.Add('end;');
end else
begin
if Assigned(propertyItem) then
begin
case propertyItem.ItemType of
itInterface:
begin
sourceCode.Add('begin');
if AProperty.HasTargetNamespace then
sourceCode.Add(' Result := (ChildNodes.FindNode(''%<PropertySourceName>:s'', ''%<Namespace>:s'') as IXML%<PropertyItemName>:s);')
else
sourceCode.Add(' Result := (ChildNodes[''%<PropertySourceName>:s''] as IXML%<PropertyItemName>:s);');
2008-04-14 19:28:57 +00:00
sourceCode.Add('end;');
end;
itEnumeration:
begin
sourceCode.Add('begin');
sourceCode.Add(' Result := StringTo%<PropertyItemName>:s(Get%<PropertyName>:sText);');
sourceCode.Add('end;');
end;
end;
end;
end;
end;
end;
sourceCode.AddLn;
end;
dxmPropertySet:
if not AProperty.IsReadOnly then
begin
WriteNewLine;
if writeNil then
sourceCode.Add(PropertyImplMethodSetNil[GetDelphiElementType(AProperty)]);
2008-04-14 19:28:57 +00:00
if writeTextProp then
if AProperty.IsAttribute then
sourceCode.Add(PropertyImplMethodSetTextAttr)
else
sourceCode.Add(PropertyImplMethodSetText[GetDelphiElementType(AProperty)]);
2008-04-14 19:28:57 +00:00
sourceCode.Add('procedure TXML%<Name>:s.Set%<PropertyName>:s(const Value: %<DataType>:s);');
value := '%<PropertySourceName>:s';
if Assigned(propertyItem) and (propertyItem.ItemType = itEnumeration) then
begin
sourceCode.Add(NativeDataTypeToXML(value, '%<PropertyItemName>:sValues[Value]', nil,
GetDelphiNodeType(AProperty),
AProperty.TargetNamespace));
2008-04-14 19:28:57 +00:00
end else
begin
if AProperty.PropertyType <> ptSimple then
raise Exception.Create('Setter must be a simple type');
sourceCode.Add(NativeDataTypeToXML(value, 'Value',
TXMLDataBindingSimpleProperty(AProperty).DataType,
GetDelphiNodeType(AProperty),
AProperty.TargetNamespace));
2008-04-14 19:28:57 +00:00
end;
sourceCode.AddLn;
end;
end;
2008-03-17 12:17:55 +00:00
end;
end;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
propertyItemName := '';
if Assigned(propertyItem) then
propertyItemName := propertyItem.TranslatedName;
Result := (sourceCode.Count > 0);
if Result then
AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName,
'PropertySourceName', AProperty.Name,
'PropertyName', AProperty.TranslatedName,
'PropertyItemName', propertyItemName,
'DataType', dataTypeName,
'FieldName', fieldName,
'Namespace', AProperty.TargetNamespace]));
2008-03-17 12:17:55 +00:00
finally
FreeAndNil(sourceCode);
2008-03-09 20:36:27 +00:00
end;
2008-02-26 21:53:11 +00:00
end;
2008-03-09 20:36:27 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection);
2008-02-26 21:53:11 +00:00
var
2008-03-09 20:36:27 +00:00
memberIndex: Integer;
2008-02-26 21:53:11 +00:00
enumStart: String;
lineIndent: String;
begin
2008-03-09 20:36:27 +00:00
if (ASection <> dxsForward) or (AItem.MemberCount = 0) then
2008-02-26 21:53:11 +00:00
exit;
enumStart := NamedFormat(' TXML%<Name>:s = (',
['Name', AItem.TranslatedName]);
2008-02-26 21:53:11 +00:00
AStream.Write(enumStart);
lineIndent := StringOfChar(' ', Length(enumStart));
2008-03-09 20:36:27 +00:00
for memberIndex := 0 to Pred(AItem.MemberCount) do
2008-02-26 21:53:11 +00:00
begin
2008-03-09 20:36:27 +00:00
if memberIndex > 0 then
2008-02-26 21:53:11 +00:00
AStream.Write(lineIndent);
2008-03-09 20:36:27 +00:00
AStream.Write(AItem.Members[memberIndex].TranslatedName);
2008-02-26 21:53:11 +00:00
2008-03-09 20:36:27 +00:00
if memberIndex < Pred(AItem.MemberCount) then
2008-02-26 21:53:11 +00:00
AStream.WriteLn(',')
else
AStream.WriteLn(');');
end;
end;
2008-03-09 20:36:27 +00:00
procedure TDelphiXMLDataBindingGenerator.WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration);
2008-02-26 21:53:11 +00:00
var
2008-03-09 20:36:27 +00:00
memberIndex: Integer;
enumStart: String;
lineIndent: String;
2008-02-26 21:53:11 +00:00
begin
2008-03-09 20:36:27 +00:00
if (AItem.MemberCount = 0) then
exit;
2008-02-26 21:53:11 +00:00
enumStart := NamedFormat(' %<Name>:sValues: ', ['Name', AItem.TranslatedName]);
AStream.WriteLn(enumStart + NamedFormat('array[TXML%<Name>:s] of WideString =',
['Name', AItem.TranslatedName]));
2008-03-09 20:36:27 +00:00
lineIndent := StringOfChar(' ', Length(enumStart));
2008-02-26 21:53:11 +00:00
2008-03-09 20:36:27 +00:00
AStream.WriteLn(lineIndent + '(');
2008-02-26 21:53:11 +00:00
2008-03-09 20:36:27 +00:00
for memberIndex := 0 to Pred(AItem.MemberCount) do
2008-02-26 21:53:11 +00:00
begin
AStream.Write(NamedFormat('%<Indent>:s ''%<Name>:s''',
['Indent', lineIndent,
'Name', AItem.Members[memberIndex].Name]));
2008-02-26 21:53:11 +00:00
2008-03-09 20:36:27 +00:00
if memberIndex < Pred(AItem.MemberCount) then
AStream.WriteLn(',')
else
AStream.WriteLn;
2008-02-20 06:52:00 +00:00
end;
2008-03-09 20:36:27 +00:00
AStream.WriteLn(lineIndent + ');');
AStream.WriteLn;
2008-02-20 06:52:00 +00:00
end;
procedure TDelphiXMLDataBindingGenerator.WriteValidate(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
var
propertyIndex: Integer;
propertyItem: TXMLDataBindingProperty;
elementSortOrder: string;
elementSortCount: Integer;
elementRequired: string;
elementRequiredCount: Integer;
attributeRequired: string;
attributeRequiredCount: Integer;
begin
if AItem.DocumentElement then
begin
case ASection of
dxsInterface,
dxsClass:
AStream.WriteLn(XSDValidateDocumentMethodInterface);
dxsImplementation:
AStream.WriteLnNamedFmt(XSDValidateDocumentMethodImplementation,
['Name', AItem.TranslatedName]);
end;
end;
if AItem.CanValidate then
begin
case ASection of
dxsInterface,
dxsClass:
begin
AStream.WriteLn(XSDValidateMethodInterface);
AStream.WriteLn('');
end;
dxsImplementation:
begin
AStream.WriteLnNamedFmt(XSDValidateMethodImplementationBegin,
['Name', AItem.TranslatedName]);
elementSortOrder := '';
elementSortCount := 0;
elementRequired := '';
elementRequiredCount := 0;
attributeRequired := '';
attributeRequiredCount := 0;
for propertyIndex := 0 to Pred(AItem.PropertyCount) do
begin
propertyItem := AItem.Properties[propertyIndex];
if propertyItem.IsAttribute then
begin
if not propertyItem.IsOptional then
begin
attributeRequired := attributeRequired + ', ' + QuotedStr(propertyItem.Name);
Inc(attributeRequiredCount);
end;
end else if not propertyItem.IsNodeValue then
begin
elementSortOrder := elementSortOrder + ', ' + QuotedStr(propertyItem.Name);
Inc(elementSortCount);
if (not propertyItem.IsOptional) and (not propertyItem.IsRepeating) then
begin
case propertyItem.PropertyType of
ptSimple:
begin
elementRequired := elementRequired + ', ' + QuotedStr(propertyItem.Name);
Inc(elementRequiredCount);
end;
ptItem:
{ For Item properties, we call our getter property. This ensures the child element exists,
but also that it is created using our binding implementation. Otherwise there will be no
IXSDValidate interface to call on the newly created node. }
AStream.WriteLnNamedFmt(XSDValidateMethodImplementationComplex,
['Name', propertyItem.TranslatedName]);
end;
end;
end;
end;
if elementRequiredCount > 0 then
begin
Delete(elementRequired, 1, 2);
AStream.WriteLnNamedFmt(XSDValidateMethodImplementationRequired,
['RequiredElements', elementRequired]);
end;
if attributeRequiredCount > 0 then
begin
Delete(attributeRequired, 1, 2);
AStream.WriteLnNamedFmt(XSDValidateMethodImplementationAttrib,
['RequiredAttributes', attributeRequired]);
end;
if elementSortCount > 1 then
begin
Delete(elementSortOrder, 1, 2);
AStream.WriteLnNamedFmt(XSDValidateMethodImplementationSort,
['SortOrder', elementSortOrder]);
end;
AStream.WriteLn(XSDValidateMethodImplementationEnd);
end;
end;
end;
end;
2008-04-14 19:28:57 +00:00
function TDelphiXMLDataBindingGenerator.GetDelphiNodeType(AProperty: TXMLDataBindingProperty): TDelphiNodeType;
begin
if AProperty.IsAttribute then
Result := dntAttribute
else if AProperty.IsNodeValue then
Result := dntNodeValue
else if AProperty.HasTargetNamespace then
Result := dntElementNS
2008-04-14 19:28:57 +00:00
else
Result := dntElement;
end;
function TDelphiXMLDataBindingGenerator.GetDelphiElementType(AProperty: TXMLDataBindingProperty): TDelphiElementType;
begin
Result := GetDelphiNodeType(AProperty);
if Result <> dntElementNS then
Result := dntElement;
end;
function TDelphiXMLDataBindingGenerator.DataTypeConversion(const ADestination, ASource: String; ADataType: IXMLTypeDef;
AAccessor: TDelphiAccessor; ANodeType: TDelphiNodeType;
const ATargetNamespace: string; const ALinesBefore: String = ''): String;
var
typeMapping: TTypeMapping;
2008-04-14 19:28:57 +00:00
conversion: String;
begin
with TNamedFormatStringList.Create do
try
2008-04-14 19:28:57 +00:00
if not (Assigned(ADataType) and GetDataTypeMapping(ADataType, typeMapping)) then
typeMapping.Conversion := tcNone;
Add('begin');
if Length(ALinesBefore) > 0 then
Add(ALinesBefore);
2008-04-14 19:28:57 +00:00
conversion := TypeConversion[AAccessor, ANodeType, typeMapping.Conversion];
if Length(conversion) = 0 then
conversion := TypeConversionNone[AAccessor, ANodeType];
Add(conversion);
Add('end;');
2008-04-14 19:28:57 +00:00
// #ToDo1 -oMvR: 6-4-2012: Namespace
2008-04-14 19:28:57 +00:00
Result := Trim(Format(['Destination', ADestination,
'Source', ASource,
'Namespace', ATargetNamespace]));
finally
Free;
end;
end;
function TDelphiXMLDataBindingGenerator.XMLToNativeDataType(const ADestination, ASource: String; ADataType: IXMLTypeDef;
ANodeType: TDelphiNodeType; const ATargetNamespace: string;
const ALinesBefore: String): String;
begin
Result := DataTypeConversion(ADestination, ASource, ADataType, daGet, ANodeType, ATargetNamespace, ALinesBefore);
end;
function TDelphiXMLDataBindingGenerator.NativeDataTypeToXML(const ADestination, ASource: String; ADataType: IXMLTypeDef;
ANodeType: TDelphiNodeType; const ATargetNamespace: string;
const ALinesBefore: String): String;
begin
Result := DataTypeConversion(ADestination, ASource, ADataType, daSet, ANodeType, ATargetNamespace, ALinesBefore);
end;
function TDelphiXMLDataBindingGenerator.CreateNewGUID: String;
2008-02-26 21:53:11 +00:00
var
guid: TGUID;
begin
Result := '{ GUID generation failed }';
if CreateGUID(guid) = S_OK then
Result := '[''' + GUIDToString(guid) + ''']';
end;
2008-02-20 06:52:00 +00:00
function TDelphiXMLDataBindingGenerator.DoGetFileName(const ASchemaName: String): String;
2008-04-14 19:20:55 +00:00
var
path: String;
fileName: String;
2008-02-20 06:52:00 +00:00
begin
Result := OutputPath;
if OutputType = otMultiple then
begin
2008-04-14 19:20:55 +00:00
path := IncludeTrailingPathDelimiter(Result);
fileName := ASchemaName + '.pas';
2008-02-20 06:52:00 +00:00
if Assigned(FOnGetFileName) then
2008-04-14 19:20:55 +00:00
FOnGetFileName(Self, ASchemaName, path, fileName);
Result := IncludeTrailingPathDelimiter(path) + fileName;
2008-02-20 06:52:00 +00:00
end;
end;
2008-04-14 19:28:57 +00:00
{ TXMLSchemaList }
constructor TXMLSchemaList.Create;
2008-04-14 19:28:57 +00:00
begin
inherited Create(False);
end;
function TXMLSchemaList.GetItem(Index: Integer): TXMLDataBindingSchema;
begin
Result := TXMLDataBindingSchema(inherited GetItem(Index));
end;
procedure TXMLSchemaList.SetItem(Index: Integer; const Value: TXMLDataBindingSchema);
begin
inherited SetItem(Index, Value);
end;
2008-02-20 06:52:00 +00:00
end.
2008-03-09 20:36:27 +00:00