📄 strfuncs.pas
字号:
{-------------------------------------------------------------------------------
单元: StrFuncs.pas
作者: 姚乔锋 - yaoqiaofeng@sohu.com
日期: 2004.12.06
版本: 1.00
说明: 字符串处理单元
-------------------------------------------------------------------------------}
unit StrFuncs;
interface
uses
Windows, SysUtils, Classes, Math, StrUtils, FastStrings, Streams, MessageDlg;
const
{ NumberSwitch }
INT_CHINESE_NUMBER = 1; // 所有中文数字 包括简写与繁写
INT_CHINESE_SIMPLE_NUMBER = 2; // 所有简写的中文数字
INT_CHINESE_TRADITION_NUMBER = 3; // 所有繁写的中文数字;
INT_ARABIC_NUMERALS = 4; // 所有阿拉伯数字
{ TabulationSwitch }
INT_CREWEL = 1; // 双线形式的制表符;
INT_MONGLINE_WIDE = 2; // 单粗线形式的制表符
INT_MONGLINE_THIN = 3; // 单细线形式的制表符
{ CurrencySwitch }
INT_CURRENCY_CHINESE_SIMPLE = 1; // 格式化为中文简写货币形式的格式
INT_CURRENCY_CHINESE_TRADITION = 2; // 格式化为中文繁写货币形式的格式
INT_NUMERICAL_CHINESE_SIMPLE = 3; // 格式化为中文简写数值形式的格式
INT_NUMERICAL_CHINESE_TRADITION = 4; // 格式化为中文繁写数值形式的格式
{ WrapText }
CHARS_UNALLOWED_EOL : TSysCharSet = ['(', '[', '{', '<'];
CHARS_UNALLOWED_BOL : TSysCharSet = [')', ']', '}', '>', ';', ':', ',', '.', '?'];
type
Strings = array of string;
{ Fast Replace Text }
TFastTagReplaceProc = procedure (var Tag: string; const UserData: Integer);
{ TStrInfo 文件统计信息结构 }
TStrInfo = record
CharAmount : Integer; // 共有字符个数
LowerCase : Integer; // 小写字母个数
UpperCase : Integer; // 大写字母个数
Blank : Integer; // 英文空格个数
Tabs : Integer; // 制表符个数
Enter : Integer; // 回车符号个数
CtrlChar : Integer; // 控制字符个数
ArabicNumerals : Integer; // 英文数字个数
UnicodeChar : Integer; // 双字节字符个数
AnsiChar : Integer; // 单字节字符个数
end;
// UpperCase 用于将字符串小写字母即是转换为相对应的大写字母
function UpperCase(value : string): string;
// LowerCase 用于将字符串大写字母转换为相对应的小写字母
function LowerCase(value : string): string;
// MutualCase 用于将字符串原先的字母大小写形式互换
function MutualCase(value : string): string;
// FirstUpperCase 用于将字符串中每一个词词首的字母转换为大写字母
function FirstUpperCase(value : string): string;
// SBCCase 转换字符串的半角字符为全角字符
function SBCCase(value : widestring): string;
// DBCCase 转换字符串的全角字符为半角字符
function DBCCase(value : widestring): string;
// StrTrim 删除半角空格与全角空格
function StrTrim(value : widestring): string;
// StrTrimLeft 删除至字符串左边第一个非半角或全角空格的字符为止
function StrTrimLeft(value : widestring): string;
// StrTrimRight 删除至字符串右边第一个非半角或全角空格的字符为止
function StrTrimRight(value : widestring): string;
// StrTrimCtrlChar 删除字符串的所有控制字符即是ASCII码为#0 - #31的字符
function StrTrimCtrlChar(value : widestring): string;
// StrTrimLineBreak 删除字符串的所有回车换行符, 具体参照system的sLineBreak常量
function StrTrimLineBreak(value : widestring): string;
// OemToAnsi 将以OEM方式编码的字符串转换为ANSI编号
function OemToAnsi(value : AnsiString): AnsiString;
// AnsiToOem 将ANSI编码方式的字符串转换为以OEM方式编码的字符串
function AnsiToOem(value : AnsiString): AnsiString;
// Utf8ToAnsi 将以UTF8(一种Unicode种编码方式)方式编码的字符串转换为ANSI编码
function Utf8ToAnsi(value : UTF8String): AnsiString;
// AnsiToUtf8 将以ANSI编码方式的字符串转换为以UTF8方式编码的字符串
function AnsiToUtf8(value : AnsiString): UTF8String;
// Utf7ToAnsi 将以UTF7(一种Unicode种编码方式)方式编码的字符串转换为ANSI编码
function Utf7ToAnsi(value : AnsiString): WideString;
// AnsiToUtf7 将以ANSI编码方式的字符串转换为以UTF7方式编码的字符串
function AnsiToUtf7(value : WideString): AnsiString;
// AnsiToUnicode 将以ANSI编码方式的字符串转换为以UCS方式编码的字符串
function AnsiToUnicode(value : WideString): AnsiString;
// UnicodeToAnsi 将以UCS编码方式的字符串转换为以ANSI方式编码的字符串
function UnicodeToAnsi(value : AnsiString): WideString;
// DosToUnix 此函数是将DOS文本转换为UNIX文本
function DosToUnix(value : string): string;
// UnixToDos 此函数是将UNIX文本转换为DOS文本
function UnixToDos(value : string): string;
// UnMimeCode 将以MIME方式编码的字符串进行解码
function DecodeMime(value : string): string;
// UnQPCode 将以QP方式编码的字符串进行解码
function DecodeQP(value : string): string;
// UnHZCode 将以HZ方式编码的字符串进行解码
function DecodeHZ(value : string): string;
// StrSimilar 比较字符串的相似度 如 'Jim' and 'James' = 40%
function StrSimilar(s1, s2: string): Integer;
// StrUpset 将字符串倒转过来 此函数采用了宽字节 因此兼容双字节形式的编码
function StrUpset(value : WideString): widestring;
// StrCompare 比较字符串的相似度 如 StrCompare('David Stidolph','*St*') = true
function StrCompare(Source, Pattern: String): Boolean;
// StrStatistic 文本统计
function StrStatistic(value : wideString): TStrInfo;
// NumberSwitch 将字符串中的数字替换为指定格式的形式
function NumberSwitch(value : WideString; Source, Target : Integer): string;
// TabulationSwitch 格式化字符串中的制表符即是文本表格线
function TabulationSwitch(value : WideString; format : integer): string;
// CurrencySwitch 将字符串中的货币数值替换为指定格式的形式
function CurrencySwitch(value : string; Format : Integer): string; overload;
function CurrencySwitch(value : Real; Format : Integer): string; overload;
// ExtractHtml 提取HTML文档源代码的文本
function ExtractHtml(value :string):string;
// ExtractURL 提取字符串中的URL
function ExtractURL(value, Delimiter : string) : string;
// ExtractEmail 提取字符串的EMail地址
function ExtractEmail(value, Delimiter : String): string;
// TabToSpace 将TAB键的字符转换为相应宽度的空格
function TabToSpace(Value: string; TabWidth : Integer = 8): string;
// SpaceToTab 将字符串的空格转换为TAB键
function SpaceToTab(value : string; TabWidth : Integer = 8): string;
// GetRandomStr 生成随机的字符串
function GetRandomStr(Source : string; StrLen : Integer) : string;
// Dec2Bin 将十进制数字转换为二进制方式的数字字符串
function Dec2Bin(value : Integer; MinBit : Integer) : string;
// Bin2Dec 将二进制方式的数字字符串转换为十进制方式的数字
function Bin2Dec(const value : string) : Integer;
// Hex2Dec 将十六进制方式的数字字符串转换转换为十进制数方式的数字
function Hex2Dec(const value : string): Integer;
// Hex2Str 将十六进制方式的数字字符串转换转换为相应ASCII码的字符串
function Hex2Str(const value : String) : String;
// Mem2Hex 将字符串转换为十六进制方式的数字字符串
function Mem2Hex(Buffer: PChar; Size : Longint): string;
// Str2Hex 对于函数MemToHex的一个调用 主要是方便字符串变量类型的转换
function Str2Hex(value : string): string;
function StrAlignment(const value : string; PageWidth : Integer;
Alignment : TAlignment): string;
// StrWrap 对一段文本进行换行
function StrWrap(const Text, LineBreak: string; const Reorder : boolean;
const Hanging, FirstLine, LeftSpace, PageWidth : Integer;
const Break : String; const BreakMode : Integer {0 在字符前换行 1 在字符后换行}
): string;
// IsBIG5 是否是BIG5编码的汉字
function IsBIG5(value: string): Boolean;
{ IsGBK 是否是GBK编码的汉字
GBK编码（俗称大字符集）是中国大陆制订的、等同于UCS的新的中文编码扩展国家标
准。GBK工作小组于1995年10月，同年12月完成GBK规范。该编码标准兼容GB2312，共
收录汉字21003个、符号883个，并提供1894个造字码位，简、繁体字融于一库。
Windows95/98简体中文版的字库表层编码就采用的是GBK，通过GBK与UCS之间一一对
应的码表与底层字库联系。其第一字节的值在 16 进制的 81～FE 之间，第二字节
在 40～FE，除去xx7F一线。}
function IsGBK(value: string): Boolean;
{ IsGB 是否是GB编码的汉字
GB2312-80 GB2312编码大约包含6000多汉字（不包括特殊字符）,编码范围为第一位
b0-f7,第二位编码范围为a1-fe(第一位为cf时,第二位为a1-d3),计算一下汉字个数
为6762个汉字。当然还有其他的字符。包括控制键和其他字符大约7573个字符编码。}
function IsGB(value: string): Boolean;
// GBToBIG5 将以GB编码的汉字转换为以BIG5的编码形式
function GBToBIG5(value: String): string;
// BIG5ToGB 将以BIG5编码的汉字转换为以GB的编码形式
function BIG5ToGB(value: String): string;
// GBToTraditional 将汉字全部转换为汉字繁写形式
function GBKToTraditional(value : widestring): string;
// GBKToSimplified 将汉字全部转换为汉字简写形式
function GBKToSimplified(value : widestring): string;
// GBKToSpell 将汉字转换为汉字拼音
function GBKToSpell(value : widestring): string;
// GBKToSpellIndex 返回汉字拼音的首个字母
function GBKToSpellIndex(value: widestring): string;
// ChinesePunctuation 格式化为中文符号 会自动检测成对单引号或双引号
function ChinesePunctuation(value : widestring): string;
// EnglishPunctuation 格式化为英文符号
function EnglishPunctuation(value : widestring): string;
// ExpressionEval 表达式求值
function ExpressionEval(Expression: string; var Error: Boolean): Extended;
// NumToStr 任意进制的数转换为字符串
function NumToStr (mNumber: Integer; mScale: Byte;
mLength: Integer = 0): string;
// StrToNum 任意进制的字符串转换为数
function StrToNum (mDigit: string; mScale: Byte): Integer;
// RomanNumerals 返回十进制数字的罗马数字
function RomanNumerals(N: Integer): string;
implementation
{$R HZCodes.RES}
type
{ Fast Find&Replace Text }
TBMJumpTable = array[0..255] of Integer;
TFastPosProc = function (const aSource, aFind: Pointer; const aSourceLen,
aFindLen: Integer; var JumpTable: TBMJumpTable): Pointer;
TFastPosIndexProc = function (const aSourceString, aFindString: string;
const aSourceLen, aFindLen, StartPos: Integer;
var JumpTable: TBMJumpTable): Integer;
resourcestring
SBufferOverflow = 'Buffer overflow';
SInvalidUTF7 = 'Invalid UTF7';
const
SBCCaseChars : widestring = ' ！＂＃＄％＆＇（）＊＋，－。／０１２３４５６７８９：；＜＝＞？＠ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ［＼］＾＿｀ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ｛｜｝～';
DBCCasePunctuations : WideString = '\.,;:?!_-|()[]{}<>""''''';
SBCCasePunctuations : WideString = '、。，；：？！＿—｜〔〕［］｛｝《》“”‘’';
GBfirst = $A1A1; // first code of GB */
GBlast = $FEFE; // last code of GB */
GBsize = $5E5E; // GBlast - GBfirst + 1 */
BIGfirst = $A140; // first code of BIG
BIGlast = $F9FE; // last code of BIG
BIGsize = $58BF; // BIGlast - BIGfirst + 1
cScaleChar = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
sChineseSpell : array of Widestring;
sChineseTradition, sChineseSimple : widestring;
function UpperCase(value : string): string;
var
I : Integer;
begin
result := value;
for I := 1 to Length(result) do
If result[I] In ['a'..'z'] then
result[I] := Char(Ord(result[I])-32)
end;
function LowerCase(value : string): string;
var
I : Integer;
begin
result := value;
for I := 1 to Length(result) do
If result[I] In ['A'..'Z'] then
result[I] := Char(Ord(result[I])+32)
end;
function MutualCase(value : string): string;
var
I : Integer;
begin
result := value;
for I := 1 To Length(result) Do
case result[I] of
'a'..'z': result[I] := char(ord(result[I])-32);
'A'..'Z': result[I] := char(ord(result[I])+32);
end;
end;
function FirstUpperCase(value : string): string;
var
I : Integer;
begin
result := value;
for I := 1 To Length(result) do
If ( result[I] in ['a'..'z', 'A'..'Z'] ) then
begin
IF ( I = 1 ) or ( ( I > 1 ) and not
( result[I-1] in ['a'..'z', '0'..'9', 'A'..'Z'] ) ) then
begin
If ( result[I] in ['a'..'z'] ) then
result[i] := char(ord(result[i])-32)
end
else begin
if ( result[I] in ['A'..'Z'] ) then
result[i] := char(ord(result[i])+32);
end;
end;
end;
function SBCCase(value : widestring): string;
var
I : integer;
begin
for I := 1 To Length(value) Do
begin
If ord(value[i]) in [32 .. 126] then
value[i] := SBCCaseChars[ord(value[i])-31];
end;
result := value;
end;
function DBCCase(value : widestring): string;
var
I, P : integer;
begin
for I := 1 To Length(value) Do
begin
P := Pos(value[I], SBCCaseChars);
If (P <> 0) then value[i] := WideChar(p+31);;
end;
result := value;
end;
function StrTrim(value : widestring): string;
var
I : Integer;
begin
I := 1;
while I <= Length(value) do
begin
If value[i] = #32 then
Delete(value, i, 1)
else if value[I] = #161#161 then
Delete(value, i, 1)
else Inc(I, 1);
end;
result := value;
end;
function StrTrimLeft(value : widestring): string;
var
I : Integer;
begin
for I := 1 To Length(value) do
If (value[I] <> #32) and (value[I] <> #161#161) Then
break;
delete(value, 1, I-1);
result := value;
end;
function StrTrimRight(value : widestring): string;
var
I : Integer;
begin
for I := Length(value) downto 1 do
If (value[I] <> #32) and (value[I] <> #161#161) Then
break;
delete(value, I + 1, Length(value)-I);
result := value;
end;
function StrTrimCtrlChar(value : widestring): string;
var
I, K : Integer;
uR : widestring;
begin
SetLength(uR, length(value));
K := 0;
for I := 1 To Length(value) do
If not ((value[I] >= #0) and (value[I] <= #31)) then begin
Inc(K);
uR[K] := value[I];
end;
SetLength(uR, K);
result := uR;
end;
function StrTrimLineBreak(value : widestring): string;
var
I, K : Integer;
uR : widestring;
begin
SetLength(uR, length(value));
K := 0;
for I := 1 To Length(value) do
If not ((value[I] = #13) or (value[I] = #10)) then begin
Inc(K);
uR[K] := value[I];
end;
SetLength(uR, K);
result := uR;
end;
function OemToAnsi(value : AnsiString): AnsiString;
begin
SetLength(Result, Length(value));
If Length(Result) > 0 Then
{$IFDEF WIN32}
OemToCharBuff(PChar(value), PChar(Result), Length(Result));
{$ELSE}
OemToAnsiBuff(@value[1], @Result[1], Length(Result));
{$ENDIF}
end;
function AnsiToOem(value : AnsiString): AnsiString;
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -