Changeset 138 for trunk/Packages/CoolWeb/Common/UHtmlClasses.pas
- Timestamp:
- Sep 9, 2022, 8:20:25 PM (2 years ago)
- File:
-
- 1 edited
-
trunk/Packages/CoolWeb/Common/UHtmlClasses.pas (modified) (32 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/CoolWeb/Common/UHtmlClasses.pas
r137 r138 4 4 5 5 uses 6 UXmlClasses, Classes, SysUtils, SpecializedList;6 UXmlClasses, Classes, SysUtils, Generics.Collections, UGenerics, UIpAddress; 7 7 8 8 type 9 10 { TDomainAddress } 11 12 TDomainAddress = class(TPersistent) 13 private 14 function GetAsString: string; 15 procedure SetAsString(const Value: string); 16 public 17 Levels: TListString; 18 constructor Create; 19 destructor Destroy; override; 20 property AsString: string read GetAsString write SetAsString; 21 end; 22 23 TAddrClass = (acA, acB, acC, acD, acE); 24 25 { TIpAddress } 26 27 TIpAddress = class(TPersistent) 28 private 29 function GetAddrClass: TAddrClass; 30 function GetAsCardinal: Cardinal; 31 function GetAsString: string; 32 function GetBroadcast: Boolean; 33 procedure SetBroadcast(const Value: Boolean); 34 procedure SetAsCardinal(const Value: Cardinal); 35 procedure SetAsString(const Value: string); 36 public 37 Octets: array[0..3] of Byte; 38 procedure Assign(Source: TPersistent); override; 39 function IsAddressString(Value: string): Boolean; 40 property AsCardinal: Cardinal read GetAsCardinal write SetAsCardinal; 41 property AsString: string read GetAsString write SetAsString; 42 property AddrClass: TAddrClass read GetAddrClass; 43 property Broadcast: Boolean read GetBroadcast write SetBroadcast; 44 end; 45 46 THostAddressState = (asDomainName, asIpAddress); 47 THostAddress = class(TPersistent) 48 private 49 function GetAsString: string; 50 procedure SetAsString(const Value: string); 51 public 52 State: THostAddressState; 53 DomainName: TDomainAddress; 54 IpAddress: TIpAddress; 55 constructor Create; 56 destructor Destroy; override; 57 property AsString: string read GetAsString write SetAsString; 58 end; 9 { TURL } 59 10 60 11 TURL = class(TPersistent) … … 90 41 end; 91 42 43 THtmlString = class; 44 THtmlBlock = class; 45 THtmlList = class; 46 THtmlInput = class; 47 48 { THtmlElements } 49 50 THtmlElements = class(TObjectList<THtmlElement>) 51 function AddString(Text: string = ''): THtmlString; 52 function AddBlock: THtmlBlock; 53 function AddList: THtmlList; 54 function AddInput: THtmlInput; 55 end; 56 92 57 TBlockType = (btNoTag, btBlockLevel, btInline); 93 58 … … 95 60 96 61 THtmlString = class(THtmlElement) 97 pr ivate62 protected 98 63 function GetAsXmlElement: TXmlElement; override; 99 64 public … … 105 70 106 71 THtmlLineBreak = class(THtmlElement) 107 pr ivate72 protected 108 73 function GetAsXmlElement: TXmlElement; override; 109 74 public … … 116 81 public 117 82 BlockType: TBlockType; 118 SubItems: TListObject; // TListObject<THtmlElement>; 83 SubItems: THtmlElements; 84 constructor Create; 85 destructor Destroy; override; 86 end; 87 88 TListType = (ltUnordered, ltOrdered); 89 90 { THtmlList } 91 92 THtmlList = class(THtmlElement) 93 protected 94 function GetAsXmlElement: TXmlElement; override; 95 public 96 ListType: TListType; 97 SubItems: THtmlElements; 119 98 constructor Create; 120 99 destructor Destroy; override; … … 122 101 123 102 THtmlLink = class(THtmlElement) 124 pr ivate103 protected 125 104 function GetAsXmlElement: TXmlElement; override; 126 105 public … … 140 119 141 120 THtmlImage = class(THtmlElement) 142 pr ivate121 protected 143 122 function GetAsXmlElement: TXmlElement; override; 144 123 public … … 156 135 157 136 THtmlInput = class(THtmlElement) 158 pr ivate137 protected 159 138 function GetAsXmlElement: TXmlElement; override; 160 139 public … … 197 176 198 177 THtmlCell = class(THtmlElement) 199 pr ivate178 protected 200 179 function GetAsXmlElement: TXmlElement; override; 201 180 public … … 207 186 end; 208 187 188 { THtmlCells } 189 190 THtmlCells = class(TObjectList<THtmlCell>) 191 function AddCell: THtmlCell; 192 end; 193 209 194 { THtmlRow } 210 195 211 196 THtmlRow = class(THtmlElement) 212 private 213 function GetAsXmlElement: TXmlElement; override; 214 public 215 Cells: TListObject; // TListObject<THtmlCell> 216 constructor Create; 217 destructor Destroy; override; 197 protected 198 function GetAsXmlElement: TXmlElement; override; 199 public 200 Cells: THtmlCells; 201 constructor Create; 202 destructor Destroy; override; 203 end; 204 205 { THtmlRows } 206 207 THtmlRows = class(TObjectList<THtmlRow>) 208 function AddRow: THtmlRow; 218 209 end; 219 210 … … 224 215 function GetAsXmlElement: TXmlElement; override; 225 216 public 226 Rows: T ListObject; // TListObject<THtmlRow>217 Rows: THtmlRows; 227 218 constructor Create; 228 219 destructor Destroy; override; … … 242 233 243 234 implementation 244 245 resourcestring246 SStringToIPConversionError = 'String to IP address conversion error';247 235 248 236 function LeftCutString(var Source, Output: string; Delimiter: string; Allowed: string = ''): Boolean; … … 298 286 end; 299 287 288 { THtmlCells } 289 290 function THtmlCells.AddCell: THtmlCell; 291 begin 292 Result := THtmlCell.Create; 293 Add(Result); 294 end; 295 296 { THtmlRows } 297 298 function THtmlRows.AddRow: THtmlRow; 299 begin 300 Result := THtmlRow.Create; 301 Add(Result); 302 end; 303 304 { THtmlList } 305 306 function THtmlList.GetAsXmlElement: TXmlElement; 307 var 308 I: Integer; 309 begin 310 Result := TXmlTag.Create; 311 with TXmlTag(Result) do begin 312 case ListType of 313 ltOrdered: Name := 'ol'; 314 ltUnordered: Name := 'ul'; 315 end; 316 for I := 0 to SubItems.Count - 1 do begin 317 with SubElements.AddTag('li') do 318 SubElements.Add(SubItems[I].AsXmlElement); 319 end; 320 end; 321 end; 322 323 constructor THtmlList.Create; 324 begin 325 inherited; 326 SubItems := THtmlElements.Create; 327 end; 328 329 destructor THtmlList.Destroy; 330 begin 331 FreeAndNil(SubItems); 332 inherited; 333 end; 334 335 { THtmlElements } 336 337 function THtmlElements.AddString(Text: string = ''): THtmlString; 338 begin 339 Result := THtmlString.Create; 340 Result.Text := Text; 341 Add(Result); 342 end; 343 344 function THtmlElements.AddBlock: THtmlBlock; 345 begin 346 Result := THtmlBlock.Create; 347 Add(Result); 348 end; 349 350 function THtmlElements.AddList: THtmlList; 351 begin 352 Result := THtmlList.Create; 353 Add(Result); 354 end; 355 356 function THtmlElements.AddInput: THtmlInput; 357 begin 358 Result := THtmlInput.Create; 359 Add(Result); 360 end; 361 300 362 { THtmlCell } 301 363 … … 319 381 destructor THtmlCell.Destroy; 320 382 begin 321 Value.Free;383 FreeAndNil(Value); 322 384 inherited; 323 385 end; … … 332 394 TXmlTag(Result).Name := 'tr'; 333 395 for Column := 0 to Cells.Count - 1 do 334 TXmlTag(Result).SubElements.Add New(THtmlCell(Cells[Column]).AsXmlElement);396 TXmlTag(Result).SubElements.Add(Cells[Column].AsXmlElement); 335 397 end; 336 398 337 399 constructor THtmlRow.Create; 338 400 begin 339 Cells := T ListObject.Create;401 Cells := THtmlCells.Create; 340 402 end; 341 403 342 404 destructor THtmlRow.Destroy; 343 405 begin 344 Cells.Free;406 FreeAndNil(Cells); 345 407 inherited; 346 408 end; … … 350 412 function THtmlTable.GetAsXmlElement: TXmlElement; 351 413 var 352 Row , Column: Integer;414 Row: Integer; 353 415 begin 354 416 Result := inherited; … … 356 418 Name := 'table'; 357 419 for Row := 0 to Rows.Count - 1 do 358 SubElements.Add New(THtmlRow(Rows[Row]).AsXmlElement);420 SubElements.Add(Rows[Row].AsXmlElement); 359 421 end; 360 422 end; … … 362 424 constructor THtmlTable.Create; 363 425 begin 364 Rows := T ListObject.Create;426 Rows := THtmlRows.Create; 365 427 end; 366 428 367 429 destructor THtmlTable.Destroy; 368 430 begin 369 Rows.Free;431 FreeAndNil(Rows); 370 432 inherited; 371 433 end; … … 448 510 destructor THtmlForm.Destroy; 449 511 begin 450 Action.Free;512 FreeAndNil(Action); 451 513 inherited; 452 514 end; … … 465 527 destructor THtmlDocument.Destroy; 466 528 begin 467 Body.Free;468 Styles.Free;469 Scripts.Free;529 FreeAndNil(Body); 530 FreeAndNil(Styles); 531 FreeAndNil(Scripts); 470 532 inherited; 471 533 end; … … 473 535 function THtmlDocument.GetAsXmlDocument: TXmlDocument; 474 536 var 475 DocType: TXMLTag;476 HTMLTag: TXMLTag;477 537 I: Integer; 478 538 begin 479 539 Result := TXmlDocument.Create; 480 540 with Result, Content do begin 481 DocType := TXMlTag.Create; 482 DocType.Name := '!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"'; 483 Doctype.EndTagSymbol := ''; 484 SubElements.Add(DocType); 485 HTMLTag := TXMLTag.Create; 486 with HTMLTag do begin 487 Name := 'html'; 488 with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin 489 Name := 'head'; 490 with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin 491 Name := 'title'; 492 with TXmlString(SubElements[SubElements.Add(TXmlString.Create)]) do begin 493 Text := Title; 494 end; 541 with SubElements.AddTag('!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"') do begin 542 EndTagSymbol := ''; 543 end; 544 with SubElements.AddTag('html') do begin 545 with SubElements.AddTag('head') do begin 546 with SubElements.AddTag('title') do begin 547 SubElements.AddString(Title); 495 548 end; 496 with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin 497 Name := 'meta'; 549 with SubElements.AddTag('meta') do begin 498 550 Attributes.Add('http-equiv', 'Content-Language'); 499 551 Attributes.Add('content', ContentLanguage); 500 552 end; 501 with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin 502 Name := 'meta'; 553 with SubElements.AddTag('meta') do begin 503 554 Attributes.Add('http-equiv', 'Content-Type'); 504 555 Attributes.Add('content', 'text/html; charset=' + ContentEncoding); 505 556 end; 506 557 for I := 0 to Styles.Count - 1 do 507 with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin 508 Name := 'link'; 558 with SubElements.AddTag('link') do begin 509 559 Attributes.Add('rel', 'stylesheet'); 510 560 Attributes.Add('href', Styles[I]); … … 513 563 end; 514 564 for I := 0 to Scripts.Count - 1 do 515 with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin 516 Name := 'script'; 565 with SubElements.AddTag('script') do begin 517 566 ShringEmpty := False; 518 567 Attributes.Add('type', 'text/javascript'); … … 520 569 end; 521 570 end; 522 with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin 523 Name := 'body'; 571 with SubElements.AddTag('body') do begin 524 572 SubElements.Add(Body.AsXmlElement); 525 573 end; 526 574 end; 527 SubElements.Add(HTMLTag);528 575 end; 529 576 end; … … 534 581 begin 535 582 inherited; 536 SubItems := T ListObject.Create;583 SubItems := THtmlElements.Create; 537 584 end; 538 585 539 586 destructor THtmlBlock.Destroy; 540 587 begin 541 SubItems.Free;588 FreeAndNil(SubItems); 542 589 inherited; 543 590 end; … … 555 602 end; 556 603 for I := 0 to SubItems.Count - 1 do 557 SubElements.Add( THtmlElement(SubItems[I]).AsXmlElement);604 SubElements.Add(SubItems[I].AsXmlElement); 558 605 end; 559 606 end; … … 580 627 end; 581 628 582 { TIpAddress } 583 584 procedure TIpAddress.Assign(Source: TPersistent); 585 var 586 I: Integer; 587 begin 588 if Assigned(Source) then begin 589 if Source is TIpAddress then begin 590 for I := 0 to High(Octets) do 591 Octets[I] := TIpAddress(Source).Octets[I]; 592 end else inherited; 593 end else inherited; 594 end; 595 596 function TIpAddress.IsAddressString(Value: string): Boolean; 597 var 598 Parts: TListString; 599 begin 600 Result := True; 601 try 602 Parts := TListString.Create; 603 Parts.Explode(Value, '.', StrToStr); 604 if Parts.Count = 4 then begin 605 if (StrToInt(Parts[3]) < 0) or (StrToInt(Parts[3]) > 255) then Result := False; 606 if (StrToInt(Parts[2]) < 0) or (StrToInt(Parts[2]) > 255) then Result := False; 607 if (StrToInt(Parts[1]) < 0) or (StrToInt(Parts[1]) > 255) then Result := False; 608 if (StrToInt(Parts[0]) < 0) or (StrToInt(Parts[0]) > 255) then Result := False; 609 end else Result := False; 610 finally 611 Parts.Free; 612 end; 613 end; 614 615 function TIpAddress.GetAddrClass: TAddrClass; 616 begin 617 if (Octets[3] and $80) = 0 then Result := acA 618 else begin 619 if (Octets[3] and $40) = 0 then Result := acB 620 else begin 621 if (Octets[3] and $20) = 0 then Result := acC 622 else begin 623 if (Octets[3] and $10) = 0 then Result := acD 624 else Result := acE; 625 end; 626 end; 627 end; 628 end; 629 630 function TIpAddress.GetAsCardinal: Cardinal; 631 begin 632 Result := Octets[0] or (Octets[1] shl 8) or (Octets[2] shl 16) or (Octets[3] shl 24); 633 end; 634 635 function TIpAddress.GetAsString: string; 636 begin 637 Result := IntToStr(Octets[3]) + '.' + IntToStr(Octets[2]) + '.' + 638 IntToStr(Octets[1]) + '.' + IntToStr(Octets[0]); 639 end; 640 641 function TIpAddress.GetBroadcast: Boolean; 642 begin 643 Result := AsCardinal = High(Cardinal); 644 end; 645 646 procedure TIpAddress.SetAsCardinal(const Value: Cardinal); 647 begin 648 Octets[0] := Byte(Value); 649 Octets[1] := Byte(Value shr 8); 650 Octets[2] := Byte(Value shr 16); 651 Octets[3] := Byte(Value shr 24); 652 end; 653 654 procedure TIpAddress.SetAsString(const Value: string); 655 var 656 Parts: TListString; 657 begin 658 try 659 Parts := TListString.Create; 660 Parts.Explode(Value, '.', StrToStr); 661 try 662 // if Length(Parts) = 4 then begin 663 Octets[0] := StrToInt(Parts[3]); 664 Octets[1] := StrToInt(Parts[2]); 665 Octets[2] := StrToInt(Parts[1]); 666 Octets[3] := StrToInt(Parts[0]); 667 // end else raise EConvertError.Create('String to IP address conversion error'); 668 except 669 raise EConvertError.Create(SStringToIPConversionError); 670 end; 671 finally 672 Parts.Free; 673 end; 674 end; 675 676 procedure TIpAddress.SetBroadcast(const Value: Boolean); 677 begin 678 AsCardinal := High(Cardinal); 679 end; 629 { TURL } 680 630 681 631 constructor TURL.Create; … … 686 636 destructor TURL.Destroy; 687 637 begin 688 Host.Free;638 FreeAndNil(Host); 689 639 inherited; 690 640 end; … … 724 674 end; 725 675 726 727 { TDomainAddress }728 729 function TDomainAddress.GetAsString: string;730 begin731 try732 Levels.Reverse;733 Result := Levels.Implode('.', StrToStr);734 finally735 Levels.Reverse;736 end;737 end;738 739 procedure TDomainAddress.SetAsString(const Value: string);740 begin741 Levels.Explode(Value, '.', StrToStr);742 Levels.Reverse;743 end;744 745 constructor TDomainAddress.Create;746 begin747 Levels := TListString.Create;748 end;749 750 destructor TDomainAddress.Destroy;751 begin752 Levels.Free;753 inherited;754 end;755 756 676 { THtmlLink } 757 677 … … 763 683 destructor THtmlLink.Destroy; 764 684 begin 765 Target.Free;685 FreeAndNil(Target); 766 686 inherited; 767 687 end; … … 791 711 end; 792 712 793 { THostAddress }794 795 constructor THostAddress.Create;796 begin797 DomainName := TDomainAddress.Create;798 IpAddress := TIpAddress.Create;799 State := asDomainName;800 DomainName.AsString := 'localhost';801 end;802 803 destructor THostAddress.Destroy;804 begin805 DomainName.Free;806 IpAddress.Free;807 inherited;808 end;809 810 function THostAddress.GetAsString: string;811 begin812 case State of813 asDomainName: Result := DomainName.AsString;814 asIpAddress: Result := IpAddress.AsString;815 end;816 end;817 818 procedure THostAddress.SetAsString(const Value: string);819 begin820 if IpAddress.IsAddressString(Value) then begin821 State := asIpAddress;822 IpAddress.AsString := Value;823 end else begin824 State := asDomainName;825 DomainName.AsString := Value;826 end;827 end;828 829 713 { THtmlImage } 830 714 … … 836 720 destructor THtmlImage.Destroy; 837 721 begin 838 Source.Free;722 FreeAndNil(Source); 839 723 inherited; 840 724 end; … … 889 773 destructor TQueryString.Destroy; 890 774 begin 891 Data.Free;775 FreeAndNil(Data); 892 776 inherited; 893 777 end;
Note:
See TracChangeset
for help on using the changeset viewer.
