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