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