{ ----------------------------------- 文字列処理関数 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を追加した //----------------------------------- } unit StringUnitLight; interface uses // Types, Windows, SysUtils, //Exception XPtest; 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; procedure testByteType; 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; procedure testCharToByteLen; 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; type TCompareResult = (crEqual, crLessThan, crGreaterThan); function CompareStringAnsiAPI(const S1, S2: String; S1Index, S2Index, CompareLength: Integer; IgnoreCase: Boolean): TCompareResult; function CompareStringWideAPI(const S1, S2: WideString; S1Index, S2index, CompareS1Length, CompareS2Length: Integer; IgnoreCase: Boolean): TCompareResult; procedure testStringTextPartsCompare; 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; procedure testRangeAnsiPosForwardBackward; procedure testRangeWidePosForwardBackward; function DeleteStr(const S: String; const Index, Count: Integer): String; overload; function DeleteStr(const S: WideString; const Index, Count: 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; procedure testMapStringW; function ConvertHanKataToZenKata(const Source: WideString): WideString; function ConvertZenKataToHanKata(const Source: WideString): WideString; procedure testConvertKataKana; function ConvertNumericHanToZen(const Source: WideString): WideString; function ConvertNumericZenToHan(const Source: WideString): WideString; procedure testConvertNumeric; function ConvertSymbolHanToZen(const Source: WideString): WideString; function ConvertSymbolZenToHan(const Source: WideString): WideString; procedure testConvertSymbol; function ConvertAlphabetHanToZen(const Source: WideString): WideString; function ConvertAlphabetZenToHan(const Source: WideString): WideString; procedure testConvertAlphabet; type TIncrementFlag = (ifByte, ifWord); function StrCount(const SubStr, S: String; IncFlag: TIncrementFlag = ifWord): Integer; const zenHiraTbl: String = // 全角ひらかな 'あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほ'+ 'まみむめもやゆよらりるれろわゐゑをんがぎぐげござじずぜぞだぢづでど'+ 'ばびぶべぼぱぴぷぺぽぁぃぅぇぉゃゅょゎっー'; const zenKataTbl: String = // 全角カタカナ 'アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホ'+ 'マミムメモヤユヨラリルレロワンヲガギグゲゴザジズゼゾダヂヅデド'+ 'バビブベボパピプペポァィゥェォャュョヮッー'; const hanKanaTbl: String = // 半角カタカナ 'ｱｲｳｴｵｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔﾕﾖﾗﾘﾙﾚﾛﾜｦﾝｧｨｩｪｫｬｭｮｯﾟｰ･､｡｢｣'; //※メーラーだと半角カタカナは全角に変換されてしまいます const zenNumberTbl: String = // 全角数字 '１２３４５６７８９０'; const hanNumberTbl: String = // 半角数字 '1234567890'; const zenAlphaTbl: String = // 全角英文字 'ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ'+ 'ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ'; const hanAlphaTbl: String = // 半角英文字 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; const zenMarkTbl: String = // 全角記号(もっと沢山あるけど一部のみ) '−．＆％＄＃＊＠？／，＜＞（）｛｝｜；：〜＋｀！V＝_＾・'; const hanMarkTbl: String = // 半角記号 '!"#$%&''()*+,-./:;<=>?@[\]^_`{|}~'; const zenSpaceTbl: String = '　'; // 全角スペース const hanSpaceTbl: String = ' '; // 半角スペース type TInTable = (itUnknown, itAllInclude, itAllExclude, itPartInclude); function CheckStrInTable(const Str, Table: WideString): TInTable; procedure testCheckStrInTable; function CheckWideCharInTable(const Char: WideChar; const Table: WideString): Boolean; procedure testCheckWideCharInTable; type TTextLineBreakStyleMultiPlatform = (tlbsmpCRLF, tlbsmpCR, tlbsmpLF); //CRLF:Windows CR:Mac LF:Unix/Linux function ChangeLineBreakes(const S: String; Style: TTextLineBreakStyleMultiPlatform): String; procedure testChangeLineBreakes; type TLineBreakStyle = (lbsCRLF, lbsCR, lbsLF ,lbsNoLineBreaks); function LastLineBreakStyle(WideStr: WideString): TLineBreakStyle; function LineBreakString(Style: TLineBreakStyle): String; function IsLineBreak(WideStr: WideString): TLineBreakStyle; function StringsReplace(const S: String; OldPatterns, NewPatterns: TStringDynArray; IgnoreCase: Boolean = False): string; function StringReplaceAll(const S, OldPattern, NewPattern: String; IgnoreCase: Boolean = False): String; procedure testStringsReplace; function WideStringsReplace(const S: WideString; OldPatterns, NewPatterns: TWideStringDynArray; IgnoreCase: Boolean = False): WideString; function WideStringReplaceAll(const S, OldPattern, NewPattern: WideString; IgnoreCase: Boolean = False): WideString; procedure testWideStringsReplace; function EncodeEscapeSequence(const Source: WideString): WideString; procedure testEncodeEscapeSequence; function DecodeEscapeSequence(const Source: WideString): WideString; procedure testDecodeEscapeSequence; 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; procedure testTrimLeftChar; procedure testTrimRightChar; procedure testTrimChar; function OneTrimChar(S: WideString; Table: WideString): WideString; procedure testOneTrimChar; function GetTagText(StartTag, EndTag, TargetText: WideString; IgnoreCase: Boolean = False): WideString; procedure testGetTagText; function StringOfWideStr(Str: WideString; Count: Integer): WideString; function InStr(const SubStr, S: string): Boolean; overload; function InStr(const SubStr, S: string; Index, Count: Integer): Boolean; overload; procedure testInStr; function CharIndexToByteIndex(Source: WideString; CharIndex: Integer): Integer; function ByteIndexToCharIndex(Source: WideString; ByteIndex: Integer): Integer; function ByteLength(Source: WideString): Integer; procedure testWideCharByteLength; procedure testCharIndexToByteIndex; procedure testByteIndexToCharIndex; procedure testCharLengthToByteLength; function DeleteStrInTable(const S, Table: WideString; IgnoreCase: Boolean = False): String; //function DeleteStrInTable(const S, Table: String; // IgnoreCase: Boolean = False): String; overload; const EmptyStr = ''; CR = #$D; //#13 LF = #$A; //#10 TAB= #$9; //#9 NULLSTR = #$0;//#0 EN = '\'; CRLF = #$D#$A;//#13#10 SPACE = ' '; 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; procedure testByteType; begin Check(True, IsDBCSLeadChar( ('る'[1]) )); Check(True, IsDBCSLeadChar( ('る'[2]) )); Check(True, IsDBCSLeadChar( ('あ'[1]) )); Check(False, IsDBCSLeadChar( ('あ'[2]) )); //↓SysUtilで使われているWinAPI関数 //Check(True, IsDBCSLeadByte( Byte('る'[1]) )); //Check(True, IsDBCSLeadByte( Byte('る'[2]) )); //Check(True, IsDBCSLeadByte( Byte('あ'[1]) )); //Check(False, IsDBCSLeadByte( Byte('あ'[2]) )); Check(mbSingleByte, ByteType('ABC', 1)); Check(mbLeadByte, ByteType('あ', 1)); Check(mbTrailByte, ByteType('あ', 2)); Check(mbLeadByte, ByteType('る', 1)); Check(mbTrailByte, ByteType('る', 2)); Check(mbLeadByte, ByteType('ああああ', 1)); Check(mbTrailByte, ByteType('ああああ', 2)); Check(mbLeadByte, ByteType('ああああ', 3)); Check(mbTrailByte, ByteType('ああああ', 4)); Check(mbLeadByte, ByteType('ああああ', 5)); Check(mbTrailByte, ByteType('ああああ', 6)); Check(mbLeadByte, ByteType('ああああ', 7)); Check(mbTrailByte, ByteType('ああああ', 8)); Check(mbLeadByte, ByteType('るるるる', 1)); Check(mbTrailByte, ByteType('るるるる', 2)); Check(mbLeadByte, ByteType('るるるる', 3)); Check(mbTrailByte, ByteType('るるるる', 4)); Check(mbLeadByte, ByteType('るるるる', 5)); Check(mbTrailByte, ByteType('るるるる', 6)); Check(mbLeadByte, ByteType('るるるる', 7)); Check(mbTrailByte, ByteType('るるるる', 8)); Check(mbLeadByte, ByteType('ABCああああ', 4)); Check(mbTrailByte, ByteType('ABCああああ', 5)); Check(mbLeadByte, ByteType('ABCああああ', 6)); Check(mbTrailByte, ByteType('ABCああああ', 7)); Check(mbLeadByte, ByteType('ABCああああ', 8)); Check(mbTrailByte, ByteType('ABCああああ', 9)); Check(mbLeadByte, ByteType('ABCああああ', 10)); Check(mbTrailByte, ByteType('ABCああああ', 11)); Check(mbLeadByte, ByteType('ABCるるるる', 4)); Check(mbTrailByte, ByteType('ABCるるるる', 5)); Check(mbLeadByte, ByteType('ABCるるるる', 6)); Check(mbTrailByte, ByteType('ABCるるるる', 7)); Check(mbLeadByte, ByteType('ABCるるるる', 8)); Check(mbTrailByte, ByteType('ABCるるるる', 9)); Check(mbLeadByte, ByteType('ABCるるるる', 10)); Check(mbTrailByte, ByteType('ABCるるるる', 11)); 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; procedure testCharToByteLen; begin Check( 2, CharToByteLen('あいうえお', 1)); Check( 6, CharToByteLen('あいうえお', 3)); Check(10, CharToByteLen('あいうえお', 5)); Check(10, CharToByteLen('あいうえお', 6)); Check( 1, CharToByteLen('ABC123あいうえお', 1)); Check( 6, CharToByteLen('ABC123あいうえお', 6)); Check( 8, CharToByteLen('ABC123あいうえお', 7)); Check(16, CharToByteLen('ABC123あいうえお',11)); 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 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 CompareStringAnsiAPI(const S1, S2: String; S1Index, S2Index, CompareLength: 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, CompareLength, PChar(S2) + S2Index - 1, CompareLength) of CSTR_LESS_THAN: Result := crLessThan; CSTR_EQUAL: Result := crEqual; CSTR_GREATER_THAN: Result := crGreaterThan; else raise Exception.Create('CompareStringAの戻り値が不正です'); 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 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; procedure testStringTextPartsCompare; procedure CheckFunctionAnsi(ReturnStrValue, ReturnTextValue: Boolean; const Sub, S: String; StrIndex: Integer); begin Check( ReturnStrValue, AnsiStringPartsCompare(Sub, S, StrIndex) ); Check( ReturnTextValue, AnsiTextPartsCompare(Sub, S, StrIndex) ); end; procedure CheckFunctionWide(ReturnStrValue, ReturnTextValue: Boolean; const Sub, S: WideString; StrIndex: Integer); begin Check( ReturnStrValue, WideStringPartsCompare(Sub, S, StrIndex) ); Check( ReturnTextValue, WideTextPartsCompare(Sub, S, StrIndex) ); end; procedure CheckFunction(ReturnStrValue, ReturnTextValue: Boolean; const Sub, S: WideString; AnsiStrIndex, WideStrIndex: Integer); begin CheckFunctionAnsi(ReturnStrValue, ReturnTextValue, Sub, S, AnsiStrIndex); CheckFunctionWide(ReturnStrValue, ReturnTextValue, Sub, S, WideStrIndex); end; begin CheckFunction( True, True, 'あ', 'あいうえお', 1, 1); CheckFunction( True, True, 'うえ', 'あいうえお', 5, 3); CheckFunction( True, True, 'お', 'あいうえお', 9, 5); CheckFunction(False,False, 'あ', 'あいうえお', 0, 0); CheckFunction(False,False, 'あ', 'あいうえお', 2, 2); CheckFunction(False,False, 'うえ', 'あいうえお', 4, 2); CheckFunction(False,False, 'うえ', 'あいうえお', 6, 4); CheckFunction(False,False, 'うえ', 'あいうえお', 8, 5); CheckFunction(False,False, 'お', 'あいうえお', 8, 4); CheckFunction(False,False, 'お', 'あいうえお', 11, 6); CheckFunction( True, True, 'D', 'ABCDEF', 4, 4); CheckFunction(False, True, 'D', 'abcdef', 4, 4); CheckFunction( True, True, 'Ｄ', 'ＡＢＣＤＥＦ', 7, 4); CheckFunction(False, True, 'Ｄ', 'ａｂｃｄｅｆ', 7, 4); CheckFunction(False,False, 'ABC', 'AB', 1, 1); CheckFunction(False, False, 'ｰ', '久々', 3, 2); 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; procedure testRangeAnsiPosForwardBackward; procedure CheckFunction(ForwardSearchIndex, BackwardSearchIndex: Integer; const SubStr, S: String; RangeStart, RangeCount: Integer); begin Check( ForwardSearchIndex, RangeAnsiPosForward(SubStr, S, RangeStart, RangeCount)); Check( BackwardSearchIndex, RangeAnsiPosBackward(SubStr, S, RangeStart, RangeCount)); end; begin CheckFunction( 0, 0, 'ABC', 'abcdefghi', 1, 3); CheckFunction( 1, 1, 'ABC', 'ABCDEFGHI', 1, 3); CheckFunction( 0, 0, 'ABC', 'ABCDEFGHI', 1, 2); CheckFunction( 1, 1, 'ABC', 'ABCDEFGHI', 1, 4); CheckFunction( 0, 0, 'ABC', 'ABCDEFGHI', 2, 4); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 1, 6); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 1, 5); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 3, 6); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 4, 3); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 4, 2); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 5, 5); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 0, 6); CheckFunction( 1, 1, 'ABC', 'ABCDEFGHI', 1, MaxInt); Check( 1, RangeAnsiPosForward('ABC', 'ABCDEFGHI', 1) ); Check( 1, RangeAnsiPosForward('ABC', 'ABCDEFGHI') ); Check( 1, RangeAnsiPosBackward('ABC', 'ABCDEFGHI', 1) ); Check( 1, RangeAnsiPosBackward('ABC', 'ABCDEFGHI') ); CheckFunction( 0, 0, 'ABC', 'ABCDEFGHI', 2, MaxInt); Check( 0, RangeAnsiPosForward('ABC', 'ABCDEFGHI', 2) ); Check( 0, RangeAnsiPosBackward('ABC', 'ABCDEFGHI', 2) ); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 1, MaxInt); Check( 4, RangeAnsiPosForward('DEF', 'ABCDEFGHI') ); Check( 4, RangeAnsiPosBackward('DEF', 'ABCDEFGHI') ); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 3, MaxInt); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 4, MaxInt); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 5, MaxInt); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 0, MaxInt); // CheckFunction( 1, 1, 'あいう', 'あいう１２３GHI', 1, 6); CheckFunction( 0, 0, 'あいう', 'あいう１２３GHI', 1, 5); CheckFunction( 1, 1, 'あいう', 'あいう１２３GHI', 1, 7); CheckFunction( 0, 0, 'あいう', 'あいう１２３GHI', 2, 6); CheckFunction( 7, 7, '１２３', 'あいう１２３GHI', 1, 12); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 1, 11); CheckFunction( 7, 7, '１２３', 'あいう１２３GHI', 7, 12); CheckFunction( 7, 7, '１２３', 'あいう１２３GHI', 7, 6); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 7, 5); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 8, 8); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 0, 12); CheckFunction( 1, 1, 'あいう', 'あいう１２３GHI', 1, MaxInt); Check( 1, RangeAnsiPosForward('あいう', 'あいう１２３GHI', 1) ); Check( 1, RangeAnsiPosForward('あいう', 'あいう１２３GHI') ); Check( 1, RangeAnsiPosBackward('あいう', 'あいう１２３GHI', 1) ); Check( 1, RangeAnsiPosBackward('あいう', 'あいう１２３GHI') ); CheckFunction( 0, 0, 'あいう', 'あいう１２３GHI', 2, MaxInt); Check( 0, RangeAnsiPosForward('あいう', 'あいう１２３GHI', 2) ); Check( 0, RangeAnsiPosBackward('あいう', 'あいう１２３GHI', 2) ); CheckFunction( 7, 7, '１２３', 'あいう１２３GHI', 1, MaxInt); Check( 7, RangeAnsiPosForward('１２３', 'あいう１２３GHI') ); Check( 7, RangeAnsiPosBackward('１２３', 'あいう１２３GHI') ); CheckFunction( 7, 7, '１２３', 'あいう１２３GHI', 6, MaxInt); CheckFunction( 7, 7, '１２３', 'あいう１２３GHI', 7, MaxInt); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 8, MaxInt); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 0, MaxInt); // CheckFunction( 1, 1, 'ABC', 'ABCDEFABCDEF', 1, 3); CheckFunction( 1, 7, 'ABC', 'ABCDEFABCDEF', 1, MaxInt); CheckFunction( 1, 7, 'ABC', 'ABCDEFABCDEF', 1, 9); CheckFunction( 1, 1, 'ABC', 'ABCDEFABCDEF', 1, 8); CheckFunction( 7, 7, 'ABC', 'ABCDEFABCDEF', 2, 8); CheckFunction( 0, 0, 'ABC', 'ABCDEFABCDEF', 2, 7); CheckFunction( 1, 1, 'あいう', 'あいう１２３あいう１２３', 1, 6); CheckFunction( 1,13, 'あいう', 'あいう１２３あいう１２３', 1, MaxInt); CheckFunction( 1,13, 'あいう', 'あいう１２３あいう１２３', 1, 18); CheckFunction( 1, 1, 'あいう', 'あいう１２３あいう１２３', 1, 17); CheckFunction(13,13, 'あいう', 'あいう１２３あいう１２３', 2, 17); CheckFunction( 0, 0, 'あいう', 'あいう１２３あいう１２３', 2, 16); 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; procedure testRangeWidePosForwardBackward; procedure CheckFunction(ForwardSearchIndex, BackwardSearchIndex: Integer; const SubStr, S: WideString; RangeStart, RangeCount: Integer); begin Check( ForwardSearchIndex, RangeWidePosForward(SubStr, S, RangeStart, RangeCount)); Check( BackwardSearchIndex, RangeWidePosBackward(SubStr, S, RangeStart, RangeCount)); end; begin CheckFunction( 1, 1, 'ABC', 'ABCDEFGHI', 1, 3); CheckFunction( 0, 0, 'ABC', 'ABCDEFGHI', 1, 2); CheckFunction( 1, 1, 'ABC', 'ABCDEFGHI', 1, 4); CheckFunction( 0, 0, 'ABC', 'ABCDEFGHI', 2, 4); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 1, 6); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 1, 5); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 3, 6); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 4, 3); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 4, 2); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 5, 5); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 0, 6); CheckFunction( 1, 1, 'ABC', 'ABCDEFGHI', 1, MaxInt); Check( 1, RangeWidePosForward('ABC', 'ABCDEFGHI', 1) ); Check( 1, RangeWidePosForward('ABC', 'ABCDEFGHI') ); Check( 1, RangeWidePosBackward('ABC', 'ABCDEFGHI', 1) ); Check( 1, RangeWidePosBackward('ABC', 'ABCDEFGHI') ); CheckFunction( 0, 0, 'ABC', 'ABCDEFGHI', 2, MaxInt); Check( 0, RangeWidePosForward('ABC', 'ABCDEFGHI', 2) ); Check( 0, RangeWidePosBackward('ABC', 'ABCDEFGHI', 2) ); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 1, MaxInt); Check( 4, RangeWidePosForward('DEF', 'ABCDEFGHI') ); Check( 4, RangeWidePosBackward('DEF', 'ABCDEFGHI') ); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 3, MaxInt); CheckFunction( 4, 4, 'DEF', 'ABCDEFGHI', 4, MaxInt); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 5, MaxInt); CheckFunction( 0, 0, 'DEF', 'ABCDEFGHI', 0, MaxInt); // CheckFunction( 1, 1, 'あいう', 'あいう１２３GHI', 1, 3); CheckFunction( 0, 0, 'あいう', 'あいう１２３GHI', 1, 2); CheckFunction( 1, 1, 'あいう', 'あいう１２３GHI', 1, 4); CheckFunction( 0, 0, 'あいう', 'あいう１２３GHI', 2, 3); CheckFunction( 4, 4, '１２３', 'あいう１２３GHI', 1, 6); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 1, 5); CheckFunction( 4, 4, '１２３', 'あいう１２３GHI', 4, 6); CheckFunction( 4, 4, '１２３', 'あいう１２３GHI', 4, 3); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 4, 2); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 5, 4); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 0, 6); CheckFunction( 1, 1, 'あいう', 'あいう１２３GHI', 1, MaxInt); Check( 1, RangeWidePosForward('あいう', 'あいう１２３GHI', 1) ); Check( 1, RangeWidePosForward('あいう', 'あいう１２３GHI') ); Check( 1, RangeWidePosBackward('あいう', 'あいう１２３GHI', 1) ); Check( 1, RangeWidePosBackward('あいう', 'あいう１２３GHI') ); CheckFunction( 0, 0, 'あいう', 'あいう１２３GHI', 2, MaxInt); Check( 0, RangeWidePosForward('あいう', 'あいう１２３GHI', 2) ); Check( 0, RangeWidePosBackward('あいう', 'あいう１２３GHI', 2) ); CheckFunction( 4, 4, '１２３', 'あいう１２３GHI', 1, MaxInt); Check( 4, RangeWidePosForward('１２３', 'あいう１２３GHI') ); Check( 4, RangeWidePosBackward('１２３', 'あいう１２３GHI') ); CheckFunction( 4, 4, '１２３', 'あいう１２３GHI', 3, MaxInt); CheckFunction( 4, 4, '１２３', 'あいう１２３GHI', 4, MaxInt); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 5, MaxInt); CheckFunction( 0, 0, '１２３', 'あいう１２３GHI', 0, MaxInt); // CheckFunction( 1, 1, 'ABC', 'ABCDEFABCDEF', 1, 3); CheckFunction( 1, 7, 'ABC', 'ABCDEFABCDEF', 1, MaxInt); CheckFunction( 1, 7, 'ABC', 'ABCDEFABCDEF', 1, 9); CheckFunction( 1, 1, 'ABC', 'ABCDEFABCDEF', 1, 8); CheckFunction( 7, 7, 'ABC', 'ABCDEFABCDEF', 2, 8); CheckFunction( 0, 0, 'ABC', 'ABCDEFABCDEF', 2, 7); CheckFunction( 1, 1, 'あいう', 'あいう１２３あいう１２３', 1, 3); CheckFunction( 1, 7, 'あいう', 'あいう１２３あいう１２３', 1, MaxInt); CheckFunction( 1, 7, 'あいう', 'あいう１２３あいう１２３', 1, 9); CheckFunction( 1, 1, 'あいう', 'あいう１２３あいう１２３', 1, 8); CheckFunction( 7, 7, 'あいう', 'あいう１２３あいう１２３', 2, 8); CheckFunction( 0, 0, 'あいう', 'あいう１２３あいう１２３', 2, 7); end; //------------------------------ //戻り値のある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; //戻り値のあるDelete(WideString版) function DeleteStr(const S: WideString; const Index, Count: Integer): WideString; overload; var Str: String; begin Str := S; Delete(Str, Index, Count); Result := Str; 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; procedure testMapStringW; begin Check('あああ', KataToHira('アあア')); Check('あかさたなはまやらわをん', KataToHira('アカサタナハマヤラワヲン')); Check('アアア', HiraToKata('あアあ')); Check('アカサタナハマヤラワヲン', HiraToKata('あかさたなはまやらわをん')); Check('ｱｱｱ', KataToHira('ｱｱｱ')); Check('abc', ZenkakuToHankaku('ａｂｃ')); Check('ｱｱｱ', ZenkakuToHankaku('アアア')); Check('ａｂｃ', HankakuToZenkaku('abc')); Check('アアア', HankakuToZenkaku('ｱｱｱ')); 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; procedure testConvertKataKana; begin Check(ConvertZenKataToHanKata('ガギグゲゴ'),'ｶﾞｷﾞｸﾞｹﾞｺﾞ'); Check(ConvertZenKataToHanKata('ザジズゼゾ'),'ｻﾞｼﾞｽﾞｾﾞｿﾞ'); Check(ConvertZenKataToHanKata('ダヂヅデド'),'ﾀﾞﾁﾞﾂﾞﾃﾞﾄﾞ'); Check(ConvertZenKataToHanKata('バビブベボ'),'ﾊﾞﾋﾞﾌﾞﾍﾞﾎﾞ'); Check(ConvertZenKataToHanKata('パピプペポ'),'ﾊﾟﾋﾟﾌﾟﾍﾟﾎﾟ'); Check(ConvertZenKataToHanKata('アイウエオ'),'ｱｲｳｴｵ'); Check(ConvertZenKataToHanKata('カキクケコ'),'ｶｷｸｹｺ'); Check(ConvertZenKataToHanKata('サシスセソ'),'ｻｼｽｾｿ'); Check(ConvertZenKataToHanKata('タチツテト'),'ﾀﾁﾂﾃﾄ'); Check(ConvertZenKataToHanKata('ナニヌネノ'),'ﾅﾆﾇﾈﾉ'); Check(ConvertZenKataToHanKata('ハヒフヘホ'),'ﾊﾋﾌﾍﾎ'); Check(ConvertZenKataToHanKata('マミムメモ'),'ﾏﾐﾑﾒﾓ'); Check(ConvertZenKataToHanKata('ヤユヨ'), 'ﾔﾕﾖ'); Check(ConvertZenKataToHanKata('ラリルレロ'),'ﾗﾘﾙﾚﾛ'); Check(ConvertZenKataToHanKata('ワヲン'), 'ﾜｦﾝ'); Check(ConvertZenKataToHanKata('ァィゥェォ'),'ｧｨｩｪｫ'); Check(ConvertZenKataToHanKata('ャュョ'), 'ｬｭｮ'); Check(ConvertZenKataToHanKata('ッ゜ー・、。「」'),'ｯﾟｰ･､｡｢｣'); Check('ガギグゲゴ',ConvertHanKataToZenKata('ｶﾞｷﾞｸﾞｹﾞｺﾞ')); Check('ザジズゼゾ',ConvertHanKataToZenKata('ｻﾞｼﾞｽﾞｾﾞｿﾞ')); Check('ダヂヅデド',ConvertHanKataToZenKata('ﾀﾞﾁﾞﾂﾞﾃﾞﾄﾞ')); Check('バビブベボ',ConvertHanKataToZenKata('ﾊﾞﾋﾞﾌﾞﾍﾞﾎﾞ')); Check('パピプペポ',ConvertHanKataToZenKata('ﾊﾟﾋﾟﾌﾟﾍﾟﾎﾟ')); Check('アイウエオ',ConvertHanKataToZenKata('ｱｲｳｴｵ')); Check('カキクケコ',ConvertHanKataToZenKata('ｶｷｸｹｺ')); Check('サシスセソ',ConvertHanKataToZenKata('ｻｼｽｾｿ')); Check('タチツテト',ConvertHanKataToZenKata('ﾀﾁﾂﾃﾄ')); Check('ナニヌネノ',ConvertHanKataToZenKata('ﾅﾆﾇﾈﾉ')); Check('ハヒフヘホ',ConvertHanKataToZenKata('ﾊﾋﾌﾍﾎ')); Check('マミムメモ',ConvertHanKataToZenKata('ﾏﾐﾑﾒﾓ')); Check('ヤユヨ', ConvertHanKataToZenKata('ﾔﾕﾖ')); Check('ラリルレロ',ConvertHanKataToZenKata('ﾗﾘﾙﾚﾛ')); Check('ワヲン', ConvertHanKataToZenKata('ﾜｦﾝ')); Check('ァィゥェォ',ConvertHanKataToZenKata('ｧｨｩｪｫ')); Check('ャュョ', ConvertHanKataToZenKata('ｬｭｮ')); Check('ッ゜ー・、。「」', ConvertHanKataToZenKata('ｯﾟｰ･､｡｢｣')); 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; procedure testConvertNumeric; begin Check(ConvertNumericZenToHan('１２３４５'),'12345'); Check('１２３４５', ConvertNumericHanToZen('12345')); 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; procedure testConvertSymbol; begin Check(ConvertSymbolZenToHan('！？＄￥％＆＃'),'!?$\%&#'); Check('！？＄￥％＆＃', ConvertSymbolHanToZen('!?$\%&#')); 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; procedure testConvertAlphabet; begin Check(ConvertAlphabetZenToHan('ＨＩＪＫＬＭＮ'),'HIJKLMN'); Check('ＨＩＪＫＬＭＮ', ConvertAlphabetHanToZen('HIJKLMN')); 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; procedure testStrCount1; begin Check(0, StrCount('A', '') ); Check(0, StrCount('ABC', '') ); Check(0, StrCount('', 'A') ); Check(0, StrCount('', 'ABC') ); Check(1, StrCount('A', 'A') ); Check(3, StrCount('A', 'AAA') ); Check(1, StrCount('A', 'ABC') ); Check(2, StrCount('A', 'ABCABC') ); Check(3, StrCount('ABC', 'ABCABCABC') ); Check(2, StrCount('BCA', 'ABCABCABC') ); Check(1, StrCount('AA', 'AAA') ); Check(0, StrCount('A', '', ifByte) ); Check(0, StrCount('ABC', '', ifByte) ); Check(0, StrCount('', 'A', ifByte) ); Check(0, StrCount('', 'ABC', ifByte) ); Check(1, StrCount('A', 'A', ifByte) ); Check(3, StrCount('A', 'AAA', ifByte) ); Check(1, StrCount('A', 'ABC', ifByte) ); Check(2, StrCount('A', 'ABCABC', ifByte) ); Check(3, StrCount('ABC', 'ABCABCABC', ifByte) ); Check(2, StrCount('BCA', 'ABCABCABC', ifByte) ); Check(2, StrCount('AA', 'AAA', ifByte) ); Check(0, StrCount('Ａ', '') ); Check(0, StrCount('ＡＢＣ', '') ); Check(0, StrCount('', 'Ａ') ); Check(0, StrCount('', 'ＡＢＣ') ); Check(1, StrCount('Ａ', 'Ａ') ); Check(3, StrCount('Ａ', 'ＡＡＡ') ); Check(1, StrCount('Ａ', 'ＡＢＣ') ); Check(2, StrCount('Ａ', 'ＡＢＣＡＢＣ') ); Check(3, StrCount('ＡＢＣ', 'ＡＢＣＡＢＣＡＢＣ') ); Check(2, StrCount('ＢＣＡ', 'ＡＢＣＡＢＣＡＢＣ') ); Check(1, StrCount('ＡＡ', 'ＡＡＡ') ); Check(0, StrCount('Ａ', '', ifByte) ); Check(0, StrCount('ＡＢＣ', '', ifByte) ); Check(0, StrCount('', 'Ａ', ifByte) ); Check(0, StrCount('', 'ＡＢＣ', ifByte) ); Check(1, StrCount('Ａ', 'Ａ', ifByte) ); Check(3, StrCount('Ａ', 'ＡＡＡ', ifByte) ); Check(1, StrCount('Ａ', 'ＡＢＣ', ifByte) ); Check(2, StrCount('Ａ', 'ＡＢＣＡＢＣ', ifByte) ); Check(3, StrCount('ＡＢＣ', 'ＡＢＣＡＢＣＡＢＣ', ifByte) ); Check(2, StrCount('ＢＣＡ', 'ＡＢＣＡＢＣＡＢＣ', ifByte) ); Check(2, StrCount('ＡＡ', 'ＡＡＡ', ifByte) ); 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; procedure testCheckStrInTable; begin Check(itAllInclude, CheckStrInTable('123', '0123456789')); Check(itAllExclude, CheckStrInTable('ABC', '0123456789')); Check(itPartInclude, CheckStrInTable('ABC123', '0123456789')); Check(itUnknown, CheckStrInTable('', '0123456789')); Check(itUnknown, CheckStrInTable('123', '')); Check(itAllInclude, CheckStrInTable('123123321123', '123')); Check(itAllExclude, CheckStrInTable('ABCABCCBAABC', '123')); Check(itPartInclude, CheckStrInTable('ABC123', '123')); end; //------------------------------ {------------------------------- // CheckWideCharInTable 機能: Charが文字列に含まれるかどうかを調べる関数 備考: 履歴: 2005/12/29 //------------------------------} function CheckWideCharInTable(const Char: WideChar; const Table: WideString): Boolean; begin Result := (1 <= WidePosForward(Char, Table)); end; procedure testCheckWideCharInTable; begin Check(True, CheckWideCharInTable('1', '0123456789')); Check(False, CheckWideCharInTable('A', '0123456789')); Check(False, CheckWideCharInTable('1', '')); end; //------------------------------ {------------------------------- // 文字列が含まれるかどうか判断します 備考: AnsiPosの条件判断をいつも間違うのでちょっと作った AnsiPosは文字列が無い場合0を返しますね。 履歴: 2005/09/22 //------------------------------} function InStr(const SubStr, S: string): Boolean; overload; begin Result := (1 <= (AnsiPosForward(SubStr, S))); end; function InStr(const SubStr, S: string; Index, Count: Integer): Boolean; overload; begin Result := (1 <= (RangeAnsiPosForward(SubStr, S, Index, Count))); end; procedure testInStr; begin Check(True, InStr('A', 'ABC')); Check(True, InStr('B', 'ABC')); Check(True, InStr('C', 'ABC')); Check(True, InStr('あ', 'あいう')); Check(True, InStr('い', 'あいう')); Check(True, InStr('う', 'あいう')); Check(False, InStr('a', 'ABC')); Check(False, InStr('A', 'abc')); Check(False, InStr('え', 'あいう')); end; //------------------------------ {------------------------------- //文字列の改行コードをそろえます 機能: 改行コードを WinCRLF形式 MacCR形式 UnixLF形式 で相互変換します 引数説明: S: 元の文字列 Style: 変換する形式指定 戻り値: 変換された文字列 備考: 履歴: 2002/03/16 //------------------------------} 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; procedure testChangeLineBreakes; procedure CheckFunc(Source, CRLFResult, CRResult, LFResult: String); begin Check(CRLFResult, ChangeLineBreakes(Source, tlbsmpCRLF)); Check(CRResult , ChangeLineBreakes(Source, tlbsmpCR)); Check(LFResult , ChangeLineBreakes(Source, tlbsmpLF)); Check(CRResult , ChangeLineBreakes(CRLFResult, tlbsmpCR)); Check(LFResult , ChangeLineBreakes(CRLFResult, tlbsmpLF)); Check(CRLFResult, ChangeLineBreakes(CRResult , tlbsmpCRLF)); Check(LFResult , ChangeLineBreakes(CRResult , tlbsmpLF)); Check(CRLFResult, ChangeLineBreakes(LFResult , tlbsmpCRLF)); Check(CRResult , ChangeLineBreakes(LFResult , tlbsmpCR)); end; begin //普通に変換 CheckFunc(#10#13+'あいう'+#10#13+'えお'+#10#13, #13#10+'あいう'+#13#10+'えお'+#13#10, #13 +'あいう'+#13 +'えお'+#13, #10 +'あいう'+#10 +'えお'+#10); //混在 CheckFunc(#13#10+'123'+#10#13+'ABC'+#13 +'あいう'+#10 , #13#10+'123'+#13#10+'ABC'+#13#10+'あいう'+#13#10, #13 +'123'+#13 +'ABC'+#13 +'あいう'+#13 , #10 +'123'+#10 +'ABC'+#10 +'あいう'+#10 ); //連続 CheckFunc(#10#13#10#13+'ABC'+#10#13#10#13+'あいう'+#10#13#10#13, #13#10#13#10+'ABC'+#13#10#13#10+'あいう'+#13#10#13#10, #13#13 +'ABC'+#13#13 +'あいう'+#13#13 , #10#10 +'ABC'+#10#10 +'あいう'+#10#10 ); //混在して連続 CheckFunc(#10#13#13 +'123'+#13#13#10 +'ABC'+#10#10#13 , #13#10#13#10+'123'+#13#10#13#10+'ABC'+#13#10#13#10, #13#13 +'123'+#13#13 +'ABC'+#13#13 , #10#10 +'123'+#10#10 +'ABC'+#10#10 ); CheckFunc(#10#13#13 +'123'+#13#10#13 +'あいう'+#10#13#10 , #13#10#13#10+'123'+#13#10#13#10+'あいう'+#13#10#13#10, #13#13 +'123'+#13#13 +'あいう'+#13#13 , #10#10 +'123'+#10#10 +'あいう'+#10#10 ); //改行数のチェック CheckFunc(#10#13#10#13+ 'ABC'+#10#13#10#13#10#13+ '123'+#10#13#10#13#10#13#10#13+ 'あいうえ'+#10#13#10#13#10#13#10#13#10#13, #13#10#13#10+ 'ABC'+#13#10#13#10#13#10+ '123'+#13#10#13#10#13#10#13#10+ 'あいうえ'+#13#10#13#10#13#10#13#10#13#10, #13#13 + 'ABC'+#13#13#13 + '123'+#13#13#13#13 + 'あいうえ'+#13#13#13#13#13 , #10#10 + 'ABC'+#10#10#10 + '123'+#10#10#10#10 + 'あいうえ'+#10#10#10#10#10 ); end; //------------------------------ {------------------------------- // 文字列の最後の改行コードを調べる関数 戻り値: type TLineBreakStyle = (lbsCRLF, lbsCR, lbsLF ,lbsNoLineBreaks); で定義される値が戻る 備考: 履歴: 2003/09/15 作成 //------------------------------} function LastLineBreakStyle(WideStr: WideString): TLineBreakStyle; begin Result := lbsNoLineBreaks; if 2 <= Length(WideStr) then begin if (WideStr[Length(WideStr)-1]=#13) and (WideStr[Length(WideStr)]=#10) then begin Result := lbsCRLF; Exit; end; end; if 1 <= Length(WideStr) then begin case WideStr[Length(WideStr)] of #13: begin Result := lbsCR; Exit; end; #10: begin Result := lbsLF; Exit; end; end; end; end; function LineBreakString(Style: TLineBreakStyle): String; begin case Style of lbsCRLF: Result := CRLF; lbsCR: Result := CR; lbsLF: Result := LF; lbsNoLineBreaks: Result := EmptyStr; end; end; //------------------------------ {------------------------------- // 文字が改行コードかどうか調べる関数 戻り値: Trueなら改行コード #13#10/#13/#10、それぞれを調べることができる。 備考: 履歴: 2007/06/18 作成 //------------------------------} function IsLineBreak(WideStr: WideString): TLineBreakStyle; begin Result := lbsNoLineBreaks; if 2 = Length(WideStr) then begin if (WideStr[Length(WideStr)-1]=#13) and (WideStr[Length(WideStr)]=#10) then begin Result := lbsCRLF; Exit; end; end; if 1 = Length(WideStr) then begin case WideStr[Length(WideStr)] 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 //------------------------------} function StringsReplace(const S: String; OldPatterns, NewPatterns: TStringDynArray; 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 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 := 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; procedure testStringsReplace; var OldPatterns, NewPatterns: TStringDynArray; begin SetLength(OldPatterns, 4); SetLength(NewPatterns, 4); OldPatterns[0] := '123'; NewPatterns[0] := 'ABC'; OldPatterns[1] := 'ABC'; NewPatterns[1] := '123'; OldPatterns[2] := '456'; NewPatterns[2] := 'DEF'; OldPatterns[3] := 'DEF'; NewPatterns[3] := '456'; Check('123ABC123ABC456DEF', StringsReplace('ABC123ABC123DEF456', OldPatterns, NewPatterns, False)); Check('abcABCabcABCdefDEF', StringsReplace('abc123abc123def456', OldPatterns, NewPatterns, False)); Check('123ABC123ABC456DEF', StringsReplace('abc123abc123def456', OldPatterns, NewPatterns, True)); 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 //------------------------------} function WideStringsReplace(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 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; procedure testWideStringsReplace; var OldPatterns, NewPatterns: TWideStringDynArray; begin SetLength(OldPatterns, 4); SetLength(NewPatterns, 4); OldPatterns[0] := '123'; NewPatterns[0] := 'ABC'; OldPatterns[1] := 'ABC'; NewPatterns[1] := '123'; OldPatterns[2] := '456'; NewPatterns[2] := 'DEF'; OldPatterns[3] := 'DEF'; NewPatterns[3] := '456'; Check('123ABC123ABC456DEF', WideStringsReplace('ABC123ABC123DEF456', OldPatterns, NewPatterns, False)); Check('abcABCabcABCdefDEF', WideStringsReplace('abc123abc123def456', OldPatterns, NewPatterns, False)); Check('123ABC123ABC456DEF', WideStringsReplace('abc123abc123def456', OldPatterns, NewPatterns, True)); SetLength(OldPatterns, 1); SetLength(NewPatterns, 1); OldPatterns[0] := '
'; NewPatterns[0] := #13#10; Check(#13#10#13#10#13#10#13#10, WideStringsReplace('



', OldPatterns, NewPatterns, True)); SetLength(OldPatterns, 2); SetLength(NewPatterns, 2); OldPatterns[0] := 'A'; NewPatterns[0] := 'B'; OldPatterns[1] := 'B'; NewPatterns[1] := 'A'; Check('BA', WideStringsReplace('AB', OldPatterns, NewPatterns, True)); 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; procedure testEncodeEscapeSequence; begin Check('ABC\r\nDEF\r\n', EncodeEscapeSequence('ABC'#13#10'DEF'#13#10)); Check('ABC\rDEF\n', EncodeEscapeSequence('ABC'#13'DEF'#10)); Check('\rDEF\n', EncodeEscapeSequence(#13'DEF'#10)); Check('\\rDEF\\n', EncodeEscapeSequence('\rDEF\n')); Check('\\\\rDEF\\\\n', EncodeEscapeSequence('\\rDEF\\n')); Check('ABC\r\nDEF\r\n', EncodeEscapeSequence('ABC'#13#10'DEF'#13#10)); 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; procedure testDecodeEscapeSequence; begin Check('ABC'#13#10'DEF'#13#10, DecodeEscapeSequence('ABC\r\nDEF\r\n')); Check('ABC'#13'DEF'#10, DecodeEscapeSequence('ABC\rDEF\n')); Check(#13'DEF'#10, DecodeEscapeSequence('\rDEF\n')); Check(#13'DEF'#10, DecodeEscapeSequence('\RDEF\N')); Check('\rDEF\n', DecodeEscapeSequence('\\rDEF\\n')); Check('\\rDEF\\n', DecodeEscapeSequence('\\\\rDEF\\\\n')); Check('ABC'#13#10'DEF'#13#10, DecodeEscapeSequence('ABC\R\NDEF\R\N')); end; //------------------------------ {------------------------------- // 英単語の置き換えを処理する 機能: 指定された文字列群の単語を置き換える。 単語の前後をアルファベットかどうかを判断している。 備考: SQL文中の予約語をUpperCaseに そろえる処理の為に実装 英文系しか実用的ではない。 WideStringsReplaceから改造 ※たしか、select→SELECTとすると SQL文中のSELECTが全部大文字化されるけど 『selecter1』という単語は変換されない。 履歴: 2004/01/11 //------------------------------} 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-1], hanAlphaTbl, vitAllInclude)) then {↑↓置き換え} if (1<=ReadIndex) 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])], hanAlphaTbl, vitAllInclude)) then {↑↓置き換え} if (ReadIndex+Length(OldPatterns[i]) <= Length(S)) 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; procedure testTrimLeftChar; begin Check('あ', TrimLeftChar('　　あ', '　')); Check('う', TrimLeftChar('　　　う', '　')); Check('か', TrimLeftChar('あいうえおああいいか', 'あいうえお')); Check('X', TrimLeftChar('　　YY　X', '　Y')); Check('789', TrimLeftChar('012346789', '6543210')); Check('ABCXYZ', TrimLeftChar('XXYYZZABCXYZ', 'XYZ')); Check('', TrimLeftChar('XXYYZZABCXYZ', 'XYZABC')); Check('AAA'#9, TrimLeftChar(#9'AAA'#9, #9)); Check(#9, TrimLeftChar('AAA'#9, 'A')); Check(#9'AAA', TrimLeftChar(#13#10#9'AAA', #13#10)); Check(#13#10, TrimLeftChar(#9'AAA'#13#10, #9'A')); Check('123', TrimLeftChar('123', '')); end; procedure testTrimRightChar; begin Check('　　', TrimRightChar('　　あ', 'あ')); Check('あいうえお', TrimRightChar('あいうえおああいいか', 'かいあ')); Check('う', TrimRightChar('う　　　', '　')); Check('　　YY', TrimRightChar('　　YY　X', '　X')); Check('012', TrimRightChar('012346789', '346789')); Check('XXYYZZABC', TrimRightChar('XXYYZZABCXYZ', 'XYZ')); Check('', TrimRightChar('XXYYZZABCXYZ', 'XYZABC')); Check(#9'AAA', TrimRightChar(#9'AAA'#9, #9)); Check(#9, TrimRightChar(#9'AAA', 'A')); Check(#9'AAA', TrimRightChar(#9'AAA'#13#10, #13#10)); Check(#13#10, TrimRightChar(#13#10#9'AAA', #9'A')); Check('123', TrimRightChar('123', '')); end; procedure testTrimChar; begin Check('ABC', TrimChar('123467829ABC5212694192', '0123456789')); Check('', TrimChar('123467829ABC5212694192', 'ABC0123456789')); Check('かきくけこ', TrimChar('あいうえああいいかきくけこおおえういあい', 'あいうえお')); Check('AAA', TrimChar(#9'AAA'#9, #9)); Check(#9, TrimChar(#9'AAA', 'A')); Check(#9'AAA', TrimChar(#9'AAA'#13#10, #13#10)); Check(#13#10, TrimChar(#9'AAA'#13#10, #9'A')); Check('123', TrimChar('123', '')); 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; procedure testOneTrimChar; begin Check('ABC', OneTrimChar('"ABC"', '"')); Check('"ABC', OneTrimChar('"ABC', '"')); Check('ABC"', OneTrimChar('ABC"', '"')); Check('"ABC"',OneTrimChar('"ABC"', '')); Check('ABC', OneTrimChar('ABC', '')); Check('ABC', OneTrimChar('ABC', '"')); Check('ABC', OneTrimChar('1ABC1', '123')); Check('2ABC2', OneTrimChar('12ABC21', '123')); Check('1ABC2',OneTrimChar('1ABC2', '123')); Check('', OneTrimChar('', '"')); 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; procedure testGetTagText; begin Check('aaa', GetTagText('<', '>', '')); Check('aaa', GetTagText('<', '>', 'abcdef')); Check('aaa', GetTagText('"', '"', '"aaa"')); Check('aaa', GetTagText('"', '"', 'abc"aaa"def')); 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; procedure testWideCharByteLength; begin Check(wcblSingle, WideCharByteLength(WideChar(WideString('a')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('g')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('z')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('A')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('G')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('Z')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('\')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('[')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString(']')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('^')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('`')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('_')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('~')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('{')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('|')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('}')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('｡')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('｢')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('｣')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('､')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('･')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｦ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｧ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｨ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｩ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｪ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｫ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｬ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｭ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｮ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｯ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｰ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｱ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｲ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｳ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｴ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｵ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｶ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｷ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｸ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｹ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｺ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｻ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｼ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｽ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｾ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ｿ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾀ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾁ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾂ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾃ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾄ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾅ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾆ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾇ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾈ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾉ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾊ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾋ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾌ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾍ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾎ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾏ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾐ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾑ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾒ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾓ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾔ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾕ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾖ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾗ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾘ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾙ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾚ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾛ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾜ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾝ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾞ')[1]))); Check(wcblSingle, WideCharByteLength(WideChar(WideString('ﾟ')[1]))); Check(wcblMulti, WideCharByteLength(WideChar(WideString('ａ')[1]))); Check(wcblMulti, WideCharByteLength(WideChar(WideString('Ａ')[1]))); 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; procedure testCharIndexToByteIndex; begin Check(1, CharIndexToByteIndex('a', 1)); Check(2, CharIndexToByteIndex('a', 2)); Check(0, CharIndexToByteIndex('a', 3)); Check(2, CharIndexToByteIndex('abc', 2)); Check(4, CharIndexToByteIndex('abc', 4)); Check(1, CharIndexToByteIndex('あ', 1)); Check(3, CharIndexToByteIndex('あ', 2)); Check(0, CharIndexToByteIndex('あ', 3)); Check(3, CharIndexToByteIndex('あいう', 2)); Check(7, CharIndexToByteIndex('あいう', 4)); Check(8, CharIndexToByteIndex('123１２３abcＡＢＣ', 6)); Check(11, CharIndexToByteIndex('123１２３abcＡＢＣ', 8)); Check(15, CharIndexToByteIndex('123１２３abcＡＢＣ', 11)); Check(19, CharIndexToByteIndex('123１２３abcＡＢＣ', 13)); Check( 0, CharIndexToByteIndex('123１２３abcＡＢＣ', 14)); 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; procedure testByteIndexToCharIndex; begin Check(1, ByteIndexToCharIndex('a', 1)); Check(0, ByteIndexToCharIndex('a', 2)); Check(0, ByteIndexToCharIndex('a', 3)); Check(2, ByteIndexToCharIndex('abc', 2)); Check(0, ByteIndexToCharIndex('abc', 4)); Check(1, ByteIndexToCharIndex('あ', 1)); Check(1, ByteIndexToCharIndex('あ', 2)); Check(0, ByteIndexToCharIndex('あ', 3)); Check(1, ByteIndexToCharIndex('あいう', 2)); Check(2, ByteIndexToCharIndex('あいう', 4)); Check(5, ByteIndexToCharIndex('123１２３abcＡＢＣ', 6)); Check(6, ByteIndexToCharIndex('123１２３abcＡＢＣ', 8)); Check(8, ByteIndexToCharIndex('123１２３abcＡＢＣ', 11)); Check(10, ByteIndexToCharIndex('123１２３abcＡＢＣ', 13)); Check(11, ByteIndexToCharIndex('123１２３abcＡＢＣ', 15)); Check(12, ByteIndexToCharIndex('123１２３abcＡＢＣ', 18)); Check( 0, ByteIndexToCharIndex('123１２３abcＡＢＣ', 19)); end; //------------------------------ {------------------------------- // WideStringの描画半角Byte桁を求める関数 備考: 文字列が半角では何桁になるのかを調べる 履歴: 2006/04/22 WordWrap処理のために作成 //------------------------------} function ByteLength(Source: WideString): Integer; begin Result := CharIndexToByteIndex(Source, Length(Source)+1)-1; end; procedure testCharLengthToByteLength; begin Check(1, ByteLength('a')); Check(1, ByteLength('A')); Check(2, ByteLength('ａ')); Check(2, ByteLength('Ａ')); Check(18, ByteLength('123１２３abcＡＢＣ')); Check(25, ByteLength('確認に使用したコード12345')); 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; //------------------------------ end.