GikoXMLDoc.pas

   1 unit GikoXMLDoc;
   2
   3 {
   4         XMLIntf, XMLDoc \82 \82½\82è\82Ì\83N\83\8d\81[\83\93
   5         Delphi 6 Personal \97p
   6 }
   7 interface
   8
   9 //==================================================
  10 uses
  11 //==================================================
  12
  13         Classes, SysUtils, Windows,
  14         YofUtils;
  15
  16 //==================================================
  17 type
  18 //==================================================
  19
  20         // \82í\82¯\82í\82©\82ç\82¸\8dì\82Á\82Ä\82é\82©\82ç\83o\83O\82¾\82ç\82¯\82©\82à
  21         XMLDictionary = Record
  22                 Name : string;
  23                 Value : string;
  24         end;
  25
  26         IXMLNode = class
  27         private
  28                 FNodeName : string;
  29                 FCapacity : Integer;
  30                 FCount : Integer;
  31                 FAttributeCount : Integer;
  32                 FChildNodes : IXMLNode;
  33                 FNodes : array of IXMLNode;
  34                 FAttributes : array of XMLDictionary;
  35                 function GetAttribute( const Name : string ) : string;
  36                 function GetNode( Index : Integer ) : IXMLNode;
  37         public
  38                 constructor     Create;
  39                 destructor      Destroy; override;
  40
  41                 property NodeName : string read FNodeName write FNodeName;
  42                 property Attributes[ const Name : string ] : string read GetAttribute;
  43                 property Node[ Index : Integer ] : IXMLNode read GetNode; default;
  44                 property ChildNodes : IXMLNode read FChildNodes write FChildNodes;
  45                 property Count : Integer read FCount write FCount;
  46                 procedure Add( node : IXMLNode );
  47                 procedure AddAttribute( const Name : string; const Value : string );
  48         end;
  49
  50         IXMLDocument = class( IXMLNode )
  51         private
  52                 function GetDocumentElement() : IXMLNode;
  53         public
  54                 property DocumentElement : IXMLNode read GetDocumentElement;
  55         end;
  56
  57 function XMLCloseCheck(
  58         var p                           : PChar;
  59         const tail      : PChar;
  60         var node : IXMLNode;
  61         out tag : string;
  62         out closed : boolean // \8cÄ\82Ñ\8fo\82µ\82½\83\8b\81[\83`\83\93\82ª node \82ð\95Â\82¶\82é\82×\82«\82È\82ç true
  63 ) : boolean; // ch \82ð\82±\82Ì\83\8b\81[\83`\83\93\82ª\8f\88\97\9d\82µ\82½\82È\82ç true
  64
  65 function XMLReadNode(
  66         var p                           : PChar;
  67         const tail      : PChar;
  68         var node : IXMLNode
  69 ) : string; // node \88È\8aO\82Ì\83m\81[\83h\82ª\95Â\82¶\82ç\82ê\82½\8fê\8d\87\82Ì\83m\81[\83h\96¼
  70
  71 procedure LoadXMLDocument(
  72         const fileName : string;
  73     var doc : IXMLDocument
  74 );
  75
  76 //==================================================
  77 const
  78 //==================================================
  79         kXMLWhite : TSysCharSet = [#0..#$20];
  80         kXMLNodeNameStop : TSysCharSet = [#0..#$20, '/', '>'];
  81         kXMLAttributeNameStop : TSysCharSet = [#0..#$20, '=', '/', '>'];
  82         kXMLDQuote : TSysCharSet = ['"'];
  83         kXMLTagStart : TSysCharSet = ['<'];
  84         kXMLTagEnd : TSysCharSet = ['>'];
  85         kXMLKanji : TSysCharSet = [#$81..#$9f, #$E0..#$fc];
  86
  87 //==================================================
  88 implementation
  89 //==================================================
  90
  91 // Constructor
  92 constructor     IXMLNode.Create;
  93 begin
  94
  95         inherited;
  96
  97         FCapacity := 0;
  98         FCount := 0;
  99
 100 end;
 101
 102 // Destructor
 103 destructor      IXMLNode.Destroy;
 104 var
 105         i : Integer;
 106 begin
 107
 108         for i := FCount - 1 downto 0 do
 109                 FNodes[ i ].Free;
 110         FChildNodes.Free;
 111
 112         inherited;
 113
 114 end;
 115
 116 function IXMLNode.GetAttribute( const Name : string ) : string;
 117 var
 118         i : Integer;
 119 begin
 120
 121         i := 0;
 122         while i < FAttributeCount do
 123         begin
 124                 if Name = FAttributes[ i ].Name then
 125                 begin
 126                         Result := FAttributes[ i ].Value;
 127                         exit;
 128                 end;
 129
 130                 Inc( i );
 131         end;
 132
 133 end;
 134
 135 function IXMLNode.GetNode( Index : Integer ) : IXMLNode;
 136 begin
 137
 138         Result := FNodes[ Index ];
 139
 140 end;
 141
 142 procedure IXMLNode.Add( node : IXMLNode );
 143 begin
 144
 145         Inc( FCount );
 146         if FCount > FCapacity then begin
 147                 FCapacity := FCapacity + (FCapacity shr 2) + 1;
 148                 SetLength( FNodes, FCapacity );
 149         end;
 150
 151         FNodes[ FCount - 1 ] := node;
 152
 153 end;
 154
 155 procedure IXMLNode.AddAttribute(
 156         const Name : string;
 157         const Value : string
 158 );
 159 var
 160         index : Integer;
 161 begin
 162
 163         index := FAttributeCount;
 164         Inc( FAttributeCount );
 165         SetLength( FAttributes, FAttributeCount );
 166
 167         FAttributes[ index ].Name := Name;
 168         FAttributes[ index ].Value := Value;
 169
 170 end;
 171
 172 function IXMLDocument.GetDocumentElement() : IXMLNode;
 173 begin
 174
 175         Result := FChildNodes[ 0 ];
 176
 177 end;
 178
 179 {*!
 180 \brief  tok \82ð\92T\82·
 181 \param  p                       \92T\8dõ\8aJ\8en\88Ê\92u
 182 \param  tail    \8fI\97¹\88Ê\92u + 1
 183 \param  tok             \92T\82·\83L\83\83\83\89\83N\83^
 184 \return tok \82ª\8dÅ\8f\89\82É\8c©\82Â\82©\82Á\82½\88Ê\92u
 185 *}
 186 function AnsiStrTok(
 187         p                       : PChar;
 188         const tail      : PChar;
 189         const tok : TSysCharSet
 190 ) : PChar;
 191 begin
 192
 193         while p < tail do
 194         begin
 195                 if p^ in tok then
 196                 begin
 197                         Break;
 198                 end else if p^ in kXMLKanji then
 199                         p := p + 2
 200                 else
 201                         Inc( p );
 202         end;
 203
 204         Result := p;
 205
 206 end;
 207
 208 {*!
 209 \brief  tok \82Å\82Í\96³\82¢\83L\83\83\83\89\83N\83^\82ð\92T\82·
 210 \param  p                       \92T\8dõ\8aJ\8en\88Ê\92u
 211 \param  tail    \8fI\97¹\88Ê\92u + 1
 212 \param  tok             \92T\82·\83L\83\83\83\89\83N\83^
 213 \return tok \82Å\82Í\82È\82¢\83L\83\83\83\89\83N\83^\82ª\8dÅ\8f\89\82É\8c©\82Â\82©\82Á\82½\88Ê\92u
 214 *}
 215 function AnsiStrNonTok(
 216         p                       : PChar;
 217         const tail      : PChar;
 218         const tok : TSysCharSet
 219 ) : PChar;
 220 begin
 221
 222         while p < tail do
 223         begin
 224                 if p^ in tok then
 225                 begin
 226                         if p^ in kXMLKanji then
 227                                 p := p + 2
 228                         else
 229                                 Inc( p );
 230                 end else begin
 231                         Break;
 232                 end;
 233         end;
 234
 235         Result := p;
 236
 237 end;
 238
 239 function XMLCloseCheck(
 240         var p : PChar;
 241         const tail      : PChar;
 242         var node : IXMLNode;
 243         out tag : string;
 244         out closed : boolean
 245 ) : boolean; // ch \82ð\82±\82Ì\83\8b\81[\83`\83\93\82ª\8f\88\97\9d\82µ\82½\82È\82ç true
 246 var
 247         found           : PChar;
 248 begin
 249
 250         closed := false;
 251         Result := false;
 252         tag := '';
 253
 254         case p^ of
 255         '>':
 256                 begin
 257                         // \8aJ\8en\83^\83O\82Ì\8dÅ\8cã\82Ü\82Å\93Ç\82ñ\82¾
 258                         Inc( p );       // '>' \94ò\82Î\82µ
 259                         Result := true;
 260                 end;
 261
 262         '?':
 263                 begin
 264                         // <?xml?> \82Ý\82½\82¢\82È\82â\82Â\81B\82æ\82Á\82Ä\96³\8e\8b
 265                         p := AnsiStrTok( p, tail, kXMLTagEnd );
 266                         p := AnsiStrTok( p, tail, kXMLTagStart );
 267                         Inc( p );       // '<' \94ò\82Î\82µ
 268                         p := AnsiStrNonTok( p, tail, kXMLWhite );
 269                         //closed := true;
 270                         Result := true;
 271                 end;
 272
 273         '/':
 274                 begin
 275                         // \83^\83O\96¼\82ð\93Ç\82Ý\8d\9e\82ñ\82Å\95Ô\82·
 276                         Inc( p );       // '/' \94ò\82Î\82µ
 277                         found := AnsiStrTok( p, tail, kXMLTagEnd );
 278 //                      tag := Copy( p, 0, found - p ); // \89½\8cÌ\82©\8c\83\92x
 279                         SetLength( tag, found - p );
 280                         CopyMemory( PChar( tag ), p, found - p );
 281
 282                         p := found + 1; // '>' \94ò\82Î\82µ
 283                         closed := true;
 284                         Result := true;
 285                 end;
 286         end;
 287
 288 end;
 289
 290 function XMLReadNode(
 291         var p : PChar;
 292         const tail      : PChar;
 293         var node : IXMLNode
 294 ) : string; // node \88È\8aO\82Ì\83m\81[\83h\82ª\95Â\82¶\82ç\82ê\82½\8fê\8d\87\82Ì\83m\81[\83h\96¼
 295 var
 296         child : IXMLNode;
 297
 298         found : PChar;
 299         tag : string;
 300
 301         isClosed : boolean;
 302
 303         nodeName : string;
 304         attributeName : string;
 305         attributeValue : string;
 306 label
 307         NextNode;
 308 begin
 309         try
 310                 // node \82Ì\93Ç\82Ý\8d\9e\82Ý(1 \83\8b\81[\83v\82É\82Â\82« 1 \83m\81[\83h)
 311                 node.ChildNodes := IXMLNode.Create;
 312
 313                 while p < tail do
 314                 begin
 315                         // NodeName \93Ç\82Ý\8d\9e\82Ý
 316                         p := AnsiStrNonTok( p, tail, kXMLWhite );
 317
 318                         while p < tail do
 319                         begin
 320                                 if XMLCloseCheck( p, tail, node, tag, isClosed ) then
 321                                 begin
 322                                         if isClosed then
 323                                         begin
 324                                                 Result := tag;
 325                                                 exit;
 326                                         end;
 327
 328                                         goto NextNode;
 329                                 end else if p^ = '<' then
 330                                 begin
 331                                         // \90V\8bK\83m\81[\83h
 332                                         Inc( p );
 333                                         child := IXMLNode.Create;
 334                                         tag := XMLReadNode( p, tail, child );
 335                                         node.ChildNodes.Add( child );
 336
 337                                         // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½
 338                                         if Length( tag ) > 0 then
 339                                         begin
 340                                                 // \8e©\95ª\82Ì\82à\82Ì\82©\83`\83F\83b\83N\82µ\82Ä\81A\88á\82¦\82Î\90e\82É\95Ô\82·
 341                                                 if tag <> node.NodeName then
 342                                                         Result := tag;
 343                                                 exit;
 344                                         end;
 345
 346                                         goto NextNode;
 347                                 end else if p^ in kXMLWhite then
 348                                 begin
 349                                         // NodeName \8a®\97¹
 350                                         break;
 351                                 end else begin
 352                                         found := AnsiStrTok( p, tail, kXMLNodeNameStop );
 353                                         SetLength( nodeName, found - p );
 354                                         CopyMemory( PChar( nodeName ), p, found - p );
 355                                         node.NodeName := nodeName;
 356
 357                                         p := found;
 358                                 end;
 359                         end;
 360
 361                         // Attribute \82Ì\93Ç\82Ý\8d\9e\82Ý
 362                         while p < tail do
 363                         begin
 364                                 // Attribute \82Ì\96¼\91O\82ð\93Ç\82Ý\8d\9e\82Ý
 365                                 attributeName := '';
 366                                 attributeValue := '';
 367
 368                                 p := AnsiStrNonTok( p, tail, kXMLWhite );
 369
 370                                 while p < tail do
 371                                 begin
 372                                         if XMLCloseCheck( p, tail, node, tag, isClosed ) then
 373                                         begin
 374                                                 if isClosed then
 375                                                 begin
 376                                                         // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½\82Ì\82Å\83\8a\83^\81[\83\93
 377                                                         // \81¦NodeName \82ð\92Ê\89ß\82µ\82Ä\82é\82Ì\82Å\93r\92\86\82Å\95Â\82¶\82Ä\82é\82±\82Æ\82É\82È\82é\81B
 378                                                         // \82æ\82Á\82Ä\93Æ\97§\83m\81[\83h\81B
 379                                                         exit;
 380                                                 end;
 381
 382                                                 // \8e\9f\82Ì\83m\81[\83h\82Ö
 383                                                 goto NextNode;
 384                                         end else if p^ = '=' then
 385                                         begin
 386                                                 // \82±\82±\82©\82ç\82Í\92l\82ª\8en\82Ü\82é\82Ì\82Å\96¼\91O\82Í\8fI\97¹
 387                                                 Inc( p );
 388                                                 break;
 389                                         end else if p^ in kXMLWhite then
 390                                         begin
 391                                                 // Value \82ª\91¶\8dÝ\82µ\82È\82¢(\8bK\8ai\8aO)\82Ì\82Å\8e\9f\82Ì\83m\81[\83h\82Ö
 392                                                 goto NextNode;
 393                                         end else begin
 394                                                 found := AnsiStrTok( p, tail, kXMLAttributeNameStop );
 395                                                 SetLength( attributeName, found - p );
 396                                                 CopyMemory( PChar( attributeName ), p, found - p );
 397
 398                                                 p := found;
 399                                         end;
 400                                 end;
 401
 402                                 // Attribute \82Ì\92l\82ð\93Ç\82Ý\8d\9e\82Ý
 403                                 p := AnsiStrNonTok( p, tail, kXMLWhite );
 404
 405                                 while p < tail do
 406                                 begin
 407                                         if XMLCloseCheck( p, tail, node, tag, isClosed ) then
 408                                         begin
 409                                                 if isClosed then
 410                                                 begin
 411                                                         if Length( attributeName ) > 0 then
 412                                                                 // \8bK\8ai\8aO\82¾\82¯\82Ç\82Ë
 413                                                                 node.AddAttribute( attributeName, attributeValue );
 414
 415                                                         // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½\82Ì\82Å\83\8a\83^\81[\83\93
 416                                                         // \81¦NodeName \82ð\92Ê\89ß\82µ\82Ä\82é\82Ì\82Å\93r\92\86\82Å\95Â\82¶\82Ä\82é\82±\82Æ\82É\82È\82é\81B
 417                                                         // \82æ\82Á\82Ä\93Æ\97§\83m\81[\83h\81B
 418                                                         exit;
 419                                                 end;
 420
 421                                                 // \8e\9f\82Ì\83m\81[\83h\82Ö
 422                                                 goto NextNode;
 423                                         end else if p^ = '"' then
 424                                         begin
 425                                                 // \92l\82ª "" \82Å\8a\87\82ç\82ê\82Ä\82é\82Ì\82Å(\82Ä\82¢\82¤\82©\8a\87\82ç\82ê\82Ä\82È\82«\82á\82¢\82¯\82È\82¢\82ñ\82¾\82¯\82Ç)
 426                                                 // \92l\82ð\88ê\8a\87\93Ç\82Ý\8d\9e\82Ý
 427                                                 Inc( p );
 428                                                 found := AnsiStrTok( p, tail, kXMLDQuote );
 429 //                                              attributeValue := Copy( p, 0, found - p );      // \89½\8cÌ\82©\8c\83\92x
 430                                                 SetLength( attributeValue, found - p );
 431                                                 CopyMemory( PChar( attributeValue ), p, found - p );
 432
 433                                                 node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
 434
 435                                                 // \92l\82ð\93Ç\82Ý\8fI\82í\82Á\82½\82Ì\82Å\8fI\97¹
 436                                                 p := found + 1; // '"' \94ò\82Î\82µ
 437                                                 break;
 438                                         end else if p^ in kXMLWhite then
 439                                         begin
 440                                                 // \8bK\8ai\8aO\82¾\82¯\82Ç\82Ë
 441                                                 node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
 442
 443                                                 goto NextNode;
 444                                         end else begin
 445                                                 // \8bK\8ai\8aO\82¾\82¯\82Ç\88ê\89\9e\8eæ\82Á\82Ä\82¨\82
 446                                                 attributeValue := attributeValue + p^;
 447
 448                                                 if p^ in kXMLKanji then
 449                                                 begin
 450                                                         attributeValue := attributeValue + (p + 1)^;
 451                                                         p := p + 2;
 452                                                 end else begin
 453                                                         Inc( p );
 454                                                 end;
 455                                         end;
 456                                 end;
 457                         end; // Attribute \82Ì\93Ç\82Ý\8d\9e\82Ý
 458
 459                         NextNode:;
 460                 end; // // node \82Ì\93Ç\82Ý\8d\9e\82Ý(1 \83\8b\81[\83v\82É\82Â\82« 1 \83m\81[\83h)
 461         finally
 462         end;
 463 end;
 464
 465 procedure LoadXMLDocument(
 466         const fileName : string;
 467         var doc : IXMLDocument
 468 );
 469 type
 470         xmlMode = ( xmlHoge );
 471 var
 472         xmlFile : TMappedFile;
 473         p                               : PChar;
 474 begin
 475                 //Result := IXMLDocument.Create;
 476         //doc := IXMLDocument.Create;
 477
 478         xmlFile := TMappedFile.Create( fileName );
 479
 480         try
 481                 p := xmlFile.Memory;
 482                 XMLReadNode( p, p + xmlFile.Size, IXMLNode( doc ) );
 483                 //XMLReadNode( xmlFile, IXMLNode( Result ) );
 484         finally
 485                 xmlFile.Free;
 486         end;
 487
 488         //Result := doc;
 489
 490 end;
 491
 492 end.