{ --▽---------------------------▼-- 文字列処理関数 2002/08/22 StringUnitからSysUtilsに依存しない 部分を移動させて超軽量な 文字列処理ユニットとして独立。 2002/09/24 IsSameWideStrをコピーしてもってくる 2002/09/26 KataToHiraなどが実装 2002/10/02 StringPartsCompare系処理が大幅に変更 IsSameWideStrの名前が変わる 2002/10/08 DeleteStrにWideString版を追加 2002/11/01 RangeAnsiPosなどすべてにIgnoreCaseフラグをつけて 大小文字を区別しない検索を実装 2003/02/27 StrCountを実装 2003/03/04 CheckStrInTableを実装 2003/03/13 ChangeLineBreakesをStringUnit(Heavy)から移動 StringsReplace/ToEscapeSequence/FromEscapeSequenceを実装 2003/03/30 BackAnsiPosを追加 AnsiStringPartsCompare_Base/WideStringPartsCompare_Baseを interface節から削除、implementation節のforward参照に変更 WideStringsReplaceを作成 WideStringReplaceAllの内部を変更した 2003/06/15 ToEscapeSequence、FromEscapeSequence関数を テーブル変換方式にしてWideString対応に変更 ConvertHanKataToZenKata、ConvertZenKataToHanKataを実装した 2004/04/14 エンコード処理にヌル文字は\0に置き換える処理を追加 2004/09/19 文字列を繰り返して出力するStringOfStr関数を追加 2005/02/10 LCMapStringWを使ったToUpperCase/ToLowerCaseを追加 2005/09/22 ・順方向が[forward direction]、逆方向が[backward direction]という 英単語なのでAnsiPosをAnsiPosForward、BackAnsiPosをAnsiPosBackwardと 関数名を変更してみた。同様にWidePosも影響度が大きそうだけど気にしない。(^-^; だってリファクタリングに躊躇したくないし、、、 AnsiPosって関数名はSysUtilsと被るから不味いし。 ・InStr関数を作った 2005/12/29 ・InStr関数にIndexとCount引数版も追加した ・CheckWideCharInTableを作成した ・CheckStrInTableを使いやすく変更した 2006/04/22 ・WordWrap処理のために WideCharByteLength/CharIndexToByteIndex/ByteIndexToCharIndex/ByteLengthを 作成 2006/05/13 ・WideCharByteLengthに半角カナ系のバグがあったので修正 2006/08/02 ・OneTrimCharを追加した 2006/11/14 ・DeleteStrInTableを追加した 2007/05/02 ・CompareStringAnsiAPI/CompareStringWideAPIを追加した 2007/07/25 ・DeleteStrのWideString版が思いっきりバグっていた...5年目にして初めて使ったか... ・Include/ExcludeBothEndsStr関数を追加 2007/08/01 ・const群をConstUnit.pasに移動 ・IncludeFirstStr等をinterface部に記述 2007/08/06 ・IncludeLastPathDelim/ExcludeLastPathDelimを追加 2008/01/15 ・StringUnitLightからStringUnitに名前変更 2008/03/04 ・DelimiterCut.pasの関数を移動した 2008/11/18 ・testStringUnit.pasを作成、とりあえずtestTrim系処理を そちらに移動した。 ・文字列定数をConstUnit.pasに移動した。 2009/01/07 ・TTextLineBreakStyleMultiPlatformを排除してTLineBreakStyleに統一する ・ChangeLineBreakesをTTextLineBreakStyleMultiPlatformからTLineBreakStyleに変更 ・IsLineBreakをLineBreakStyleに名前変更 2010/03/04(木) ・ testコードをすべてtestStringUnit.pasに移行 動作させた ・ StringReplaceをオープン配列パラメータ指定として 引数に[str1, str2]という形での指定ができるようにした。 ・ CopyIndexを作成した //--▲---------------------------△-- } unit StringUnit; interface uses // Types, Windows, SysUtils, //Exception ConstUnit, uses_end; type //Typesユニットからコピペ TStringDynArray = array of string; TWideStringDynArray = array of WideString; type TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte); {mbSingle=半角 mbLead=全角の1バイト目 mbTrail=全角の2バイト目} function WidePosForward(const SubStr, S: WideString; IgnoreCase: Boolean = False): Integer; function WidePosBackward(const SubStr, S: WideString; IgnoreCase: Boolean = False): Integer; function AnsiPosForward(const SubStr, S: string; IgnoreCase: Boolean = False): Integer; function AnsiPosBackward(const SubStr, S: string; IgnoreCase: Boolean = False): Integer; function IsDBCSLeadChar(c:char):boolean; function ByteType(const S: string; Index: Integer): TMbcsByteType; function CharToByteLen(const S: string; MaxLen: Integer): Integer; function Trim(const S: WideString): WideString; function TrimLeft(const S: WideString): WideString; function TrimRight(const S: WideString): WideString; function AnsiStringPartsCompare (const SubStr, S: String; StrIndex: Integer): Boolean; function AnsiTextPartsCompare (const SubStr, S: String; StrIndex: Integer): Boolean; function WideStringPartsCompare (const SubStr, S: WideString; StrIndex: Integer): Boolean; function WideTextPartsCompare (const SubStr, S: WideString; StrIndex: Integer): Boolean; function WideStringFirstCompareCase(const SubStr, S: WideString; IgnoreCase: Boolean): Boolean; function WideStringLastCompareCase(const SubStr, S: WideString; IgnoreCase: Boolean): Boolean; type TCompareResult = (crEqual, crLessThan, crGreaterThan); function CompareStringAnsiAPI(const S1, S2: String; S1Index, S2Index, CompareS1Length, CompareS2Length: Integer; IgnoreCase: Boolean): TCompareResult; function CompareStringAnsi(const S1, S2: String; IgnoreCase: Boolean): TCompareResult; function CompareStringWideAPI(const S1, S2: WideString; S1Index, S2index, CompareS1Length, CompareS2Length: Integer; IgnoreCase: Boolean): TCompareResult; function CompareStringWide(const S1, S2: WideString; IgnoreCase: Boolean): TCompareResult; function RangeAnsiPosForward(const SubStr, S: String; Index: Integer = 1; Count: Integer = MaxInt; IgnoreCase: Boolean = False): Integer; function RangeAnsiPosBackward(const SubStr, S: String; Index: Integer = 1; Count: Integer = MaxInt; IgnoreCase: Boolean = False): Integer; function RangeWidePosForward(const SubStr, S: WideString; Index: Integer = 1; Count: Integer = MaxInt; IgnoreCase: Boolean = False): Integer; function RangeWidePosBackward(const SubStr, S: WideString; Index: Integer = 1; Count: Integer = MaxInt; IgnoreCase: Boolean = False): Integer; function DeleteStr(const S: String; const Index, Count: Integer): String; overload; function DeleteStr(const S: WideString; const Index, Count: Integer): WideString; overload; function CopyIndex(const S: String; StartIndex, EndIndex: Integer): String; overload; function CopyIndex(const S: WideString; StartIndex, EndIndex: Integer): WideString; overload; function KataToHira(const Source: WideString): WideString; function HiraToKata(const Source: WideString): WideString; function ZenkakuToHankaku(const Source: WideString): WideString; function HankakuToZenkaku(const Source: WideString): WideString; function ToUpperCase(const Source: WideString): WideString; function ToLowerCase(const Source: WideString): WideString; function ConvertHanKataToZenKata(const Source: WideString): WideString; function ConvertZenKataToHanKata(const Source: WideString): WideString; function ConvertNumericHanToZen(const Source: WideString): WideString; function ConvertNumericZenToHan(const Source: WideString): WideString; function ConvertSymbolHanToZen(const Source: WideString): WideString; function ConvertSymbolZenToHan(const Source: WideString): WideString; function ConvertAlphabetHanToZen(const Source: WideString): WideString; function ConvertAlphabetZenToHan(const Source: WideString): WideString; type TIncrementFlag = (ifByte, ifWord); function StrCount(const SubStr, S: String; IncFlag: TIncrementFlag = ifWord): Integer; type TInTable = (itUnknown, itAllInclude, itAllExclude, itPartInclude); function CheckStrInTable(const Str, Table: WideString): TInTable; function CheckWideCharInTable(const Char: WideChar; const Table: WideString): Boolean; //type TTextLineBreakStyleMultiPlatform = (tlbsmpCRLF, tlbsmpCR, tlbsmpLF); // //CRLF:Windows CR:Mac LF:Unix/Linux //function ChangeLineBreakes(const S: String; Style: TTextLineBreakStyleMultiPlatform): String; type TLineBreakStyle = (lbsCRLF, lbsCR, lbsLF ,lbsNoLineBreaks); //改行コードは、CRLF:Windows CR:旧Mac LF:Unix/Linux/MacOSX function ChangeLineBreakes(const S: String; Style: TLineBreakStyle): String; function LastLineBreakStyle(S: WideString): TLineBreakStyle; procedure ExcludeLineBreakProc(var S: WideString); function ExcludeLineBreak(const S: WideString): WideString; function LineBreakString(Style: TLineBreakStyle): String; function LineBreakStyle(S: WideString): TLineBreakStyle; function StringsReplace(const S: String; OldPatterns, NewPatterns: array of string; IgnoreCase: Boolean = False): string; //function StringReplaceAll(const S, OldPattern, NewPattern: String; // IgnoreCase: Boolean = False): String; function WideStringsReplace(const S: WideString; OldPatterns, NewPatterns: array of WideString; IgnoreCase: Boolean = False): WideString; //function WideStringReplaceAll(const S, OldPattern, NewPattern: WideString; // IgnoreCase: Boolean = False): WideString; function EncodeEscapeSequence(const Source: WideString): WideString; function DecodeEscapeSequence(const Source: WideString): WideString; function WideStringsWordReplace(const S: WideString; OldPatterns, NewPatterns: TWideStringDynArray; IgnoreCase: Boolean = False): WideString; function TrimLeftChar(S: WideString; Table: WideString): WideString; function TrimRightChar(S: WideString; Table: WideString): WideString; function TrimChar(S: WideString; Table: WideString): WideString; function OneTrimChar(S: WideString; Table: WideString): WideString; function GetTagText(StartTag, EndTag, TargetText: WideString; IgnoreCase: Boolean = False): WideString; function StringOfWideStr(Str: WideString; Count: Integer): WideString; type TWideCharByteLength = (wcblSingle, wcblMulti); function WideCharByteLength(source: WideChar): TWideCharByteLength; function InStr(const SubStr, S: string; IgnoreCase: Boolean=False): Boolean; overload; function InStr(const SubStr, S: string; Index, Count: Integer; IgnoreCase: Boolean=False): Boolean; overload; function InWideStr(const SubStr, S: WideString; IgnoreCase: Boolean=False): Boolean; function CharIndexToByteIndex(Source: WideString; CharIndex: Integer): Integer; function ByteIndexToCharIndex(Source: WideString; ByteIndex: Integer): Integer; function ByteLength(Source: WideString): Integer; function DeleteStrInTable(const S, Table: WideString; IgnoreCase: Boolean = False): String; //function DeleteStrInTable(const S, Table: String; // IgnoreCase: Boolean = False): String; overload; function IsFirstStr(const S: WideString; const SubStr: WideString): Boolean; function IsLastStr(const S: WideString; const SubStr: WideString): Boolean; function IncludeFirstStr(const S: WideString; const SubStr: WideString): WideString; function IncludeLastStr(const S: WideString; const SubStr: WideString): WideString; function IncludeBothEndsStr(const S: WideString; const SubStr: WideString): WideString; function ExcludeFirstStr(const S: WideString; const SubStr: WideString): WideString; function ExcludeLastStr(const S: WideString; const SubStr: WideString): WideString; function ExcludeBothEndsStr(const S: WideString; const SubStr: WideString): WideString; function IncludeLastPathDelim(const Path: WideString): WideString; function ExcludeLastPathDelim(const Path: WideString): WideString; //=が区切り文字だとして function DelimiterRight(Delimiter, Str: String): String; // AAA=BBB=CCC → CCC function DelimiterLeft(Delimiter, Str: String): String; // AAA=BBB=CCC → AAA function DelimiterLeftLong(Delimiter, Str: String): String; // AAA=BBB=CCC → AAA=BBB function DelimiterRightLong(Delimiter, Str: String): String; // AAA=BBB=CCC → BBB=CCC //という値を取得出来ます。 implementation //uses // SysUtils; function AnsiStringPartsCompare_Base(const S1, S2: String; S1Index, S2index, CompareLength: Integer; IgnoreCase: Boolean): Boolean; forward; function WideStringPartsCompare_Base(const S1, S2: WideString; S1Index, S2index, CompareLength: Integer; IgnoreCase: Boolean): Boolean; forward; //XPテスト procedure Check(A, B: TMbcsByteType); overload; begin if not(A = B) then begin Assert(False, 'エラーです'); end; end; function WidePosForward(const SubStr, S: WideString; IgnoreCase: Boolean = False): Integer; begin Result := RangeWidePosForward(SubStr, S, 1, MaxInt, IgnoreCase); end; function WidePosBackward(const Substr, S: WideString; IgnoreCase: Boolean = False): Integer; begin Result := RangeWidePosBackward(SubStr, S, 1, MaxInt, IgnoreCase); end; //SysUtilsとは違う形で実装 function AnsiPosForward(const SubStr, S: string; IgnoreCase: Boolean = False): Integer; begin Result := RangeAnsiPosForward(SubStr, S, 1, MaxInt, IgnoreCase); end; function AnsiPosBackward(const Substr, S: string; IgnoreCase: Boolean = False): Integer; begin Result := RangeAnsiPosBackward(SubStr, S, 1, MaxInt, IgnoreCase); end; //(*--▽---------------------------▼-- //SysUtilsの代わりに実装している機能 //※DBCSはDouble-Byte Character Setの略 //※MBCSはMultiByte Character Set の略 function IsDBCSLeadChar(c:char):boolean; begin Result:=c in [#$81..#$9F,#$E0..#$FC] end; {↓SysUtils.ByteTypeをWinAPIを使って実装 これを使うとSysUtilsをusesしなくても RangeAnsiPos(=AnsiPos)が実装できる} function ByteType(const S: string; Index: Integer): TMbcsByteType; var i: Integer; begin if Index = 1 then begin if IsDBCSLeadChar(S[Index]) then begin Result := mbLeadByte; end else begin Result := mbSingleByte; end; end else begin i := Index-1; while IsDBCSLeadChar(S[i]) do begin Dec(i); if i = 0 then break; end; if Odd(Index - i) then begin if IsDBCSLeadChar(S[Index]) then begin Result := mbLeadByte; end else begin Result := mbSingleByte; end; end else begin Result := mbTrailByte; end; end; end; //MaxLenまでの文字数までに何Byteあるかカウントする //SysUtilsにも同名関数があるが、別な実装方法(互換性不明) function CharToByteLen(const S: string; MaxLen: Integer): Integer; var i: Integer; SLen: Integer; SingleByteCount, DoubleByteCount: Integer; begin Result := 0; if MaxLen <= 0 then Exit; SLen := length(S); if SLen=0 then Exit; if SLen < MaxLen then MaxLen := SLen; SingleByteCount := 0; DoubleByteCount := 0; i:=1; while i<=SLen do begin case ByteType(S, i) of mbSingleByte: Inc(SingleByteCount); mbTrailByte: Inc(DoubleByteCount); mbLeadByte:; else Assert(False, 'エラー'); end; if (SingleByteCount + DoubleByteCount) = MaxLen then begin Result := i; Exit; end; Inc(i); end; Result := i - 1; end; function Trim(const S: WideString): WideString; var I, L: Integer; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); if I > L then Result := '' else begin while S[L] <= ' ' do Dec(L); Result := Copy(S, I, L - I + 1); end; end; function TrimLeft(const S: WideString): WideString; var I, L: Integer; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); Result := Copy(S, I, Maxint); end; function TrimRight(const S: WideString): WideString; var I: Integer; begin I := Length(S); while (I > 0) and (S[I] <= ' ') do Dec(I); Result := Copy(S, 1, I); end; //--▲---------------------------△--*) {------------------------------- // 文字列の範囲一致比較 AnsiStringPartsCompare AnsiTextPartsCompare AnsiStringPartsCompare_Base WideStringPartsCompare WideTextPartsCompare WideStringPartsCompare_Base 機能: 2つの文字列のIndex指定の比較 AnsiStringPartsCompare(S, SubStr, Index)とすると SのIndex位置からSubStrが一致するかどうかを判定できる Stringの方は大文字小文字を区別する Textの方は大文字小文字を区別しない 備考: _Baseの関数は 内部で使うエラー処理の無い関数 (エラーかどうか判定する分が無駄になるから) _Baseの方はRangeAnsiPosなどでも使用している。 履歴: 2002/09/29 最初はRangeAnsiPosの為に作ったが 応用範囲が広く他でも使用するようになったので 関数名InSameStrなどから変更した 2002/10/01 _Base関数でCompareStringA/WのAPIを使うようにしたので 大小文字関係ない比較が容易になった 2002/10/02 コード共通化のため_BaseでIgnoreFlagを使用して 比較に大小文字の影響を切り替えられるようにした AnsiStringPartsCompare_BaseでShiftJISの2Byte文字が 途中Byteで区切られている場合も正しく比較するようにした (多少OverHeadがあるが) 参考：Windows-API による文字列比較オブジェクト http://www.s34.co.jp/cpptechdoc/article/comparestring/index.html CompareString Windowsは上述のような様々な比較オプションに対応した文字列比較関数 CompareString を提供しています。 int CompareString( LCID Locale, DWORD dwCmpFlags, LPCTSTR lpString1, int cchCount1. LPCTSTR lpString2, int cchCount2 ); Locale : ロケール 値 意味 LOCALE_SYSTEM_DEFAULT システムのデフォルトロケール LOCALE_USER_DEFAULT 現在のユーザのデフォルトロケール dwCmpFlags : 比較オプション(下記の値の論理和による組み合わせ) 値 意味 NORM_IGNORECASE 大文字/小文字を区別しない NORM_IGNOREKANATYPE ひらがな/カタカナを区別しない NORM_IGNORENONSPACE 場所を取らない文字を区別しない NORM_IGNORESYMBOLS 記号を無視する NORM_IGNOREWIDTH 1バイト文字とそれと同じ2バイト文字を区別しない SORT_STRINGSORT 句読点を記号として扱う lpString1 : 第1文字列へのポインタ cchString1 : 第1文字列の文字数 -1のときはナル文字まで。 lpString2 : 第2文字列へのポインタ cchString2 : 第2文字列の文字数 -1のときはナル文字まで。 CompareStringは比較の結果、次の値を返します(比較失敗時は0)。 値 意味 CSTR_LESS_THAN 第1文字列 < 第2文字列 CSTR_EQUAL 第1文字列 = 第2文字列 CSTR_GRATER_THAN 第1文字列 > 第2文字列 //--▼----------------------▽--} function AnsiStringPartsCompareCase(const SubStr, S: String; StrIndex: Integer; IgnoreCase: Boolean): Boolean; begin Result := False; if (S = '') or (SubStr = '') then Exit; if (StrIndex <= 0) or ((Length(S)-Length(SubStr)+1) < StrIndex) then Exit; Result := AnsiStringPartsCompare_Base(SubStr, S, 1, StrIndex, Length(SubStr), IgnoreCase); end; function AnsiStringPartsCompare(const SubStr, S: String; StrIndex: Integer): Boolean; begin Result := AnsiStringPartsCompareCase(SubStr, S, StrIndex, False); end; function AnsiTextPartsCompare(const SubStr, S: String; StrIndex: Integer): Boolean; begin Result := AnsiStringPartsCompareCase(SubStr, S, StrIndex, True); end; function WideStringPartsCompareCase(const SubStr, S: WideString; StrIndex: Integer; IgnoreCase: Boolean): Boolean; begin Result := False; if (S = '') or (SubStr = '') then Exit; if (StrIndex <= 0) or ((Length(S)-Length(SubStr)+1) < StrIndex) then Exit; Result := WideStringPartsCompare_Base(SubStr, S, 1, StrIndex, Length(SubStr), IgnoreCase); end; function WideStringPartsCompare(const SubStr, S: WideString; StrIndex: Integer): Boolean; begin Result := WideStringPartsCompareCase(SubStr, S, StrIndex, False); end; function WideTextPartsCompare(const SubStr, S: WideString; StrIndex: Integer): Boolean; begin Result := WideStringPartsCompareCase(SubStr, S, StrIndex, True); end; function WideStringFirstCompareCase(const SubStr, S: WideString; IgnoreCase: Boolean): Boolean; begin Result := WideStringPartsCompareCase(SubStr, S, 1, IgnoreCase); end; function WideStringLastCompareCase(const SubStr, S: WideString; IgnoreCase: Boolean): Boolean; begin Result := WideStringPartsCompareCase(SubStr, S, Length(S)-Length(SubStr)+1, IgnoreCase); end; function AnsiStringPartsCompare_Base(const S1, S2: String; S1Index, S2Index, CompareLength: Integer; IgnoreCase: Boolean): Boolean; var CompareFlag: longword; begin if IgnoreCase then CompareFlag := NORM_IGNORECASE else CompareFlag := 0; if not (CompareStringA(LOCALE_USER_DEFAULT, CompareFlag, PChar(S1) + S1Index - 1, CompareLength, PChar(S2) + S2Index - 1, CompareLength) = CSTR_EQUAL) then begin Result := False; Exit; end; {以下はCompareStringAで一致している場合の処理} {↓ByteTypeの比較をする場合 先頭のByteTypeが一致していなければ不一致 ※CompareStringAで調べているのでここで比較する必要はないような気もする} if not (ByteType(S1, S1Index)=ByteType(S2, S2Index)) then begin Result := False; Exit; end; {↓最後の文字のByteTypeが2バイト文字(全角)の先頭バイト以外 つまり半角文字や2バイト文字の後方バイトなら CompareStringAの結果で一致したことがわかる} if ByteType(S2, S2Index+CompareLength-1)<>mbLeadByte then begin Result := True; Exit; end; {↓比較文字の最後が全角の先頭バイトで切れていないかどうか調べて} if ( S1Index+CompareLength <= Length(S1) ) and ( S2Index+CompareLength <= Length(S2) ) then begin {↓比較文字の最後が全角の先頭バイトなら 全角の後方バイトまで比較するようにしている} if CompareStringA(LOCALE_USER_DEFAULT, CompareFlag, PChar(S1) + S1Index - 1 + CompareLength - 1, 2, PChar(S2) + S2Index - 1 + CompareLength - 1, 2) = CSTR_EQUAL then begin Result := True; Exit; end else begin Result := False; Exit; end; end else begin {↓文字列の長さが短かった時も不正文字としてFalseを返す} Result := False; Exit; end; end; { --▽---------------------------▼-- ↑AnsiStringPartsCompare_Baseの実装は 2バイト文字の後方を考慮せずに、 単に以下のようになってもいいと思う function AnsiStringPartsCompare_Base(const S1, S2: String; S1Index, S2Index, CompareLength: Integer; IgnoreCase: Boolean): Boolean; var CompareFlag: longword; begin if IgnoreCase then CompareFlag := NORM_IGNORECASE else CompareFlag := 0; if CompareStringA(LOCALE_USER_DEFAULT, CompareFlag, PChar(S1) + S1Index - 1, CompareLength, PChar(S2) + S2Index - 1, CompareLength) = CSTR_EQUAL then begin Result := True; end else begin Result := False; end; //--▲---------------------------△-- } { --▽---------------------------▼-- //CompareStringAPIを使わない場合の実装 //大文字小文字は区別する function AnsiStringPartsCompare_Base(const S1, S2: String; S1Index, S2index, StrLength: Integer): Boolean; var i: Integer; begin Result := True; for i := 0 to StrLength-1 do begin if not (S1[S1Index+i] = S2[S2Index+i]) then begin Result := False; Break; end else if not (ByteType(S1, S1Index+i) = ByteType(S2, S2Index+i)) then begin Result := False; Break; end; end; end; //--▲---------------------------△-- } function WideStringPartsCompare_Base(const S1, S2: WideString; S1Index, S2index, CompareLength: Integer; IgnoreCase: Boolean): Boolean; var CompareFlag: longword; begin if IgnoreCase then CompareFlag := NORM_IGNORECASE else CompareFlag := 0; if CompareStringW(LOCALE_USER_DEFAULT, CompareFlag, PWideChar(S1) + S1Index - 1, CompareLength, PWideChar(S2) + S2Index - 1, CompareLength) = CSTR_EQUAL then begin Result := True; end else begin Result := False; end; end; { --▽---------------------------▼-- //CompareStringAPIを使わない場合の実装 //大文字小文字は区別する function WideStringPartsCompare_Base(const S1, S2: WideString; S1Index, S2index, StrLength: Integer): Boolean; var i: Integer; begin Result := True; for i := 0 to StrLength-1 do begin if S1[S1Index + i] <> S2[S2index + i] then begin Result := False; Exit; end; end; end; //--▲---------------------------△-- } function CompareStringAnsiAPI(const S1, S2: String; S1Index, S2Index, CompareS1Length, CompareS2Length: Integer; IgnoreCase: Boolean): TCompareResult; var CompareFlag: longword; begin if IgnoreCase then CompareFlag := NORM_IGNORECASE else CompareFlag := 0; case CompareStringA(LOCALE_USER_DEFAULT, CompareFlag, PChar(S1) + S1Index - 1, CompareS1Length, PChar(S2) + S2Index - 1, CompareS2Length) of CSTR_LESS_THAN: Result := crLessThan; CSTR_EQUAL: Result := crEqual; CSTR_GREATER_THAN: Result := crGreaterThan; else raise Exception.Create('CompareStringAの戻り値が不正です'); end; end; function CompareStringAnsi(const S1, S2: String; IgnoreCase: Boolean): TCompareResult; begin Result := CompareStringAnsiAPI(S1, S2, 1, 1, Length(S1), Length(S2), IgnoreCase); end; function CompareStringWideAPI(const S1, S2: WideString; S1Index, S2index, CompareS1Length, CompareS2Length: Integer; IgnoreCase: Boolean): TCompareResult; var CompareFlag: longword; begin if IgnoreCase then CompareFlag := NORM_IGNORECASE else CompareFlag := 0; case CompareStringW(LOCALE_USER_DEFAULT, CompareFlag, PWideChar(S1) + S1Index - 1, CompareS1Length, PWideChar(S2) + S2Index - 1, CompareS2Length) of CSTR_LESS_THAN: Result := crLessThan; CSTR_EQUAL: Result := crEqual; CSTR_GREATER_THAN: Result := crGreaterThan; else raise Exception.Create('CompareStringWの戻り値が不正です'); end; end; function CompareStringWide(const S1, S2: WideString; IgnoreCase: Boolean): TCompareResult; begin Result := CompareStringWideAPI(S1, S2, 1, 1, Length(S1), Length(S2), IgnoreCase); end; //--△----------------------▲-- {------------------------------- RangeAnsiPosForward RangeAnsiPosBackward //指定範囲を検索するAnsiPos 戻り値: 0:文字列が存在しない 0以外:検索文字列が存在するSのIndex 処理: 1Charずつ指定範囲を検査する 備考: 履歴: 2002/05/31 2002/07/14 Count が MaxInt の場合 EndIndex := Index + Count -1 が 負の値になるので EndIndex:Cardinalで対応をする 2002/08/18 StrPartsCompareで使っている ByteTypeをVCLのSysUtilsのものを 使わずにAPIを使うことにした 2002/08/22 ByteTypeをようやく正しく実装。 EndIndex:Cardinalを止めて Integerにして範囲を超えた時の負の値 をはじくようにした 2002/09/29 StrPartsCompareをAnsiStringPartsCompare_Base という名称に変えて IsSameStrをAnsiStringPartsCompareに変更 RangeAnsiPos/RangeBackAnsiPosと 実装が同じだったのでまとめた 2005/09/22 関数名変えた //--▼----------------------▽--} type TSearchDirection = (sdForward, sdBackward); {↑Forward: 前方検索 前から後ろへ検索する[→] Backward: 後方検索 後ろから前へ検索する[←]} function RangeAnsiPos_Base(const SubStr, S: String; Index, Count: Integer; IgnoreCase: Boolean; SearchDirection: TSearchDirection): Integer; var i: Integer; EndIndex: Integer; begin Result := 0; if (SubStr='') or (S='') then Exit; if not ( (1<=Index) and (Index<=Length(S)) ) then Exit; if not ( (Length(SubStr)<=Count) ) then Exit; if not (1<=Count) then Exit; {↓Index+Count-1を計算してMaxIntを超える場合 負の値になるので修正} EndIndex := Index + Count - 1; if (EndIndex < 0) or (Length(S) < EndIndex) then begin EndIndex := Length(S); end; { 123456789A __________←Sは10Char 4____9 ←Index=4/End=9の6Char ___ ←SubStr=3Char ___ ___ ___ ←ループは4から7←(9+1-3) 逆方向は7から4 } case SearchDirection of sdForward: begin for i := Index to EndIndex-Length(SubStr)+1 do begin if AnsiStringPartsCompare_Base(S, SubStr, i, 1, Length(SubStr), IgnoreCase) then begin Result := i; Break; end; end; end; sdBackward: begin for i := EndIndex-Length(SubStr)+1 downto Index do begin if AnsiStringPartsCompare_Base(S, SubStr, i, 1, Length(SubStr), IgnoreCase) then begin Result := i; Break; end; end; end; end; //case SearchMuki end; function RangeAnsiPosForward(const SubStr, S: String; Index: Integer = 1; Count: Integer = MaxInt; IgnoreCase: Boolean = False): Integer; begin Result := RangeAnsiPos_Base(SubStr, S, Index, Count, IgnoreCase, sdForward); end; function RangeAnsiPosBackward(const SubStr, S: String; Index: Integer = 1; Count: Integer = MaxInt; IgnoreCase: Boolean = False): Integer; begin Result := RangeAnsiPos_Base(SubStr, S, Index, Count, IgnoreCase, sdBackward); end; function RangeWidePos_Base(const SubStr, S: WideString; Index, Count: Integer; IgnoreCase: Boolean; SearchDirection: TSearchDirection): Integer; var i: Integer; EndIndex: Integer; begin Result := 0; if (SubStr='') or (S='') then Exit; if not ( (1<=Index) and (Index<=Length(S)) ) then Exit; if not ( (Length(SubStr)<=Count) ) then Exit; if not (1<=Count) then Exit; {↓Index+Count-1を計算してMaxIntを超える場合 負の値になるので修正} EndIndex := Index + Count - 1; if (EndIndex < 0) or (Length(S) < EndIndex) then begin EndIndex := Length(S); end; { 123456789A __________←Sは10Char 4____9 ←Index=4/End=9の6Char ___ ←SubStr=3Char ___ ___ ___ ←ループは4から7←(9+1-3) 逆方向は7から4 } case SearchDirection of sdForward: begin for i := Index to EndIndex-Length(SubStr)+1 do begin if WideStringPartsCompare_Base(S, SubStr, i, 1, Length(SubStr), IgnoreCase) then begin Result := i; Break; end; end; end; sdBackward: begin for i := EndIndex-Length(SubStr)+1 downto Index do begin if WideStringPartsCompare_Base(S, SubStr, i, 1, Length(SubStr), IgnoreCase) then begin Result := i; Break; end; end; end; end; //case SearchMuki end; function RangeWidePosForward(const SubStr, S: WideString; Index: Integer = 1; Count: Integer = MaxInt; IgnoreCase: Boolean = False): Integer; begin Result := RangeWidePos_Base(SubStr, S, Index, Count, IgnoreCase, sdForward); end; function RangeWidePosBackward(const SubStr, S: WideString; Index: Integer = 1; Count: Integer = MaxInt; IgnoreCase: Boolean = False): Integer; begin Result := RangeWidePos_Base(SubStr, S, Index, Count, IgnoreCase, sdBackward); end; //--△----------------------▲-- {----------------------------------------- // 戻り値を返すDelete 機能: 備考: おそらくメモリ確保を考えると Deleteをそのまま使うより動作は遅い 履歴: だいぶ以前 //--▼--------------------------------▽--} function DeleteStr(const S: String; const Index, Count: Integer): String; overload; //var // Str: String; //begin // Str := S; // Delete(Str, Index, Count); // Result := Str; //end; begin Result := S; Delete(Result, Index, Count); end; //戻り値のあるDelete(WideString版) function DeleteStr(const S: WideString; const Index, Count: Integer): WideString; overload; begin Result := S; Delete(Result, Index, Count); end; //最後から何文字かを削除する手続き procedure DeleteEndCount(var S: WideString; Count: Integer); begin Delete(S, Length(S)-Count+1, Count); end; //--△--------------------------------▲-- {---------------------------------------- // Indexを指定するCopy 機能: 通常のCopyはIndexとCountだが CopyIndexはStartIndexとEndIndexを指定する 備考: 履歴: 2010/03/04(木) //----------------------------------------} function CopyIndex(const S: String; StartIndex, EndIndex: Integer): String; overload; begin if StartIndex < 1 then StartIndex := 1; Result := Copy(S, StartIndex, EndIndex - StartIndex + 1); end; function CopyIndex(const S: WideString; StartIndex, EndIndex: Integer): WideString; overload; begin if StartIndex < 1 then StartIndex := 1; Result := Copy(S, StartIndex, EndIndex - StartIndex + 1); end; //---------------------------------------- {------------------------------- // WideStringで文字列変換 機能: APIのLCMapStringWを用いて ひらがな⇔カタカナ 全角⇔半角 大文字⇔小文字 の変換処理をします 引数説明: dwMapFlags:変換処理していフラグ 備考: KanaToHira/HiraToKana /ZenkakuToHankaku/HankakuToZenkaku /ToUpperCase/ToLowerCase 履歴: 2002/09/26 2005/02/10 ToUpper/ToLowerを追加 //--▼----------------------▽--} function MapStringW(const Source: WideString; dwMapFlags: Longword): WideString; var Len: Integer; begin Result := ''; Len := LCMapStringW(LOCALE_USER_DEFAULT, dwMapFlags, PWideChar(Source), -1, nil, 0); SetLength(Result, Len-1); LCMapStringW(LOCALE_USER_DEFAULT, dwMapFlags, PWideChar(Source), Length(Source)+1, PWideChar(Result), Len); //LOCALE_USER_DEFAULTの代わりに //GetUserDefaultLCIDを指定してもいいみたい end; function KataToHira(const Source: WideString): WideString; begin Result := MapStringW(Source, LCMAP_HIRAGANA); end; function HiraToKata(const Source: WideString): WideString; begin Result := MapStringW(Source, LCMAP_KATAKANA); end; function ZenkakuToHankaku(const Source: WideString): WideString; begin Result := MapStringW(Source, LCMAP_HALFWIDTH); end; function HankakuToZenkaku(const Source: WideString): WideString; begin Result := MapStringW(Source, LCMAP_FULLWIDTH); end; function ToUpperCase(const Source: WideString): WideString; begin Result := MapStringW(Source, LCMAP_UPPERCASE); end; function ToLowerCase(const Source: WideString): WideString; begin Result := MapStringW(Source, LCMAP_LOWERCASE); end; //--△----------------------▲-- {------------------------------- // カタカナを半角⇔全角相互変換します ConvertHanKataToZenKata ConvertZenKataToHanKata 機能: カタカナを変換します 引数説明: Source: 元の文字列 戻り値: 変換後の文字列 備考: 履歴: 2003/06/15 //--▼----------------------▽--} const ConvertTblHanKata: array[0..86] of WideString = ( 'ｶﾞ','ｷﾞ','ｸﾞ','ｹﾞ','ｺﾞ', 'ｻﾞ','ｼﾞ','ｽﾞ','ｾﾞ','ｿﾞ', 'ﾀﾞ','ﾁﾞ','ﾂﾞ','ﾃﾞ','ﾄﾞ', 'ﾊﾞ','ﾋﾞ','ﾌﾞ','ﾍﾞ','ﾎﾞ', 'ﾊﾟ','ﾋﾟ','ﾌﾟ','ﾍﾟ','ﾎﾟ', 'ｱ','ｲ','ｳ','ｴ','ｵ', 'ｶ','ｷ','ｸ','ｹ','ｺ', 'ｻ','ｼ','ｽ','ｾ','ｿ', 'ﾀ','ﾁ','ﾂ','ﾃ','ﾄ', 'ﾅ','ﾆ','ﾇ','ﾈ','ﾉ', 'ﾊ','ﾋ','ﾌ','ﾍ','ﾎ', 'ﾏ','ﾐ','ﾑ','ﾒ','ﾓ', 'ﾔ','ﾕ','ﾖ', 'ﾗ','ﾘ','ﾙ','ﾚ','ﾛ', 'ﾜ','ｦ','ﾝ', 'ｧ','ｨ','ｩ','ｪ','ｫ', 'ｬ','ｭ','ｮ', 'ｯ','ﾟ','ｰ','･','､','｡','｢','｣'); ConvertTblZenKata: array[0..86] of WideString = ( 'ガ','ギ','グ','ゲ','ゴ', 'ザ','ジ','ズ','ゼ','ゾ', 'ダ','ヂ','ヅ','デ','ド', 'バ','ビ','ブ','ベ','ボ', 'パ','ピ','プ','ペ','ポ', 'ア','イ','ウ','エ','オ', 'カ','キ','ク','ケ','コ', 'サ','シ','ス','セ','ソ', 'タ','チ','ツ','テ','ト', 'ナ','ニ','ヌ','ネ','ノ', 'ハ','ヒ','フ','ヘ','ホ', 'マ','ミ','ム','メ','モ', 'ヤ','ユ','ヨ', 'ラ','リ','ル','レ','ロ', 'ワ','ヲ','ン', 'ァ','ィ','ゥ','ェ','ォ', 'ャ','ュ','ョ', 'ッ','゜','ー','・','、','。','「','」'); function ConvertHanKataToZenKata(const Source: WideString): WideString; var HanKanaPatterns, ZenKanaPatterns: TWideStringDynArray; i: Integer; begin SetLength(HanKanaPatterns, High(ConvertTblHanKata)+1); for i := 0 to High(ConvertTblHanKata) do HanKanaPatterns[i] := ConvertTblHanKata[i]; SetLength(ZenKanaPatterns, High(ConvertTblZenKata)+1); for i := 0 to High(ConvertTblZenKata) do ZenKanaPatterns[i] := ConvertTblZenKata[i]; Result := WideStringsReplace(Source, HanKanaPatterns, ZenKanaPatterns); end; function ConvertZenKataToHanKata(const Source: WideString): WideString; var HanKanaPatterns, ZenKanaPatterns: TWideStringDynArray; i: Integer; SymbolCount: Integer; begin SymbolCount := 5; {↓全角→半角の場合、ひらがな記号『・、。「」』これらはカタカナにしなくてよい} SetLength(HanKanaPatterns, High(ConvertTblHanKata)+1 - SymbolCount); for i := 0 to High(ConvertTblHanKata) - SymbolCount do HanKanaPatterns[i] := ConvertTblHanKata[i]; SetLength(ZenKanaPatterns, High(ConvertTblZenKata)+1 - SymbolCount); for i := 0 to High(ConvertTblZenKata) - SymbolCount do ZenKanaPatterns[i] := ConvertTblZenKata[i]; Result := WideStringsReplace(Source, ZenKanaPatterns, HanKanaPatterns); end; //--△----------------------▲-- {------------------------------- // 英語と数値と記号半角⇔全角相互変換します ConvertAlphabetHanToZen ConvertAlphabetZenToHan ConvertNumericHanToZen ConvertNumericZenToHan ConvertSymbolHanToZen ConvertSymbolZenToHan 機能: 数値と記号を変換します 引数説明: Source: 元の文字列 戻り値: 変換後の文字列 備考: 履歴: 2006/04/05 //--▼----------------------▽--} const ConvertTblHanNumeric: WideString = ('0123456789-+/.'); ConvertTblZenNumeric: WideString = ('０１２３４５６７８９−＋／．'); function ConvertNumericHanToZen(const Source: WideString): WideString; var HanNumericPatterns, ZenNumericPatterns: TWideStringDynArray; i: Integer; begin SetLength(HanNumericPatterns, Length(ConvertTblHanNumeric)); for i := 0 to Length(ConvertTblHanNumeric)-1 do HanNumericPatterns[i] := ConvertTblHanNumeric[i+1]; SetLength(ZenNumericPatterns, Length(ConvertTblZenNumeric)); for i := 0 to Length(ConvertTblZenNumeric)-1 do ZenNumericPatterns[i] := ConvertTblZenNumeric[i+1]; Result := WideStringsReplace(Source, HanNumericPatterns, ZenNumericPatterns); end; function ConvertNumericZenToHan(const Source: WideString): WideString; var HanNumericPatterns, ZenNumericPatterns: TWideStringDynArray; i: Integer; begin SetLength(HanNumericPatterns, Length(ConvertTblHanNumeric)); for i := 0 to Length(ConvertTblHanNumeric)-1 do HanNumericPatterns[i] := ConvertTblHanNumeric[i+1]; SetLength(ZenNumericPatterns, Length(ConvertTblZenNumeric)); for i := 0 to Length(ConvertTblZenNumeric)-1 do ZenNumericPatterns[i] := ConvertTblZenNumeric[i+1]; Result := WideStringsReplace(Source, ZenNumericPatterns, HanNumericPatterns); end; const ConvertTblHanSymbol: WideString = ('!?$\%&#''"_' + '()[]<>{}' + '-+/*=.,;:@| '); ConvertTblZenSymbol: WideString = ('！？＄￥％＆＃’”＿' + '（）［］＜＞｛｝' + '−＋／＊＝．，；：＠｜　'); function ConvertSymbolHanToZen(const Source: WideString): WideString; var HanSymbolPatterns, ZenSymbolPatterns: TWideStringDynArray; i: Integer; begin SetLength(HanSymbolPatterns, Length(ConvertTblHanSymbol)); for i := 0 to Length(ConvertTblHanSymbol)-1 do HanSymbolPatterns[i] := ConvertTblHanSymbol[i+1]; SetLength(ZenSymbolPatterns, Length(ConvertTblZenSymbol)); for i := 0 to Length(ConvertTblZenSymbol)-1 do ZenSymbolPatterns[i] := ConvertTblZenSymbol[i+1]; Result := WideStringsReplace(Source, HanSymbolPatterns, ZenSymbolPatterns); end; function ConvertSymbolZenToHan(const Source: WideString): WideString; var HanSymbolPatterns, ZenSymbolPatterns: TWideStringDynArray; i: Integer; begin SetLength(HanSymbolPatterns, Length(ConvertTblHanSymbol)); for i := 0 to Length(ConvertTblHanSymbol)-1 do HanSymbolPatterns[i] := ConvertTblHanSymbol[i+1]; SetLength(ZenSymbolPatterns, Length(ConvertTblZenSymbol)); for i := 0 to Length(ConvertTblZenSymbol)-1 do ZenSymbolPatterns[i] := ConvertTblZenSymbol[i+1]; Result := WideStringsReplace(Source, ZenSymbolPatterns, HanSymbolPatterns); end; const ConvertTblHanAlphabet: WideString = // 全角英文字 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; const ConvertTblZenAlphabet: WideString = // 半角英文字 'ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ'+ 'ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ'; function ConvertAlphabetHanToZen(const Source: WideString): WideString; var HanAlphabetPatterns, ZenAlphabetPatterns: TWideStringDynArray; i: Integer; begin SetLength(HanAlphabetPatterns, Length(ConvertTblHanAlphabet)); for i := 0 to Length(ConvertTblHanAlphabet)-1 do HanAlphabetPatterns[i] := ConvertTblHanAlphabet[i+1]; SetLength(ZenAlphabetPatterns, Length(ConvertTblZenAlphabet)); for i := 0 to Length(ConvertTblZenAlphabet)-1 do ZenAlphabetPatterns[i] := ConvertTblZenAlphabet[i+1]; Result := WideStringsReplace(Source, HanAlphabetPatterns, ZenAlphabetPatterns); end; function ConvertAlphabetZenToHan(const Source: WideString): WideString; var HanAlphabetPatterns, ZenAlphabetPatterns: TWideStringDynArray; i: Integer; begin SetLength(HanAlphabetPatterns, Length(ConvertTblHanAlphabet)); for i := 0 to Length(ConvertTblHanAlphabet)-1 do HanAlphabetPatterns[i] := ConvertTblHanAlphabet[i+1]; SetLength(ZenAlphabetPatterns, Length(ConvertTblZenAlphabet)); for i := 0 to Length(ConvertTblZenAlphabet)-1 do ZenAlphabetPatterns[i] := ConvertTblZenAlphabet[i+1]; Result := WideStringsReplace(Source, ZenAlphabetPatterns, HanAlphabetPatterns); end; //--△----------------------▲-- {------------------------------- // 文字列の数を求める 引数説明: SubStr:検索する単語 S:検索される文字列 戻り値: 見つからない場合:0 後は個数 備考: 2バイト対応 StrCount('ＡＡ', 'ＡＡＡ', ifWord) → 1 単語分を飛ばす StrCount('ＡＡ', 'ＡＡＡ', ifByte) → 2 1バイトだけ増加して調べる 履歴: 2003/02/19 //--▼----------------------▽--} function StrCount(const SubStr, S: String; IncFlag: TIncrementFlag = ifWord): Integer; var i, j: Integer; SubStrLength, SLength: Integer; SameCheckFlag: Boolean; begin Result := 0; if (SubStr='') or (S='') then Exit; SubStrLength := Length(SubStr); SLength := Length(S); i := 1; while i <= SLength do begin {↓先頭文字が検索したい文字と一致するなら} if (S[i] = SubStr[1]) and (ByteType(S, i) = ByteType(SubStr, 1)) then begin SameCheckFlag := True; for j := 2 to SubStrLength do begin if (SubStr[j]<>S[i+j-1]) or (ByteType(SubStr, j)<>ByteType(S, i+j-1)) then begin SameCheckFlag := False; break; end end; //for j if SameCheckFlag then begin Inc(Result); if IncFlag = ifWord then Inc(i, SubStrLength-1); end; end; Inc(i); end; end; //--△----------------------▲-- {------------------------------- // CheckStrInTable 機能: StrがTable文字列の中の文字群に 『すべて含まれるか』AllInclude もしくは 『すべて含まれないか』AllExclude を判定します。 引数説明: Str:判定文字列 Table:文字列テーブル 戻り値: InTable itUnknown 判定不可能(空文字が入るから) itAllInclude すべて含まれる itAllExclude ひとつも含まれない itPartInclude 含まれるものもある 動作結果は testCheckStrInTable を参照のこと 備考: 例えばTable="0123456789"とセットすると 履歴: 2002/03/10 2005/12/28 わかりににくいので InTableフラグで動作を変更するのではなく 戻り値でAllIncludeとAllExcludeを判断するようにした //--▼----------------------▽--} //function CheckStrInTable(const Str, Table: WideString; // InTable: TStrInTable): Boolean; //var // ExistCondition: Boolean; // i: Integer; //begin // ExistCondition := False; // case InTable of // vitAllInclude: ExistCondition := True; // vitAllExclude: ExistCondition := False; // else // Assert(False, 'InTableの不正指定'); //// raise Exception.Create('InTableの不正指定'); // end; // // Result := True; // for i:=1 to Length(Str) do // begin // if (AnsiPosForward(Str[i], Table)=0)=ExistCondition then // begin // Result := False; // Break; // end; // end; //end; // //procedure testCheckStrInTable; //begin // Check(True, CheckStrInTable('123', '0123456789', vitAllInclude)); // Check(False, CheckStrInTable('ABC', '0123456789', vitAllInclude)); // Check(False, CheckStrInTable('ABC123', '0123456789', vitAllInclude)); // Check(False, CheckStrInTable('123', '0123456789', vitAllExclude)); // Check(True, CheckStrInTable('ABC', '0123456789', vitAllExclude)); // Check(False, CheckStrInTable('ABC123', '0123456789', vitAllExclude)); //end; function CheckStrInTable(const Str, Table: WideString): TInTable; var i: Integer; begin Result := itUnknown; {←Strが空文字の場合にはこれを返す} if (Length(Str)=0) or (Length(Table)=0) then Exit; if CheckWideCharInTable(Str[1], Table) then begin {↓文字列が含まれるなら} Result := itAllInclude; end else begin {↓文字列が含まれないなら} Result := itAllExclude; end; for i:=2 to Length(Str) do begin if CheckWideCharInTable(Str[i], Table) then begin {↓文字列が含まれる場合} if Result <> itAllInclude then begin Result := itPartInclude; break; end; end else begin {↓文字列が含まれない場合} if Result <> itAllExclude then begin Result := itPartInclude; break; end; end; end; end; //--△----------------------▲-- {------------------------------- // CheckWideCharInTable 機能: Charが文字列に含まれるかどうかを調べる関数 備考: 高速化できそうだがとりあえずWidePosForwardで実装した 履歴: 2005/12/29 //--▼----------------------▽--} function CheckWideCharInTable(const Char: WideChar; const Table: WideString): Boolean; begin Result := (1 <= WidePosForward(Char, Table)); end; //--△----------------------▲-- {------------------------------- // 文字列が含まれるかどうか判断します 備考: AnsiPosの条件判断をいつも間違うのでちょっと作った AnsiPosは文字列が無い場合0を返しますね。 履歴: 2005/09/22 //--▼----------------------▽--} function InStr(const SubStr, S: string; IgnoreCase: Boolean=False): Boolean; overload; begin Result := (1 <= (AnsiPosForward(SubStr, S, IgnoreCase))); end; function InStr(const SubStr, S: string; Index, Count: Integer; IgnoreCase: Boolean=False): Boolean; overload; begin Result := (1 <= (RangeAnsiPosForward(SubStr, S, Index, Count, IgnoreCase))); end; function InWideStr(const SubStr, S: WideString; IgnoreCase: Boolean=False): Boolean; begin Result := (1 <= (WidePosForward(SubStr, S, IgnoreCase))); end; //--△----------------------▲-- {------------------------------- //文字列の改行コードをそろえます 機能: 改行コードを WinCRLF形式 MacCR形式 UnixLF形式 で相互変換します 引数説明: S: 元の文字列 Style: 変換する形式指定 戻り値: 変換された文字列 備考: 履歴: 2002/03/16 2009/01/07 //--▼----------------------▽--} function ChangeLineBreakes(const S: String; Style: TLineBreakStyle): String; type StrArray = array[1..$10] of char; //CRとLFがいくつあるかをカウントする function CountCRLF(const S: String): Integer; var i: Integer; PS: ^StrArray; begin Result := 0; PS := @S[1]; for i := 1 to Length(S) do begin case PS^[i] of CR: begin Inc(Result); end; LF: begin Inc(Result); end; else ; end; end; //for i end; var ReadIndex, WriteIndex, SourceLength: Integer; ReplaceStr: array[0..1] of Char; ReplaceStrLen: Integer; PResultStr, PSourceStr: ^StrArray; begin if S = '' then begin Result := ''; Exit; end; SourceLength := Length(S); case Style of lbsCRLF: begin ReplaceStr := CR+LF; ReplaceStrLen := 2; SetLength(Result, SourceLength+CountCRLF(S)); //↑最大で改行コードの数だけ // 文字列長が増加する可能性があるので // メモリを確保している end; lbsCR: begin ReplaceStr := CR+#0; ReplaceStrLen := 1; SetLength(Result, SourceLength); end; lbsLF: begin ReplaceStr := LF+#0; ReplaceStrLen := 1; SetLength(Result, SourceLength); end; lbsNoLineBreaks: begin ReplaceStr := #0+#0; ReplaceStrLen := 0; SetLength(Result, SourceLength-CountCRLF(S)); //↑改行コードを削除するので // CRLFの分、文字列長が短くなるのでその分を引いて // メモリを確保している end; else ReplaceStrLen := 0; Assert(False, ''); end; PResultStr := @Result[1]; PSourceStr := @S[1]; ReadIndex := 1; WriteIndex := 1; while (ReadIndex <= SourceLength-1) do begin //↓文字がCRかLFの場合は改行コード挿入処理へ // CRLFかLFCRの場合は読み込み位置を1足している case PSourceStr^[ReadIndex] of CR: begin if PSourceStr^[ReadIndex+1]=LF then Inc(ReadIndex); end; LF: begin if PSourceStr^[ReadIndex+1]=CR then Inc(ReadIndex); //改行コード挿入コードへ end; //↓文字がCRかLFではない場合は // Source文字をResult文字にコピーしている else PResultStr^[WriteIndex] := PSourceStr^[ReadIndex]; Inc(WriteIndex); Inc(ReadIndex); Continue; end; //case //改行コード挿入処理 PResultStr^[WriteIndex ] := ReplaceStr[0]; PResultStr^[WriteIndex+1] := ReplaceStr[1]; inc(WriteIndex, ReplaceStrLen); Inc(ReadIndex); end; //while //↓読み込み位置が文字列の最後のときの場合だけ // ループ外で処理する。 // PSourceStr^[ReadIndex+1]を読み込むとエラーになるが // その防止処理をループ毎で判定したくないため。 if ReadIndex = SourceLength then begin case PSourceStr^[SourceLength] of //↓文字がCRかLFの場合は改行コード挿入処理へ CR, LF: begin //改行コード挿入処理 PResultStr^[WriteIndex ] := ReplaceStr[0]; PResultStr^[WriteIndex+1] := ReplaceStr[1]; Inc(WriteIndex, ReplaceStrLen); end; //↓文字がCRかLFではない場合は // Source文字をResult文字にコピーしている else PResultStr^[WriteIndex] := PSourceStr^[SourceLength]; Inc(WriteIndex); end; //case end; //SourceLength < ReadIndex になっている場合は //文字の最後が改行変換されている場合なので //別に何もしない SetLength(Result,WriteIndex-1); end; (*--▽---------------------------▼-- //2009/01/07 //高速さが失われるかもしれないので必ず既存コードは残しておく。 function ChangeLineBreakes(const S: String; Style: TTextLineBreakStyleMultiPlatform): String; type StrArray = array[1..$10] of char; //CRとLFがいくつあるかをカウントする function CountCRLF(const S: String): Integer; var i: Integer; PS: ^StrArray; begin Result := 0; PS := @S[1]; for i := 1 to Length(S) do begin case PS^[i] of CR: begin Inc(Result); end; LF: begin Inc(Result); end; else ; end; end; //for i end; var ReadIndex, WriteIndex, SourceLength: Integer; ReplaceChar: array[0..1] of Char; ReplaceStrLen: Integer; PResultStr, PSourceStr: ^StrArray; begin if S = '' then begin Result := ''; Exit; end; SourceLength := Length(S); case Style of tlbsmpCRLF: begin ReplaceChar := CR+LF; ReplaceStrLen := 2; SetLength(Result, SourceLength+CountCRLF(S)); //↑最大で改行コードの数だけ // 文字列長が増加する可能性があるので // メモリを確保している end; tlbsmpCR: begin ReplaceChar := CR+#0; ReplaceStrLen := 1; SetLength(Result, SourceLength); end; tlbsmpLF: begin ReplaceChar := LF+#0; ReplaceStrLen := 1; SetLength(Result, SourceLength); end; else ReplaceStrLen := 0; Assert(False, ''); end; PResultStr := @Result[1]; PSourceStr := @S[1]; ReadIndex := 1; WriteIndex := 1; while (ReadIndex <= SourceLength-1) do begin case PSourceStr^[ReadIndex] of CR: begin if PSourceStr^[ReadIndex+1]=LF then Inc(ReadIndex); //改行コード挿入コードへ end; LF: begin if PSourceStr^[ReadIndex+1]=CR then Inc(ReadIndex); //改行コード挿入コードへ end; else PResultStr^[WriteIndex] := PSourceStr^[ReadIndex]; Inc(WriteIndex); Inc(ReadIndex); Continue; end; //case //改行コード挿入 PResultStr^[WriteIndex ] := ReplaceChar[0]; PResultStr^[WriteIndex+1] := ReplaceChar[1]; inc(WriteIndex, ReplaceStrLen); Inc(ReadIndex); end; //while if ReadIndex = SourceLength then begin case PSourceStr^[SourceLength] of CR, LF: begin //改行コード挿入 PResultStr^[WriteIndex ] := ReplaceChar[0]; PResultStr^[WriteIndex+1] := ReplaceChar[1]; Inc(WriteIndex, ReplaceStrLen); end; else PResultStr^[WriteIndex] := PSourceStr^[SourceLength]; Inc(WriteIndex); end; //case end; //SourceLength < ReadIndex の場合 //=文字の最後が???CRLFか???LFCRの場合 //何もしない SetLength(Result,WriteIndex-1); end; //--▲---------------------------△--*) //--△----------------------▲-- {------------------------------- // 文字列の最後の改行コードを調べる関数 戻り値: type TLineBreakStyle = (lbsCRLF, lbsCR, lbsLF ,lbsNoLineBreaks); で定義される値が戻る 備考: 履歴: 2003/09/15 作成 //--▼----------------------▽--} function LastLineBreakStyle(S: WideString): TLineBreakStyle; begin Result := lbsNoLineBreaks; if 2 <= Length(S) then begin if (S[Length(S)-1]=#13) and (S[Length(S)]=#10) then begin Result := lbsCRLF; Exit; end; end; if 1 <= Length(S) then begin case S[Length(S)] of #13: begin Result := lbsCR; Exit; end; #10: begin Result := lbsLF; Exit; end; end; end; end; //--△----------------------▲-- {------------------------------- // 文字列の最後の改行コードを取り除く手続き 備考: 履歴: 2009/01/15 作成 //--▼----------------------▽--} procedure ExcludeLineBreakProc(var S: WideString); begin DeleteEndCount(S, Length(LineBreakString(LastLineBreakStyle(S)))) end; function ExcludeLineBreak(const S: WideString): WideString; begin Result := S; ExcludeLineBreakProc(Result); end; //--△----------------------▲-- {------------------------------- // 改行スタイルから文字に変換する関数 備考: 履歴: 2009/01/15 作成 //--▼----------------------▽--} function LineBreakString(Style: TLineBreakStyle): String; begin case Style of lbsCRLF: Result := CRLF; lbsCR: Result := CR; lbsLF: Result := LF; lbsNoLineBreaks: Result := EmptyStr; end; end; //--△----------------------▲-- {------------------------------- // 文字が改行コードかどうか調べる関数 戻り値: #13#10/#13/#10、それぞれを調べることができる。 備考: 履歴: 2007/06/18 作成 //--▼----------------------▽--} function LineBreakStyle(S: WideString): TLineBreakStyle; begin Result := lbsNoLineBreaks; if 2 = Length(S) then begin if (S[Length(S)-1]=#13) and (S[Length(S)]=#10) then begin Result := lbsCRLF; Exit; end; end; if 1 = Length(S) then begin case S[Length(S)] of #13: begin Result := lbsCR; Exit; end; #10: begin Result := lbsLF; Exit; end; end; end; end; //--△----------------------▲-- {------------------------------- // 文字列を一気に置き換えます 機能: StringReplaceと似ている機能だけど '\\'→'\' '\r'→#13 等のように複数文字列を一気に置き換えるので 結果として'\\r'→'\r'になります。 引数説明: S: 変更したい文字列 OldPatterns, NewPatterns: 変更文字列配列 二つの文字列配列は大きさは同じにしておく必要がある 戻り値: 変更後の文字列 備考: 履歴: 2003/03/13 2007/09/02 OldPatternsの指定がなかったり NewとOldの個数があっていない場合 ResultにEmptyStrではなくSを返すようにした //--▼----------------------▽--} function StringsReplace(const S: String; OldPatterns, NewPatterns: array of string; IgnoreCase: Boolean = False): string; function PlusValue(Value: Integer): Integer; begin if 0 < Value then Result := Value else Result := 0; end; type TCompareFunction = function(const SubStr, S: String; StrIndex: Integer): Boolean; var ReadIndex, WriteIndex, SourceLength: Integer; ResultLength: Integer; i, j: Integer; SameFlag: Boolean; CompareFunction: TCompareFunction; begin Result := ''; if Length(OldPatterns) = 0 then begin Result := S; Exit; end; if ( Length(OldPatterns) <> Length(NewPatterns) ) then begin Result := S; Exit; end; if S = '' then Exit; SourceLength := Length(S); ResultLength := SourceLength; for i := 0 to Length(OldPatterns)-1 do begin if OldPatterns[i] <> '' then begin ResultLength := ResultLength + PlusValue(Length(NewPatterns[i])-Length(OldPatterns[i]))*StrCount(OldPatterns[i], S); end; end; SetLength(Result, ResultLength); if IgnoreCase then CompareFunction := AnsiTextPartsCompare else CompareFunction := AnsiStringPartsCompare; ReadIndex := 1; WriteIndex := 1; while (ReadIndex <= SourceLength) do begin SameFlag := False; for i := 0 to Length(OldPatterns)-1 do begin if CompareFunction(OldPatterns[i], S, ReadIndex) then begin SameFlag := True; for j := 0 to Length(NewPatterns[i])-1 do begin Result[WriteIndex+j] := (NewPatterns[i])[j+1]; end; Inc(WriteIndex, Length(NewPatterns[i])); Inc(ReadIndex, Length(OldPatterns[i])); break; end; //if end; //for if SameFlag = False then begin Result[WriteIndex] := S[ReadIndex]; Inc(WriteIndex); Inc(ReadIndex); end; end; //while SetLength(Result,WriteIndex-1); end; //function StringReplaceAll(const S, OldPattern, NewPattern: String; // IgnoreCase: Boolean = False): String; //var // OldPatterns, NewPatterns: TStringDynArray; //begin // SetLength(OldPatterns, 1); // SetLength(NewPatterns, 1); // // OldPatterns[0] := OldPattern; NewPatterns[0] := NewPattern; // // Result := StringsReplace(S, OldPatterns, NewPatterns, IgnoreCase); //end; //--△----------------------▲-- {------------------------------- // 文字列を一気に置き換えます 機能: 自作のStringsReplaceからのコピー StringをWideStringに変更したのみ。 備考: 説明・機能などすべてStringsReplaceの通り 履歴: 2003/03/30 2007/09/02 OldPatternsの指定がなかったり NewとOldの個数があっていない場合 ResultにEmptyStrではなくSを返すようにした //--▼----------------------▽--} function WideStringsReplace(const S: WideString; OldPatterns, NewPatterns: array of WideString; IgnoreCase: Boolean = False): WideString; function PlusValue(Value: Integer): Integer; begin if 0 < Value then Result := Value else Result := 0; end; type TCompareFunction = function(const SubStr, S: WideString; StrIndex: Integer): Boolean; var ReadIndex, WriteIndex, SourceLength: Integer; ResultLength: Integer; i, j: Integer; SameFlag: Boolean; CompareFunction: TCompareFunction; begin Result := ''; if Length(OldPatterns) = 0 then begin Result := S; Exit; end; if ( Length(OldPatterns) <> Length(NewPatterns) ) then begin Result := S; Exit; end; if S = '' then Exit; SourceLength := Length(S); ResultLength := SourceLength; for i := 0 to Length(OldPatterns)-1 do begin if OldPatterns[i] <> '' then begin ResultLength := ResultLength + PlusValue(Length(NewPatterns[i])-Length(OldPatterns[i]))*StrCount(OldPatterns[i], S); end; end; SetLength(Result, ResultLength); if IgnoreCase then CompareFunction := WideTextPartsCompare else CompareFunction := WideStringPartsCompare; ReadIndex := 1; WriteIndex := 1; while (ReadIndex <= SourceLength) do begin SameFlag := False; for i := 0 to Length(OldPatterns)-1 do begin if CompareFunction(OldPatterns[i], S, ReadIndex) then begin SameFlag := True; for j := 0 to Length(NewPatterns[i])-1 do begin Result[WriteIndex+j] := (NewPatterns[i])[j+1]; end; Inc(WriteIndex, Length(NewPatterns[i])); Inc(ReadIndex, Length(OldPatterns[i])); break; end; //if end; //for if SameFlag = False then begin Result[WriteIndex] := S[ReadIndex]; Inc(WriteIndex); Inc(ReadIndex); end; end; //while SetLength(Result,WriteIndex-1); end; //--△----------------------▲-- { --▽---------------------------▼-- //リファクタリングしたので没 function WideStringReplaceAll(const S, OldPattern, NewPattern: WideString): Widestring; var SearchStr, Patt, NewStr: WideString; Offset: Integer; begin SearchStr := S; Patt := OldPattern; NewStr := S; Result := ''; while SearchStr <> '' do begin Offset := Pos(Patt, SearchStr); if Offset = 0 then begin Result := Result + NewStr; Break; end; Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern; NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt); SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt); end; end; //--▲---------------------------△-- } //function WideStringReplaceAll(const S, OldPattern, NewPattern: WideString; // IgnoreCase: Boolean = False): Widestring; //var // OldPatterns, NewPatterns: TWideStringDynArray; //begin // SetLength(OldPatterns, 1); // SetLength(NewPatterns, 1); // // OldPatterns[0] := OldPattern; NewPatterns[0] := NewPattern; // // Result := WideStringsReplace(S, OldPatterns, NewPatterns, IgnoreCase); //end; {------------------------------- // エスケープシーケンス変換関数 EncodeEscapeSequence CRLF→\r\nにする DecodeEscapeSequence \r\n→CRLFにする 機能: エスケープシーケンスと 普通の文字列を相互変換します 引数説明: Source: 元の文字列 戻り値: 変換後の文字列 備考: \r/\n/\t に対応している 履歴: 2003/03/13 2003/06/15 WideStringでの実装に変更 2004/04/13 NULL文字を\0に置き換える処理を追加 //--▼----------------------▽--} const ConvertTblEncodeEscapeSequence: array[0..4] of WideString = ('\r', '\n', '\t', '\\', '\0'); ConvertTblDecodeEscapeSequence: array[0..4] of WideString = ( CR, LF, TAB, '\', NULLStr); function EncodeEscapeSequence(const Source: WideString): WideString; var OldPatterns, NewPatterns: TWideStringDynArray; i: Integer; begin SetLength(OldPatterns, High(ConvertTblEncodeEscapeSequence)+1); SetLength(NewPatterns, High(ConvertTblEncodeEscapeSequence)+1); for i := 0 to High(ConvertTblEncodeEscapeSequence) do begin OldPatterns[i] := ConvertTblDecodeEscapeSequence[i]; NewPatterns[i] := ConvertTblEncodeEscapeSequence[i]; end; Result := WideStringsReplace(Source, OldPatterns, NewPatterns, True); end; function DecodeEscapeSequence(const Source: WideString): WideString; var OldPatterns, NewPatterns: TWideStringDynArray; i: Integer; begin SetLength(OldPatterns, High(ConvertTblEncodeEscapeSequence)+1); SetLength(NewPatterns, High(ConvertTblEncodeEscapeSequence)+1); for i := 0 to High(ConvertTblEncodeEscapeSequence) do begin OldPatterns[i] := ConvertTblEncodeEscapeSequence[i]; NewPatterns[i] := ConvertTblDecodeEscapeSequence[i]; end; Result := WideStringsReplace(Source, OldPatterns, NewPatterns, True); end; //--△----------------------▲-- {------------------------------- // 英単語の置き換えを処理する 機能: 指定された文字列群の単語を置き換える。 単語の前後をアルファベットかどうかを判断している。 備考: SQL文中の予約語をUpperCaseに そろえる処理の為に実装 英文系しか実用的ではない。 WideStringsReplaceから改造 ※select→SELECTとすると SQL文中のSELECTが全部大文字化されるけど 『selecter』という単語は変換されない。 履歴: 2004/01/11 2007/09/08 [s"]の["]を[']に変更しようとするときも sを前後に接続するアルファベットとして認識してしまうので sの隣が記号ならそれはちゃんと区切られているものとして 認識させることにした。 つまり、[ttp://]を[http://]に変換するとき [xttp://]はtの前にxがきて連続したアルファベットのために 独立した単語として認識されないので変換されないが [ ttp://www]は/の後ろにwがきても連続したアルファベットでないので 独立した単語として認識されて[ http://www]と変換される //--▼----------------------▽--} function WideStringsWordReplace(const S: WideString; OldPatterns, NewPatterns: TWideStringDynArray; IgnoreCase: Boolean = False): WideString; function PlusValue(Value: Integer): Integer; begin if 0 < Value then Result := Value else Result := 0; end; type TCompareFunction = function(const SubStr, S: WideString; StrIndex: Integer): Boolean; var ReadIndex, WriteIndex, SourceLength: Integer; ResultLength: Integer; i, j: Integer; SameFlag: Boolean; CompareFunction: TCompareFunction; begin Result := ''; if Length(OldPatterns) = 0 then Exit; if ( Length(OldPatterns) <> Length(NewPatterns) ) then Exit; if S = '' then Exit; SourceLength := Length(S); ResultLength := SourceLength; for i := 0 to Length(OldPatterns)-1 do begin if OldPatterns[i] <> '' then begin ResultLength := ResultLength + PlusValue(Length(NewPatterns[i])-Length(OldPatterns[i]))*StrCount(OldPatterns[i], S); end; end; SetLength(Result, ResultLength); if IgnoreCase then CompareFunction := WideTextPartsCompare else CompareFunction := WideStringPartsCompare; ReadIndex := 1; WriteIndex := 1; while (ReadIndex <= SourceLength) do begin SameFlag := False; for i := 0 to Length(OldPatterns)-1 do begin if CompareFunction(OldPatterns[i], S, ReadIndex) then begin {↓置き換え元の文字列前後が半角アルファベットかアンダーバーであり その隣の文字列も半角アルファベットかアンダーバーであるなら 単語として独立していないとみなしてパスされる} if (1<=ReadIndex) and (CheckStrInTable(S[ReadIndex], hanAlphaTbl+'_')=itAllInclude) and (CheckStrInTable(S[ReadIndex-1], hanAlphaTbl+'_')=itAllInclude) then begin continue; end; if (ReadIndex+Length(OldPatterns[i]) <= Length(S)) and (CheckStrInTable(S[ReadIndex+Length(OldPatterns[i])-1], hanAlphaTbl+'_') = itAllInclude) and (CheckStrInTable(S[ReadIndex+Length(OldPatterns[i])], hanAlphaTbl+'_') = itAllInclude) then begin continue; end; SameFlag := True; for j := 0 to Length(NewPatterns[i])-1 do begin Result[WriteIndex+j] := (NewPatterns[i])[j+1]; end; Inc(WriteIndex, Length(NewPatterns[i])); Inc(ReadIndex, Length(OldPatterns[i])); break; end; //if end; //for if SameFlag = False then begin Result[WriteIndex] := S[ReadIndex]; Inc(WriteIndex); Inc(ReadIndex); end; end; //while SetLength(Result,WriteIndex-1); end; //--△----------------------▲-- {------------------------------- //指定文字をトリム TrimLeftChar TrimRightChar TrimChar 引数説明: S: トリム対象 Table: トリムしたい文字列テーブル 備考: SとTableに指定する文字列は 全角文字やEmptyStrに対応している。 Tableに'123'と指定すると1,2,3それぞれの文字でトリムする 履歴: 2001/10/15 2003/06/29 高速化 //--▼----------------------▽--} //const // EmptyStr: WideString = ''; function TrimLeftChar(S: WideString; Table: WideString): WideString; var i: Integer; WriteIndex: Integer; TrimFlag: Boolean; begin SetLength(Result, Length(S)); WriteIndex := 0; TrimFlag := True; for i := 1 to Length(S) do begin if not (TrimFlag and (1<=Pos(S[i], Table))) then begin TrimFlag := False; Inc(WriteIndex); Result[WriteIndex] := S[i]; end; end; SetLength(Result, WriteIndex); { ----------------------------------- //低速だがコードが短い方の実装 while (S<>EmptyStr) and (1<=Pos(S[1], Table)) do Delete(S, 1, 1); Result := S; //----------------------------------- } end; function TrimRightChar(S: WideString; Table: WideString): WideString; var i: Integer; WriteIndex: Integer; begin Result := S; WriteIndex := Length(Result); for i := Length(S) downto 1 do begin if (1<=Pos(S[i], Table)) then begin Dec(WriteIndex); end else begin break; end; end; SetLength(Result, WriteIndex); { ----------------------------------- //低速だがコードが短い方の実装 while (S<>EmptyStr) and (1<=Pos(S[Length(S)], Table)) do Delete(S, Length(S), 1); Result := S; //----------------------------------- } end; function TrimChar(S: WideString; Table: WideString): WideString; begin Result := TrimLeftChar(TrimRightChar(S, Table), Table); end; //--△----------------------▲-- {------------------------------- // 1文字だけトリムする関数 機能: 備考: 履歴: 2006/08/02(水) 12:50 //--▼----------------------▽--} function OneTrimChar(S: WideString; Table: WideString): WideString; begin Result := S; if (2 <= Length(S)) = False then Exit; if (Table = EmptyStr) then Exit; if Pos(S[1], Table)=0 then Exit; {↓前後の1文字がTableの中に含まれるなら} if Pos(S[1], Table) = Pos(S[Length(S)], Table) then begin Result := Copy(S, 2, Length(S)-2); end; end; //--△----------------------▲-- {------------------------------- // 指定されたタグではさまれた文字列を取り出す 機能: 備考: 履歴: 2006/05/05(金) 15:02 バグがあったので修正した //--▼----------------------▽--} function GetTagText(StartTag, EndTag, TargetText: WideString; IgnoreCase: Boolean = False): WideString; var StartIndex: Integer; EndIndex: Integer; begin Result := ''; StartIndex:= RangeWidePosForward(StartTag, TargetText, 1, MaxInt, IgnoreCase); if StartIndex = 0 then Exit; StartIndex := StartIndex + Length(StartTag); EndIndex := RangeWidePosForward(EndTag, TargetText, StartIndex, MaxInt, IgnoreCase); if EndIndex = 0 then Exit; Result := Copy(TargetText, StartIndex, EndIndex - StartIndex); end; //--△----------------------▲-- {------------------------------- // 文字列を繰り返し出力します 備考: StringOfCharの文字列版 履歴: 2004/09/19 2004/11/30 DupeString 関数がVCLにあるが WideString対応じゃない //--▼----------------------▽--} function StringOfWideStr(Str: WideString; Count: Integer): WideString; var i: Integer; begin Result := ''; for i := 1 to Count do begin Result := Result + Str; end; end; //--△----------------------▲-- {------------------------------- // WideCharの描画文字幅が半角なのか全角なのかを返す関数 備考: 内部的に使うだけなのでtypeは外部に公開しない 履歴: 2006/04/22 WordWrap処理のために作成 2006/05/13 ・半角カナに対応していなかったので HiByte=$00以外も比較条件にいれた 参考: Unicode対応 文字コード表 http://ash.jp/code/unitbl1.htm //--▼----------------------▽--} //type TWideCharByteLength = (wcblSingle, wcblMulti); function WideCharByteLength(source: WideChar): TWideCharByteLength; var Buffer: word; begin Buffer := Ord(source); case Buffer of $0020..$007F, $203E, $FF61..$FF9F: begin Result := wcblSingle; end; else begin Result := wcblMulti; end; end; end; //--△----------------------▲-- {------------------------------- // 文字位置からByte位置を返す関数 // CharToByteInexのWideString版(実装には参考にしてない) 備考: ByteIndexはAnsiStringと同く1オリジンとする ByteIndexは描画位置を示して半角80桁とかに使える値になる 履歴: 2006/04/22 WordWrap処理のために作成 //--▼----------------------▽--} function CharIndexToByteIndex(Source: WideString; CharIndex: Integer): Integer; var i: Integer; begin Result := 0; if not(1<=CharIndex) then Exit; if not(CharIndex<=Length(Source)+1) then Exit; Result := 1; for i := 1 to CharIndex - 1 do begin case WideCharByteLength(Source[i]) of wcblSingle: Inc(Result); wcblMulti: Inc(Result, 2); end; end; end; //--△----------------------▲-- {------------------------------- // Byte位置から文字位置を返す関数 // ByteToCharInexのWideString版(実装には参考にしてない) 備考: ByteIndexはAnsiStringと同く1オリジンとする ByteIndexは描画位置を示して半角80桁とかに使える値になる 履歴: 2006/04/22 WordWrap処理のために作成 //--▼----------------------▽--} function ByteIndexToCharIndex(Source: WideString; ByteIndex: Integer): Integer; var i: Integer; ByteCounter: Integer; begin Result := 0; if not(1<=ByteIndex) then Exit; ByteCounter := 0; for i := 1 to Length(Source) do begin case WideCharByteLength(Source[i]) of wcblSingle: Inc(ByteCounter); wcblMulti: Inc(ByteCounter, 2); end; if ByteIndex <= ByteCounter then begin Result := i; break; end; end; end; //--△----------------------▲-- {------------------------------- // WideStringの描画半角Byte桁を求める関数 備考: 文字列が半角では何桁になるのかを調べる 履歴: 2006/04/22 WordWrap処理のために作成 //--▼----------------------▽--} function ByteLength(Source: WideString): Integer; begin Result := CharIndexToByteIndex(Source, Length(Source)+1)-1; end; //--△----------------------▲-- {------------------------------- // テーブルに含まれる文字列を削除する 機能: Tableに"123"と指定すると 文字列から1と2と3を削除する 備考: 履歴: 2006/11/14(火) 13:54 //--▼----------------------▽--} function DeleteStrInTable(const S, Table: WideString; IgnoreCase: Boolean = False): String; var OldPatterns, NewPatterns: TWideStringDynArray; i: Integer; begin SetLength(OldPatterns, Length(Table)); SetLength(NewPatterns, Length(Table)); for i := 0 to Length(Table) - 1 do begin OldPatterns[i] := Table[i+1]; NewPatterns[i] := ''; end; Result := WideStringsReplace(S, OldPatterns, NewPatterns, IgnoreCase); end; //function DeleteStrInTable(const S, Table: String; // IgnoreCase: Boolean = False): String; //var // OldPatterns, NewPatterns: TStringDynArray; // i: Integer; //begin // SetLength(OldPatterns, Length(Table)); // SetLength(NewPatterns, Length(Table)); // for i := 0 to Length(Table) - 1 do // begin // OldPatterns[i] := Table[i+1]; // NewPatterns[i] := ''; // end; // // Result := StringsReplace(S, OldPatterns, NewPatterns, IgnoreCase); //end; //--△----------------------▲-- {------------------------------- // 文字列の先頭(First)と終端(Last)に文字列を含ませたり取り除く関数 機能: 備考: IncludeBothEndsStrは AnsiQuotedStrと同じような仕様かもしれない 履歴: 2007/07/25(水) 17:14 2010/03/09(火) ・ IsFirstStr/IsLastStrとして実装 //--▼----------------------▽--} function IsFirstStr(const S: WideString; const SubStr: WideString): Boolean; begin Result := WideStringPartsCompare(SubStr, S, 1); end; function IsLastStr(const S: WideString; const SubStr: WideString): Boolean; begin Result := WideStringPartsCompare(SubStr, S, Length(S)-Length(SubStr)+1); end; function IncludeFirstStr(const S: WideString; const SubStr: WideString): WideString; begin if IsFirstStr(S, SubStr) then begin Result := S; end else begin Result := SubStr + S; end; end; function IncludeLastStr(const S: WideString; const SubStr: WideString): WideString; begin if IsLastStr(S, SubStr) then begin Result := S; end else begin Result := S + SubStr; end; end; function IncludeBothEndsStr(const S: WideString; const SubStr: WideString): WideString; begin Result := IncludeLastStr(IncludeFirstStr(S, SubStr), SubStr); end; function ExcludeFirstStr(const S: WideString; const SubStr: WideString): WideString; begin if IsFirstStr(S, SubStr) then begin Result := DeleteStr(S, 1, Length(SubStr)); end else begin Result := S; end; end; function ExcludeLastStr(const S: WideString; const SubStr: WideString): WideString; begin if IsLastStr(S, SubStr) then begin Result := DeleteStr(S, Length(S)-Length(SubStr)+1, Length(SubStr)); end else begin Result := S; end; end; function ExcludeBothEndsStr(const S: WideString; const SubStr: WideString): WideString; begin Result := ExcludeLastStr(ExcludeFirstStr(S, SubStr), SubStr); end; //--△----------------------▲-- {------------------------------- // 文字列終端に\記号が追加されたり取り除かれたりする関数 機能: Include/ExcludeTrailingPathDelimiter()互換(たぶん) 関数名が長すぎて嫌だからこっちを使う事にした。 備考: 履歴: 2007/07/25(水) 17:14 //--▼----------------------▽--} function IncludeLastPathDelim(const Path: WideString): WideString; begin Result := IncludeLastStr(Path, PathDelim); end; function ExcludeLastPathDelim(const Path: WideString): WideString; begin Result := ExcludeLastStr(Path, PathDelim); end; //--△----------------------▲-- {------------------------------- // 区切り文字取得 機能: AAA=BBB=CCCという文字から [AAA]や[CCC]や[AAA=BBB]や[BBB=CCC]を取得する 備考: 履歴: 2000/07/24 2008/03/04(火) StringUnitに持ってきた //--▼----------------------▽--} //最も後方に位置する区切り文字（文字列）で指定した物の後方文字列を取得 function DelimiterRight(Delimiter, Str: String): String; var DelIndex: Integer; begin Result := Str; DelIndex := AnsiPosBackward(Delimiter, Str); if DelIndex = 0 then exit; DelIndex := DelIndex + Length(Delimiter) - 1; Delete( Result, 1, DelIndex); end; //最も前方に位置する区切り文字（文字列）で指定した物の前方文字列を取得 function DelimiterLeft(Delimiter, Str: String): String; var DelIndex: Integer; begin Result := Str; DelIndex := AnsiPosForward( Delimiter, Str); if DelIndex = 0 then exit; Result := copy( Result, 1, DelIndex - 1); end; //最も後方に位置する区切り文字（文字列）で指定した物の前方方文字列を取得 function DelimiterLeftLong(Delimiter, Str: String): String; var DelIndex: Integer; begin Result := Str; DelIndex := AnsiPosBackward(Delimiter, Str); if DelIndex = 0 then exit; Result := copy(Result, 1, DelIndex - 1); end; //最も前方に位置する区切り文字（文字列）で指定した物の後方文字列を取得 function DelimiterRightLong(Delimiter, Str: String): String; var DelIndex: Integer; begin Result := Str; DelIndex := AnsiPosForward( Delimiter, Str); if DelIndex = 0 then exit; Delete( Result, 1, DelIndex + Length(Delimiter) - 1); end; //--△----------------------▲-- end.