<commit_before>unit kn_ClipUtils;

interface
uses Windows, Classes, SysUtils, clipbrd;

const
  CF_HTML : word = 0;

type
   TClipBoardW= class(TClipboard)
      private
        function GetAsTextW: wideString;
        procedure SetAsTextW(const Value: wideString);
      public
        property AsTextW: wideString read GetAsTextW write SetAsTextW;
   end;

function Clipboard: TClipBoardW;

function ClipboardAsString : string;
function ClipboardAsStringW : WideString;
function FirstLineFromClipboard( const MaxLen : integer ) : WideString;


function ClipboardHasHTMLformat : boolean;
function ClipboardToStream( Fmt : word; Stm : TStream ) : boolean;
function GetURLFromHTMLClipboard : wideString;

implementation
uses WideStrings;

function ClipboardHasHTMLformat : boolean;
begin
  result := ( CF_HTML <> 0 ) and Clipboard.HasFormat( CF_HTML );
end; // ClipboardHasHTMLformat

function ClipboardToStream( Fmt : word; Stm : TStream ) : boolean;
// code by Peter Below
var
  hMem: THandle;
  pMem: Pointer;
begin
  result := false;
  hMem := Clipboard.GetAsHandle( fmt );
  if hMem <> 0 then
  begin
    pMem := GlobalLock( hMem );
    if pMem <> Nil Then Begin
      try
        Stm.Write( pMem^, GlobalSize( hMem ));
        result := true;
      finally
        GlobalUnlock( hMem );
      end;
    end
  end;
end; // ClipboardToStream

function GetURLFromHTMLClipboard : wideString;
const
  HTML_FMT_SRCURL  = 'SourceURL:';
  MAX_TEST_LINES = 15;
var
  List : TWideStringList;
  i : integer;
  Stm : TMemoryStream;
  line : WideString;
begin

  result := '';
  if ClipboardHasHTMLformat then
  begin
    Stm := TMemoryStream.Create;
    try
      ClipboardToStream( CF_HTML, Stm );
      Stm.Position := 0;
      list := TWideStringList.Create;
      try
        list.LoadFromStream( Stm );
        for i := 0 to list.count-1 do
        begin
          if ( i > MAX_TEST_LINES ) then
            break;
          line := list[i];
          if ( pos( HTML_FMT_SRCURL, line ) = 1 ) then
          begin
            delete( line, 1, length( HTML_FMT_SRCURL ));
            result := line;
            break;
          end;
        end;
      finally
        list.Free;
      end;
    finally
      Stm.Free;
    end;<commit_msg>Fix issue 163: Paste as web clip is not showing source URL<commit_after>unit kn_ClipUtils;

interface
uses Windows, Classes, SysUtils, clipbrd;

const
  CF_HTML : word = 0;

type
   TClipBoardW= class(TClipboard)
      private
        function GetAsTextW: wideString;
        procedure SetAsTextW(const Value: wideString);
      public
        property AsTextW: wideString read GetAsTextW write SetAsTextW;
   end;

function Clipboard: TClipBoardW;

function ClipboardAsString : string;
function ClipboardAsStringW : WideString;
function FirstLineFromClipboard( const MaxLen : integer ) : WideString;


function ClipboardHasHTMLformat : boolean;
function ClipboardToStream( Fmt : word; Stm : TStream ) : boolean;
function GetURLFromHTMLClipboard : string;

implementation
uses WideStrings;

function ClipboardHasHTMLformat : boolean;
begin
  result := ( CF_HTML <> 0 ) and Clipboard.HasFormat( CF_HTML );
end; // ClipboardHasHTMLformat

function ClipboardToStream( Fmt : word; Stm : TStream ) : boolean;
// code by Peter Below
var
  hMem: THandle;
  pMem: Pointer;
begin
  result := false;
  hMem := Clipboard.GetAsHandle( fmt );
  if hMem <> 0 then
  begin
    pMem := GlobalLock( hMem );
    if pMem <> Nil Then Begin
      try
        Stm.Write( pMem^, GlobalSize( hMem ));
        result := true;
      finally
        GlobalUnlock( hMem );
      end;
    end
  end;
end; // ClipboardToStream

function GetURLFromHTMLClipboard : string;
const
  HTML_FMT_SRCURL  = 'SourceURL:';
  MAX_TEST_LINES = 15;
var
  List : TStringList;
  i : integer;
  Stm : TMemoryStream;
  line : string;
begin

  result := '';
  if ClipboardHasHTMLformat then
  begin
    Stm := TMemoryStream.Create;
    try
      ClipboardToStream( CF_HTML, Stm );
      Stm.Position := 0;
      list := TStringList.Create;
      try
        list.LoadFromStream( Stm );
        for i := 0 to list.count-1 do
        begin
          if ( i > MAX_TEST_LINES ) then
            break;
          line := list[i];
          if ( pos( HTML_FMT_SRCURL, line ) = 1 ) then
          begin
            delete( line, 1, length( HTML_FMT_SRCURL ));
            result := line;
            break;
          end;
        end;
      finally
        list.Free;
      end;
    finally
      Stm.Free;
    end;
{'fraction_non_alphanumeric': 0.08524371244157579, 'fraction_numerical': 0.005119074115290452, 'mean_word_length': 2.612540192926045, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6048045', 'n_tokens_mistral': 1477, 'n_tokens_neox': 1437, 'n_words': 406}