关于复制HTML源文件到剪贴板格式

最新推荐文章于 2024-09-28 14:09:02 发布

liqj

最新推荐文章于 2024-09-28 14:09:02 发布

阅读量2k

点赞数

分类专栏： Delphi 文章标签： html integer string function class 文档

本文链接：https://blog.csdn.net/liqj/article/details/994280

版权

Delphi 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

// sClipFormat: array[TConvType] of string = ('HTML Format', 'Rich Text Format');

// TConvType = (ctHTML, ctRTF);

procedure TfrmMain.AddToClip(const psFormatText, psText: string;

const ConvType: TConvType);

var

bIsAddToClip, bIsAddSourceCodeTextOfFormat: boolean;

begin

bIsAddToClip := mmConvAfterAddToClip.Checked; // 是否加入剪贴板

bIsAddSourceCodeTextOfFormat := mmAddToClipTextIsSourceCode.Checked;

// 加到剪贴板文本格式是否源码

if not bIsAddToClip then

Exit;

if bIsAddSourceCodeTextOfFormat then

begin

if ConvType = ctHTML then

AddFormatToClipBoard(

GetHTMLClipFormat(psFormatText), // 转换 HTML 源码为剪贴板格式

psFormatText, // 剪贴板文本格式放 HTML 源码

sClipFormat[ConvType]) // 注册到剪贴板的格式

else

AddFormatToClipBoard(

psFormatText,

sClipFormat[ConvType]);

end

else

begin

if ConvType = ctHTML then

AddFormatToClipBoard(

GetHTMLClipFormat(psFormatText), // 转换 HTML 源码为剪贴板格式

psText, // 剪贴板文本格式放未转换前源码

sClipFormat[ConvType]) // 注册到剪贴板的格式

else

AddFormatToClipBoard(

psFormatText,

psText,

sClipFormat[ConvType]);

end;

end ;

procedure AddFormatToClipBoard(const psFormatText,psText,psFormat:string);

var

iFormatTextLen,iTextLen :integer;

uFormat :UINT;

hData: THandle;

pData: Pointer;

begin

// psFormat :

// Rich Text Format = 多信息文本格式到剪贴板

// HTML Format = 网页格式到剪贴板

iFormatTextLen := Length(psFormatText); // StrLen

iTextLen := Length(psText);

Clipboard.Open;

try

EmptyClipboard;

// Add Format = psFormat

if iFormatTextLen > 0 then

begin

uFormat := RegisterClipboardFormat(PChar(psFormat));

hData := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, iFormatTextLen + 1 );

try

pData := GlobalLock(hData);

try

Move(PChar(psFormatText)^,pData^,iFormatTextLen + 1 );

SetClipboardData(uFormat,hData);

finally

GlobalUnlock(hData);

end;

except

GlobalFree(hData);

raise;

end;

// Add Text Format = CF_TEXT

if iTextLen > 0 then

begin

hData := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, iTextLen + 1 );

try

pData := GlobalLock(hData);

try

Move(PChar(psText)^,pData^,iTextLen + 1 );

SetClipboardData(CF_TEXT,hData);

finally

GlobalUnlock(hData);

end;

except

GlobalFree(hData);

raise;

end;

finally

Clipboard.Close;

end;

end ;

function GetHTMLClipFormat(const psInput: string):string;

const

CRLF = System.sLineBreak;

sClipHead =

'Version:1.0' + CRLF + // 1.0 版本

'StartHTML:%.10d' + CRLF + // 从第一字符到 DocHand 前一字符数量

'EndHTML:%.10d' + CRLF + // 整个内容数量 ( 注：这里的数量最大 10 位数 )

'StartFragment:%.10d' + CRLF + // 第一个字符到  后数量

'EndFragment:%.10d' + CRLF + // 第一个字符到  前数量

'StartSelection:%.10d' + CRLF + // =StartFragment

'EndSelection:%.10d' + CRLF + // =EndFragment

'SourceURL:%s' + CRLF; // 来源地址 http://xx.xx.xx/xxx.htm -- about:blank

sDocHead = // html 文档中开始 -- 假设原来还没有

'<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">' + CRLF;

sStartFragment = '' ;

sEndFragment = '' ;

var

iBodyPosStart ,iBodyPosEnd ,

iStartPos, iEndPos, iHeadLen,iUtf8Pos :Integer;

ssOutput :TStringStream;

sHeadStr,sUtf8Str :string;

p :PChar;

begin

// 把剪贴板源码转换为剪贴板格式 HTML Format

Result := '' ;

if psInput = '' then Exit;

// ToDo: Check Utf8 Format : Utf8Encode(psInput)

// 检查是否已经过 UTF-8 编码 , 防止重复编码

iUtf8Pos := Pos( 'charset= utf-8">' ,LowerCase(psInput));

if iUtf8Pos= 0 then

sUtf8Str := Utf8Encode(psInput)

else

sUtf8Str := psInput;

{ 在 MSDN 中查找： HTML Clipboard Format

内容是 UTF8 格式

HeadStr -> ClipHead

DocHead -> HTML First Row

<html> |

<head> |

<title></title> | -> HTMLHead

<mete .... |

</head> |

<body class="g1"> |

<pre> |

<div .. | -> HTMLBody

</pre> |

</body> | -> HTMLEnd

</html> |

}

ssOutput := TStringStream.Create( '' );

try

sHeadStr := Format(sClipHead,[ 0 , 0 , 0 , 0 , 0 , 0 , 'about:blank' ]); // 先留位置

iHeadLen := Length(sHeadStr);

ssOutput.Write(sHeadStr[ 1 ],iHeadLen);

ssOutput.Write(sDocHead[ 1 ],Length(sDocHead));

// 确定 <body>...</body> 范围

iBodyPosEnd := Pos( '</body>' ,LowerCase(sUtf8Str));

if iBodyPosEnd =- 1 then iBodyPosEnd := Length(sUtf8Str);

iBodyPosStart := Pos( '<body' ,LowerCase(sUtf8Str));

Inc(iBodyPosStart, 4 );

while (iBodyPosStart< iBodyPosEnd) and (sUtf8Str[iBodyPosStart]<> '>' ) do

Inc(iBodyPosStart);

// 写源码头 <html>...<body>

ssOutput.Write(sUtf8Str[ 1 ],iBodyPosStart);

iStartPos := ssOutput.Position;

// 写内容开始标识

ssOutput.Write(sStartFragment,Length(sStartFragment));

// 写源码内容 <body> ... </body> 之间数据

//msOutput.Write((Pointer(Integer(@sUtf8Str[1]) + iBodyPosStart))^,

// iBodyPosEnd - iBodyPosStart -1 );

ssOutput.Write(sUtf8Str[iBodyPosStart+ 1 ],

iBodyPosEnd - iBodyPosStart - 1 );

iEndPos := ssOutput.Position ;

// 写内容结束标识

ssOutput.Write(sEndFragment,Length(sEndFragment));

// 写源码结尾 </body>...</html>

//msOutput.Write((Pointer(Integer(@sUtf8Str[1]) + iBodyPosEnd -1)^),

// Length(sUtf8Str) - iBodyPosEnd+1);

ssOutput.Write(sUtf8Str[iBodyPosEnd],

Length(sUtf8Str) - iBodyPosEnd + 1 );

sHeadStr := Format(sClipHead,[iHeadLen,ssOutput.Size,iStartPos,iEndPos,

iStartPos,iEndPos, 'about:blank' ]);

p := PChar(sHeadStr);

CopyMemory(PChar(ssOutput.DataString),p,iHeadLen);

Result := ssOutput.DataString;

finally

ssOutput.Free;

end;

end ;

liqj

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
1
评论
复制链接

分享到 QQ

分享到新浪微博

扫一扫

专栏目录