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         t : Integer;
 161         index : Integer;
 162 begin
 163
 164         index := FAttributeCount;
 165         Inc( FAttributeCount );
 166         SetLength( FAttributes, FAttributeCount );
 167
 168         FAttributes[ index ].Name := Name;
 169         FAttributes[ index ].Value := Value;
 170
 171 end;
 172
 173 function IXMLDocument.GetDocumentElement() : IXMLNode;
 174 begin
 175
 176         Result := FChildNodes[ 0 ];
 177
 178 end;
 179
 180 {*!
 181 \brief  tok \82ð\92T\82·
 182 \param  p                       \92T\8dõ\8aJ\8en\88Ê\92u
 183 \param  tail    \8fI\97¹\88Ê\92u + 1
 184 \param  tok             \92T\82·\83L\83\83\83\89\83N\83^
 185 \return tok \82ª\8dÅ\8f\89\82É\8c©\82Â\82©\82Á\82½\88Ê\92u
 186 *}
 187 function AnsiStrTok(
 188         p                       : PChar;
 189         const tail      : PChar;
 190         const tok : TSysCharSet
 191 ) : PChar;
 192 begin
 193
 194         while p < tail do
 195         begin
 196                 if p^ in tok then
 197                 begin
 198                         Break;
 199                 end else if p^ in kXMLKanji then
 200                         p := p + 2
 201                 else
 202                         Inc( p );
 203         end;
 204
 205         Result := p;
 206
 207 end;
 208
 209 {*!
 210 \brief  tok \82Å\82Í\96³\82¢\83L\83\83\83\89\83N\83^\82ð\92T\82·
 211 \param  p                       \92T\8dõ\8aJ\8en\88Ê\92u
 212 \param  tail    \8fI\97¹\88Ê\92u + 1
 213 \param  tok             \92T\82·\83L\83\83\83\89\83N\83^
 214 \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
 215 *}
 216 function AnsiStrNonTok(
 217         p                       : PChar;
 218         const tail      : PChar;
 219         const tok : TSysCharSet
 220 ) : PChar;
 221 begin
 222
 223         while p < tail do
 224         begin
 225                 if p^ in tok then
 226                 begin
 227                         if p^ in kXMLKanji then
 228                                 p := p + 2
 229                         else
 230                                 Inc( p );
 231                 end else begin
 232                         Break;
 233                 end;
 234         end;
 235
 236         Result := p;
 237
 238 end;
 239
 240 function XMLCloseCheck(
 241         var p : PChar;
 242         const tail      : PChar;
 243         var node : IXMLNode;
 244         out tag : string;
 245         out closed : boolean
 246 ) : boolean; // ch \82ð\82±\82Ì\83\8b\81[\83`\83\93\82ª\8f\88\97\9d\82µ\82½\82È\82ç true
 247 var
 248         found           : PChar;
 249 begin
 250
 251         closed := false;
 252         Result := false;
 253         tag := '';
 254
 255         case p^ of
 256         '>':
 257                 begin
 258                         // \8aJ\8en\83^\83O\82Ì\8dÅ\8cã\82Ü\82Å\93Ç\82ñ\82¾
 259                         Inc( p );       // '>' \94ò\82Î\82µ
 260                         Result := true;
 261                 end;
 262
 263         '?':
 264                 begin
 265                         // <?xml?> \82Ý\82½\82¢\82È\82â\82Â\81B\82æ\82Á\82Ä\96³\8e\8b
 266                         p := AnsiStrTok( p, tail, kXMLTagEnd );
 267                         p := AnsiStrTok( p, tail, kXMLTagStart );
 268                         Inc( p );       // '<' \94ò\82Î\82µ
 269                         p := AnsiStrNonTok( p, tail, kXMLWhite );
 270                         //closed := true;
 271                         Result := true;
 272                 end;
 273
 274         '/':
 275                 begin
 276                         // \83^\83O\96¼\82ð\93Ç\82Ý\8d\9e\82ñ\82Å\95Ô\82·
 277                         Inc( p );       // '/' \94ò\82Î\82µ
 278                         found := AnsiStrTok( p, tail, kXMLTagEnd );
 279 //                      tag := Copy( p, 0, found - p ); // \89½\8cÌ\82©\8c\83\92x
 280                         SetLength( tag, found - p );
 281                         CopyMemory( PChar( tag ), p, found - p );
 282
 283                         p := found + 1; // '>' \94ò\82Î\82µ
 284                         closed := true;
 285                         Result := true;
 286                 end;
 287         end;
 288
 289 end;
 290
 291 function XMLReadNode(
 292         var p : PChar;
 293         const tail      : PChar;
 294         var node : IXMLNode
 295 ) : string; // node \88È\8aO\82Ì\83m\81[\83h\82ª\95Â\82¶\82ç\82ê\82½\8fê\8d\87\82Ì\83m\81[\83h\96¼
 296 var
 297         child : IXMLNode;
 298
 299         found : PChar;
 300         tag : string;
 301         tagLen : Integer;
 302
 303         isClosed : boolean;
 304
 305         nodeName : string;
 306         attributeName : string;
 307         attributeValue : string;
 308
 309         t, t2 : Integer;
 310 label
 311         NextNode;
 312 begin
 313         try
 314                 // node \82Ì\93Ç\82Ý\8d\9e\82Ý(1 \83\8b\81[\83v\82É\82Â\82« 1 \83m\81[\83h)
 315                 node.ChildNodes := IXMLNode.Create;
 316
 317                 while p < tail do
 318                 begin
 319                         // NodeName \93Ç\82Ý\8d\9e\82Ý
 320                         p := AnsiStrNonTok( p, tail, kXMLWhite );
 321
 322                         while p < tail do
 323                         begin
 324                                 if XMLCloseCheck( p, tail, node, tag, isClosed ) then
 325                                 begin
 326                                         if isClosed then
 327                                         begin
 328                                                 Result := tag;
 329                                                 exit;
 330                                         end;
 331
 332                                         goto NextNode;
 333                                 end else if p^ = '<' then
 334                                 begin
 335                                         // \90V\8bK\83m\81[\83h
 336                                         Inc( p );
 337                                         child := IXMLNode.Create;
 338                                         tag := XMLReadNode( p, tail, child );
 339                                         node.ChildNodes.Add( child );
 340
 341                                         // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½
 342                                         if Length( tag ) > 0 then
 343                                         begin
 344                                                 // \8e©\95ª\82Ì\82à\82Ì\82©\83`\83F\83b\83N\82µ\82Ä\81A\88á\82¦\82Î\90e\82É\95Ô\82·
 345                                                 if tag <> node.NodeName then
 346                                                         Result := tag;
 347                                                 exit;
 348                                         end;
 349
 350                                         goto NextNode;
 351                                 end else if p^ in kXMLWhite then
 352                                 begin
 353                                         // NodeName \8a®\97¹
 354                                         break;
 355                                 end else begin
 356                                         found := AnsiStrTok( p, tail, kXMLNodeNameStop );
 357                                         SetLength( nodeName, found - p );
 358                                         CopyMemory( PChar( nodeName ), p, found - p );
 359                                         node.NodeName := nodeName;
 360
 361                                         p := found;
 362                                 end;
 363                         end;
 364
 365                         // Attribute \82Ì\93Ç\82Ý\8d\9e\82Ý
 366                         while p < tail do
 367                         begin
 368                                 // Attribute \82Ì\96¼\91O\82ð\93Ç\82Ý\8d\9e\82Ý
 369                                 attributeName := '';
 370                                 attributeValue := '';
 371
 372                                 p := AnsiStrNonTok( p, tail, kXMLWhite );
 373
 374                                 while p < tail do
 375                                 begin
 376                                         if XMLCloseCheck( p, tail, node, tag, isClosed ) then
 377                                         begin
 378                                                 if isClosed then
 379                                                 begin
 380                                                         // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½\82Ì\82Å\83\8a\83^\81[\83\93
 381                                                         // \81¦NodeName \82ð\92Ê\89ß\82µ\82Ä\82é\82Ì\82Å\93r\92\86\82Å\95Â\82¶\82Ä\82é\82±\82Æ\82É\82È\82é\81B
 382                                                         // \82æ\82Á\82Ä\93Æ\97§\83m\81[\83h\81B
 383                                                         exit;
 384                                                 end;
 385
 386                                                 // \8e\9f\82Ì\83m\81[\83h\82Ö
 387                                                 goto NextNode;
 388                                         end else if p^ = '=' then
 389                                         begin
 390                                                 // \82±\82±\82©\82ç\82Í\92l\82ª\8en\82Ü\82é\82Ì\82Å\96¼\91O\82Í\8fI\97¹
 391                                                 Inc( p );
 392                                                 break;
 393                                         end else if p^ in kXMLWhite then
 394                                         begin
 395                                                 // Value \82ª\91¶\8dÝ\82µ\82È\82¢(\8bK\8ai\8aO)\82Ì\82Å\8e\9f\82Ì\83m\81[\83h\82Ö
 396                                                 goto NextNode;
 397                                         end else begin
 398                                                 found := AnsiStrTok( p, tail, kXMLAttributeNameStop );
 399                                                 SetLength( attributeName, found - p );
 400                                                 CopyMemory( PChar( attributeName ), p, found - p );
 401
 402                                                 p := found;
 403                                         end;
 404                                 end;
 405
 406                                 // Attribute \82Ì\92l\82ð\93Ç\82Ý\8d\9e\82Ý
 407                                 p := AnsiStrNonTok( p, tail, kXMLWhite );
 408
 409                                 while p < tail do
 410                                 begin
 411                                         if XMLCloseCheck( p, tail, node, tag, isClosed ) then
 412                                         begin
 413                                                 if isClosed then
 414                                                 begin
 415                                                         if Length( attributeName ) > 0 then
 416                                                                 // \8bK\8ai\8aO\82¾\82¯\82Ç\82Ë
 417                                                                 node.AddAttribute( attributeName, attributeValue );
 418
 419                                                         // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½\82Ì\82Å\83\8a\83^\81[\83\93
 420                                                         // \81¦NodeName \82ð\92Ê\89ß\82µ\82Ä\82é\82Ì\82Å\93r\92\86\82Å\95Â\82¶\82Ä\82é\82±\82Æ\82É\82È\82é\81B
 421                                                         // \82æ\82Á\82Ä\93Æ\97§\83m\81[\83h\81B
 422                                                         exit;
 423                                                 end;
 424
 425                                                 // \8e\9f\82Ì\83m\81[\83h\82Ö
 426                                                 goto NextNode;
 427                                         end else if p^ = '"' then
 428                                         begin
 429                                                 // \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Ç)
 430                                                 // \92l\82ð\88ê\8a\87\93Ç\82Ý\8d\9e\82Ý
 431                                                 Inc( p );
 432                                                 found := AnsiStrTok( p, tail, kXMLDQuote );
 433 //                                              attributeValue := Copy( p, 0, found - p );      // \89½\8cÌ\82©\8c\83\92x
 434                                                 SetLength( attributeValue, found - p );
 435                                                 CopyMemory( PChar( attributeValue ), p, found - p );
 436
 437                                                 node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
 438
 439                                                 // \92l\82ð\93Ç\82Ý\8fI\82í\82Á\82½\82Ì\82Å\8fI\97¹
 440                                                 p := found + 1; // '"' \94ò\82Î\82µ
 441                                                 break;
 442                                         end else if p^ in kXMLWhite then
 443                                         begin
 444                                                 // \8bK\8ai\8aO\82¾\82¯\82Ç\82Ë
 445                                                 node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
 446
 447                                                 goto NextNode;
 448                                         end else begin
 449                                                 // \8bK\8ai\8aO\82¾\82¯\82Ç\88ê\89\9e\8eæ\82Á\82Ä\82¨\82
 450                                                 attributeValue := attributeValue + p^;
 451
 452                                                 if p^ in kXMLKanji then
 453                                                 begin
 454                                                         attributeValue := attributeValue + (p + 1)^;
 455                                                         p := p + 2;
 456                                                 end else begin
 457                                                         Inc( p );
 458                                                 end;
 459                                         end;
 460                                 end;
 461                         end; // Attribute \82Ì\93Ç\82Ý\8d\9e\82Ý
 462
 463                         NextNode:;
 464                 end; // // node \82Ì\93Ç\82Ý\8d\9e\82Ý(1 \83\8b\81[\83v\82É\82Â\82« 1 \83m\81[\83h)
 465         finally
 466         end;
 467 end;
 468
 469 procedure LoadXMLDocument(
 470         const fileName : string;
 471         var doc : IXMLDocument
 472 );
 473 type
 474         xmlMode = ( xmlHoge );
 475 var
 476         xmlFile : TMappedFile;
 477         p                               : PChar;
 478 begin
 479                 //Result := IXMLDocument.Create;
 480         //doc := IXMLDocument.Create;
 481
 482         xmlFile := TMappedFile.Create( fileName );
 483
 484         try
 485                 p := xmlFile.Memory;
 486                 XMLReadNode( p, p + xmlFile.Size, IXMLNode( doc ) );
 487                 //XMLReadNode( xmlFile, IXMLNode( Result ) );
 488         finally
 489                 xmlFile.Free;
 490         end;
 491
 492         //Result := doc;
 493
 494 end;
 495
 496 end.