richkit/cliptohtml.pas at main · plainlib/richkit · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
//-----------------------------------------------------------------------------------
//  RichKit Package © 2026 by Alexander Tverskoy
//  Licensed under the MIT License
//  You may obtain a copy of the License at https://opensource.org/licenses/MIT
//-----------------------------------------------------------------------------------

unit ClipToHtml;

{$mode objfpc}{$H+}

interface

uses
  Clipbrd;

var
  CF_HTML_FORMAT: QWord = 0;
  CF_TEXT_HTML_FORMAT: QWord = 0;
  CF_PUBLIC_HTML_FORMAT: QWord = 0;
  CF_RTF_FORMAT: QWord = 0;

// Ensures that the known HTML clipboard formats are registered
procedure EnsureHtmlFormatRegistered;

// Ensures that the Rtf clipboard format are registered
procedure EnsureRtfFormatRegistered;

// Returns the HTML content from the clipboard as a string.
// Tries several known HTML formats across platforms.
function GetHtmlFromClipboard: string;

implementation

uses
  Classes, SysUtils;

procedure EnsureHtmlFormatRegistered;
begin
  if CF_HTML_FORMAT = 0 then
    CF_HTML_FORMAT := RegisterClipboardFormat('HTML Format');
  if CF_TEXT_HTML_FORMAT = 0 then
    CF_TEXT_HTML_FORMAT := RegisterClipboardFormat('text/html');
  if CF_PUBLIC_HTML_FORMAT = 0 then
    CF_PUBLIC_HTML_FORMAT := RegisterClipboardFormat('public.html');
end;

procedure EnsureRtfFormatRegistered;
begin
  if CF_RTF_FORMAT = 0 then
    CF_RTF_FORMAT := RegisterClipboardFormat('Rich Text Format');
end;

function ExtractHtmlBody(const AClipboardHtml: string): string;
var
  lower: string = '';
  startPos, endPos: integer;
begin
  Result := AClipboardHtml;

  lower := LowerCase(Result);
  startPos := Pos('<html', lower);
  if startPos = 0 then
    startPos := Pos('<body', lower);

  if startPos > 0 then
    Result := Copy(Result, startPos, Length(Result) - startPos + 1);

  lower := LowerCase(Result);
  endPos := Pos('</html>', lower);
  if endPos > 0 then
    Result := Copy(Result, 1, endPos + Length('</html>') - 1);
end;

function GetHtmlFromClipboard: string;
var
  ms: TMemoryStream = nil;
  s: string = '';
  formatID: QWord = 0;
begin
  Result := '';
  EnsureHtmlFormatRegistered;

  formatID := 0;

  if (CF_TEXT_HTML_FORMAT <> 0) and Clipboard.HasFormat(CF_TEXT_HTML_FORMAT) then
    formatID := CF_TEXT_HTML_FORMAT
  else if (CF_HTML_FORMAT <> 0) and Clipboard.HasFormat(CF_HTML_FORMAT) then
    formatID := CF_HTML_FORMAT
  else if (CF_PUBLIC_HTML_FORMAT <> 0) and Clipboard.HasFormat(CF_PUBLIC_HTML_FORMAT) then
    formatID := CF_PUBLIC_HTML_FORMAT;

  if formatID = 0 then Exit;

  ms := TMemoryStream.Create;
  try
    if Clipboard.GetFormat(formatID, ms) then
    begin
      ms.Position := 0;
      SetLength(s, ms.Size);
      if ms.Size > 0 then
        ms.ReadBuffer(s[1], ms.Size);
      Result := s;
    end;
  finally
    ms.Free;
  end;

  if Result <> '' then
    Result := ExtractHtmlBody(Result);
end;

end.