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