100分求:DELPHI 关于字符串操作的一些函数?? (100分)

  • 主题发起人 wiseinfo
  • 开始时间
W

wiseinfo

Unregistered / Unconfirmed
GUEST, unregistred user!
100分求:DELPHI 关于字符串操作的一些函数??
一个字符串在另一个字符串出现的次数??
一个字符串在别一个字符串出现的第X次的位置??
X表示出现的第几次??
多多益善,最好是DELPHI自带的!!
还有个问题,实现SQL SERVER视图对应的基表字段??
我现在用字符串函数对SQL 语句进行分析,好象很麻烦的!!

 
深度历险上的
unit xStrings;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses SysUtils, Classes, Windows, FileCtrl, Dialogs;

const
DEFAULT_DELIMITERS = [' ', #9, #10, #13];
CRLF=#13#10;

function GetToken(const S: string
index: Integer
bTrail: Boolean = False
Delimiters: TSysCharSet = DEFAULT_DELIMITERS): string;
function CountWords(S: string
Delimiters: TSysCharSet = DEFAULT_DELIMITERS): Integer;
function BracketString(const S: string): string

///分割一个字符串,其中分割的标志是ch
function SplitString(const source,ch:string):tstrings;
function striptags(value:string):string;
{strip HTML tags from value}
{example: striptags('<TR><TD Align="center">Hello World</TD>') = 'Hello World'}


procedure TruncateCRLF(var S: string);
function IsContainingCRLF(const S: string): Boolean;

function ReplaceString(var S: string
const Token, NewToken: string
bCaseSensitive: Boolean): Boolean;
procedure Simple_ReplaceString(var S: string
const Substr: string
index, Count: Integer);

function UnquoteString(const S: string): string;
function FirstToken(var S: string
const Delimiter: string
Remove: Boolean): string;
function AddTimeStamp(const S: string): string;

function PartialIndexOf(SL: TStrings
S: string
StartIndex: Integer
bForward: Boolean): Integer;
function CompositeStrings(SL: TStrings
const Delimiter: string): string;

function SafeLoadStrings(SL: TStrings
const Filename: string): Boolean;
procedure SafeSaveStrings(SL: TStrings
const Filename: string);

procedure RemoveDuplicates(SL: TStrings);
function ParseRPLNo(var Msg: string): Integer;

function RPos(const C: Char
const S: string): Integer;
function AnsiIPos(const Substr, S: string): Integer;
function MatchString(S, SubS: string
Options: TFindOptions): Integer;

implementation

function GetToken(const S: string
index: Integer
bTrail: Boolean = False
Delimiters: TSysCharSet = DEFAULT_DELIMITERS): string;
var
I, W, head, tail: Integer;
bInWord : Boolean;
begin
I := 1;
W := 0;
bInWord := False;
head := 1;
tail := Length(S);
while (I <= Length(S)) and (W <= index) do
begin
if S in Delimiters then
begin
if (W = index) and bInWord then tail := I - 1;
bInWord := False;
end else
begin
if not bInWord then
begin
bInWord := True;
Inc(W);
if W = index then head := I;
end;
end;

Inc(I);
end;

if bTrail then tail := Length(S);
if W >= index then Result := Copy(S, head, tail - head + 1)
else Result := '';
end;

function CountWords(S: string
Delimiters: TSysCharSet = DEFAULT_DELIMITERS): Integer;
var
bInWord: Boolean;
I : Integer;
begin
Result := 0;
I := 1;
bInWord := False;
while I <= Length(S) do
begin
if S in Delimiters then bInWord := False
else
begin
if not bInWord then
begin
bInWord := True;
Inc(Result);
end;
end;

Inc(I);
end;
end;

function IsContainingCRLF(const S: string): Boolean;
var
len: Integer;
begin
len := Length(S);
Result := (len >= 2) and (S[len - 1] = #13) and (S[len] = #10);
end;

procedure TruncateCRLF(var S: string);
var
I: Integer;
begin
I := 1;
while I <= Length(S) do
if (S = #13) or (S = #10) then Delete(S, I, 1)
else Inc(I);
end;

function ReplaceString(var S: string
const Token, NewToken: string
bCaseSensitive: Boolean): Boolean;
var
I : Integer;
sFirstPart: string

begin
if bCaseSensitive then
I := AnsiPos(Token, S)
else
I := AnsiPos(AnsiUpperCase(Token), AnsiUpperCase(S));

if I <> 0 then
begin
sFirstPart := Copy(S, 1, I - 1) + NewToken
// 磷?礚絘患癹
S := Copy(S, I + Length(Token), Maxint);
end;

Result := I <> 0;
if Result then
begin
ReplaceString(S, Token, NewToken, bCaseSensitive);
S := sFirstPart + S;
end;
end;

procedure Simple_ReplaceString(var S: string
const Substr: string
index, Count: Integer);
begin
S := Format('%s%s%s',[Copy(S, 1, index - 1), Substr, Copy(S, index + Count, Maxint)]);
end;

function BracketString(const S: string): string;
begin
Result := S;
if (Result = '') or (Result[1] <> '[') then Result := '[' + Result;
if Result[Length(Result)] <> ']' then Result := Result + ']';
end;

function UnquoteString(const S: string): string;
begin
if S = '' then Exit;

Result := S;

if Result[1] = '"' then Delete(Result, 1, 1);
if Result = '' then Exit;

if Result[Length(Result)] = '"' then Delete(Result, Length(Result), 1);
end;

function FirstToken(var S: string
const Delimiter: string
Remove: Boolean): string;
var
I: Integer;
begin
I := Pos(Delimiter, S);
if I <> 0 then
begin
Result := Copy(S, 1, I - 1);
if Remove then S := Trim(Copy(S, I + 1, Maxint));
end else
begin
Result := S;
if Remove then S := '';
end;
end;

function CompositeStrings(SL: TStrings
const Delimiter: string): string;
var
I: Integer;
begin
Result := '';

with SL do
begin
for I := 0 to Count - 2 do
Result := Result + Strings + Delimiter;
if Count > 0 then
Result := Result + Strings[Count - 1];
end;
end;

function AddTimeStamp(const S: string): string;
begin
if S = '' then
Result := DateTimeToStr(Now)
else if S[Length(S)] = #10 then
Result := Copy(S, 1, Length(S) - 2) + ' at ' + DateTimeToStr(Now) + #13#10
else
Result := S + ' at ' + DateTimeToStr(Now);
end;

function SafeLoadStrings(SL: TStrings
const Filename: string): Boolean;
begin
Result := False;
repeat
try
if not FileExists(Filename) then Exit;
SL.LoadFromFile(Filename);
Result := True;
Break;
except
Sleep(500);
end;
until False;
end;

procedure SafeSaveStrings(SL: TStrings
const Filename: string);
begin
ForceDirectories(ExtractFilePath(Filename));
repeat
try
SL.SaveToFile(Filename);
Break;
except
Sleep(500);
end;
until False;
end;

function PartialIndexOf(SL: TStrings
S: string
StartIndex: Integer
bForward: Boolean): Integer;
begin
with SL do
begin
if bForward then
begin
for Result := StartIndex to Count - 1 do
if AnsiCompareText(S, Copy(Strings[Result], 1, Length(S))) = 0 then Exit;
end else
begin
for Result := StartIndex downto 0 do
if AnsiCompareText(S, Copy(Strings[Result], 1, Length(S))) = 0 then Exit;
end;
end;

Result := -1;
end;

// duplicated string must be adjacent ..
procedure RemoveDuplicates(SL: TStrings);
var
I: Integer;
begin
with SL do
begin
I := 1;
while I < Count do
if CompareText(Strings, Strings[I - 1]) = 0 then
Delete(I)
else
Inc(I);
end;
end;

function ParseRPLNo(var Msg: string): Integer;
var
S: string;
begin
S := GetToken(Msg, 1, False);
Result := StrToIntDef(S, 0);
Msg := GetToken(Msg, 2, True);
end;

function RPos(const C: Char
const S: string): Integer;
var
I: Integer;
begin
Result := 0;
I := Length(S);
repeat
if S = C then
begin
Result := I;
Exit;
end;
dec(I);
until I < 1;
end;

function AnsiIPos(const Substr, S: string): Integer;
begin
Result := AnsiPos(AnsiLowerCase(Substr), AnsiLowerCase(S));
end;

function MatchString(S, SubS: string
Options: TFindOptions): Integer;
const
Delimiters = [#0..#47, #58..#64, #123..#255];
var
EndI: Integer;
begin
if not (frMatchCase in Options) then
begin
S := AnsiUpperCase(S);
SubS := AnsiUpperCase(SubS);
end;

if frWholeWord in Options then
begin
Result := 1;
EndI := Length(SubS);
while EndI <= Length(S) do
begin
if ((Result = 1) or (S[Result - 1] in Delimiters)) and ((EndI = Length(S)) or (S[EndI + 1] in Delimiters)) and
(AnsiCompareStr(Copy(S, Result, Length(SubS)), SubS) = 0) then Break;
Inc(Result);
Inc(EndI);
end;
Result := EndI;
if Result > Length(S) then Result := 0;
end else Result := AnsiPos(SubS, S);
end;

function SplitString(const source,ch:string):tstrings;
var
temp:string;
i:integer;
begin
result:=tstringlist.Create;
temp:=source;
i:=pos(ch,source);
while i<>0 do
begin
result.Add(copy(temp,0,i-1));
delete(temp,1,i);
i:=pos(ch,temp);
end;
result.Add(temp);
end;

function striptags(value:string):string;
var
i:integer;
s:string;
begin
i:=1;
s:='';
while i<=length(value) do
begin
if value='<' then repeat inc(i) until (value='>') else s:=s+value;
inc(i);
end;
result:=s;
end;

end.
 
thank !!!继续~~~
 
AnsiCompareStr(const s1,s2:String):Boolean:区分大小写比较
AnsiCompareText(const s1,s2:String):Boolean:不区分大小写比较
AnsiConstainsStr(Const Atext,ASubText:String):Boolean;区分大小写查找
AnsiConstainsText(Const Atext,ASubText:String):Boolean;不区分大小写查找
AnsiEdnsStr(const ASubtext,AText:String):Boolean;区分大小写判断给定字符串是否在尾部
AnsiEdnsText(const ASubtext,AText:String):Boolean;不区分大小写判断给定字符串是否在尾部
AnsiIndexStr(const Atext:String;const AValues:array of string):Integer
返加字符串数组中指定字符串的索引值,区分大小写。并且以0作为偏移的基数如果没有有找到完全区配的字
符串函数返回-1;
AnsiReplaceStr(const Atex,AFromText,AToText:String):String
实现替换字符串中的子串。区分大小写
AnsiReplaceText(const Atex,AFromText,AToText:String):String
实现替换字符串中的子串。不区分大小写
AnsiSameStr(const S1,S2:String);比较两字符串是否相等。区分大小写
AnsiSameText(const S1,S2:String);比较两字符串是否相等。不区分大小写
AnsiStrPos:pchar
AnsiTextPos:pchar;一个区分大小写,一个不区分
。。。。。。。。
手写酸了。
 
Delphi6函数大全(1)
<<Delphi6函数大全1-StrUtils.pas>>

首部 function AnsiResemblesText(const AText, AOther: string): Boolean
$[StrUtils.pas
功能 返回两个字符串是否相似
说明 ANSI(American National Standards Institute)美国国家标准协会;不区分大小写
参考 function StrUtils.SoundexProc
var StrUtils.AnsiResemblesProc
例子 CheckBox1.Checked := AnsiResemblesText(Edit1.Text, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiContainsText(const AText, ASubText: string): Boolean
$[StrUtils.pas
功能 返回字符串AText是否包含子串ASubText
说明 不区分大小写
参考 function StrUtils.AnsiUppercase
function StrUtils.AnsiPos
例子 CheckBox1.Checked := AnsiContainsText(Edit1.Text, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiStartsText(const ASubText, AText: string): Boolean
$[StrUtils.pas
功能 返回字符串AText是否以子串ASubText开头
说明 不区分大小写
参考 function Windows.CompareString
例子 CheckBox1.Checked := AnsiStartsText(Edit1.Text, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiEndsText(const ASubText, AText: string): Boolean
$[StrUtils.pas
功能 返回字符串AText是否以子串ASubText结尾
说明 不区分大小写
参考 function Windows.CompareString
例子 CheckBox1.Checked := AnsiEndsText(Edit1.Text, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiReplaceText(const AText, AFromText, AToText: string): string
$[StrUtils.pas
功能 返回字符串AText中用子串AFromText替换成子串AToText的结果
说明 不区分大小写
参考 function SysUtils.StringReplace
type SysUtils.TReplaceFlags
例子 Edit4.Text := AnsiReplaceText(Edit1.Text, Edit2.Text, Edit3.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiMatchText(const AText: string
const AValues: array of string): Boolean
$[StrUtils.pas
功能 返回字符串数组AValues中是否包含字符串AText
说明 不区分大小写
参考 function StrUtils.AnsiIndexText
例子 CheckBox1.Checked := AnsiMatchText(Edit1.Text, ['a1', 'a2', 'a3', 'a4']);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiIndexText(const AText: string
const AValues: array of string): Integer
$[StrUtils.pas
功能 返回字符串AText在字符串数组AValues中的位置
说明 不区分大小写;如果不包含则返回-1
参考 function SysUtils.AnsiSameText
例子 SpinEdit1.Value := AnsiIndexText(Edit1.Text, ['a1', 'a2', 'a3', 'a4']);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiContainsStr(const AText, ASubText: string): Boolean
$[StrUtils.pas
功能 返回字符串AText是否包含子串ASubText
说明 区分大小写
参考 function StrUtils.AnsiPos
例子 CheckBox1.Checked := AnsiContainsStr(Edit1.Text, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiStartsStr(const ASubText, AText: string): Boolean
$[StrUtils.pas
功能 返回字符串AText是否以子串ASubText开头
说明 区分大小写
参考 function SysUtils.AnsiSameStr
例子 CheckBox1.Checked := AnsiStartsStr(Edit1.Text, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiEndsStr(const ASubText, AText: string): Boolean
$[StrUtils.pas
功能 返回字符串AText是否以子串ASubText结尾
说明 区分大小写
参考 function SysUtils.AnsiSameStr
例子 CheckBox1.Checked := AnsiEndsStr(Edit1.Text, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiReplaceStr(const AText, AFromText, AToText: string): string
$[StrUtils.pas
功能 返回字符串AText中用子串AFromText替换成子串AToText的结果
说明 区分大小写
参考 function SysUtils.StringReplace
type SysUtils.TReplaceFlags
例子 Edit4.Text := AnsiReplaceStr(Edit1.Text, Edit2.Text, Edit3.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiMatchStr(const AText: string
const AValues: array of string): Boolean
$[StrUtils.pas
功能 返回字符串数组AValues中是否包含字符串AText
说明 区分大小写
参考 function StrUtils.AnsiIndexStr
例子 CheckBox1.Checked := AnsiMatchStr(Edit1.Text, ['a1', 'a2', 'a3', 'a4']);
━━━━━━━━━━━━━━━━━━━━━
首部 function AnsiIndexStr(const AText: string
const AValues: array of string): Integer
$[StrUtils.pas
功能 返回字符串AText在字符串数组AValues中的位置
说明 区分大小写
参考 function SysUtils.AnsiSameStr
例子 SpinEdit1.Value := AnsiIndexStr(Edit1.Text, ['a1', 'a2', 'a3', 'a4']);
━━━━━━━━━━━━━━━━━━━━━
首部 function DupeString(const AText: string
ACount: Integer): string
$[StrUtils.pas
功能 返回字符串AText的ACount个复本
说明 当ACount为0时返回''
参考 function System.SetLength
例子 Edit3.Text := DupeString(Edit1.Text, SpinEdit1.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function ReverseString(const AText: string): string
$[StrUtils.pas
功能 返回字符串AText的反序
说明 ReverseString('1234') = '4321'
参考 function System.SetLength
例子 Edit3.Text := ReverseString(Edit1.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function StuffString(const AText: string
AStart, ALength: Cardinal
const ASubText: string): string
$[StrUtils.pas
功能 返回嵌套字符串
说明 AStart:嵌套开始位置;ALength:嵌套长度;StuffString('abcd', 2, 0, '12') = 'a12bcd'
参考 function System.Copy
例子 Edit3.Text := StuffString(Edit1.Text, SpinEdit1.Value, SpinEdit2.Value, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function RandomFrom(const AValues: array of string): string
overload
$[StrUtils.pas
功能 随机返回字符串数组AValues中的一个元素
说明 之前建议执行Randomize
参考 function System.Random
例子 Randomize
Edit3.Text := RandomFrom(['a1', 'a2', 'a3', 'a4']);
━━━━━━━━━━━━━━━━━━━━━
首部 function IfThen(AValue: Boolean
const ATrue: string
AFalse: string = ''): string
overload
$[StrUtils.pas
功能 返回指定的逻辑字符串
说明 IfThen(True, '是', '否') = '是';IfThen(False, '是', '否') = '否'
参考 <NULL>
例子 Edit3.Text := IfThen(CheckBox1.Checked, Edit1.Text, Edit2.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function LeftStr(const AText: string
const ACount: Integer): string
$[StrUtils.pas
功能 返回字符串AText左边的ACount个字符
说明 LeftStr('123456', 3) = '123'
参考 function System.Copy
例子 Edit3.Text := LeftStr(Edit1.Text, SpinEdit1.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function RightStr(const AText: string
const ACount: Integer): string
$[StrUtils.pas
功能 返回字符串AText右边的ACount个字符
说明 RightStr('123456', 3) = '456'
参考 function System.Copy
例子 Edit3.Text := RightStr(Edit1.Text, SpinEdit1.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function MidStr(const AText: string
const AStart, ACount: Integer): string
$[StrUtils.pas
功能 返回字符串AText从AStart开始的ACount个字符
说明 其实就是Copy
参考 function System.Copy
例子 Edit3.Text := MidStr(Edit1.Text, SpinEdit1.Value, SpinEdit2.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function SearchBuf(Buf: PChar
BufLen: Integer
SelStart, SelLength: Integer
SearchString: String
Options: TStringSearchOptions = [soDown]): PChar
$[StrUtils.pas
功能 返回第一个搜索到的指针位置
说明 这函数常用于文本中搜索字符串
参考 <NULL>
例子
///////Begin SearchBuf
function SearchEdit(EditControl: TCustomEdit
const SearchString: String;
SearchOptions: TStringSearchOptions
FindFirst: Boolean = False): Boolean;
var
Buffer, P: PChar;
Size: Word;
begin
Result := False;
if (Length(SearchString) = 0) then Exit;
Size := EditControl.GetTextLen;
if (Size = 0) then Exit;
Buffer := StrAlloc(Size + 1);
try
EditControl.GetTextBuf(Buffer, Size + 1);
P := SearchBuf(Buffer, Size, EditControl.SelStart, EditControl.SelLength,
SearchString, SearchOptions);
if P <> nil then begin
EditControl.SelStart := P - Buffer;
EditControl.SelLength := Length(SearchString);
Result := True;
end;
finally
StrDispose(Buffer);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
SearchOptions: TStringSearchOptions;
begin
SearchOptions := [];
if CheckBox1.Checked then
Include(SearchOptions, soDown);
if CheckBox2.Checked then
Include(SearchOptions, soMatchCase);
if CheckBox3.Checked then
Include(SearchOptions, soWholeWord);
SearchEdit(Memo1, Edit1.Text, SearchOptions);
Memo1.SetFocus;
end;
///////End SearchBuf
━━━━━━━━━━━━━━━━━━━━━
首部 function Soundex(const AText: string
ALength: TSoundexLength = 4): string
$[StrUtils.pas
功能 返回探测字符串
说明 根据探测法(Soundex)可以找到相进的字符串;http://www.nara.gov/genealogy/coding.html
参考 <NULL>
例子 Edit2.Text := Soundex(Edit1.Text, SpinEdit1.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function SoundexInt(const AText: string
ALength: TSoundexIntLength = 4): Integer
$[StrUtils.pas
功能 返回探测整数
说明 ALength的值越大解码准确率越高
参考 <NULL>
例子 SpinEdit2.Value := SoundexInt(Edit1.Text, SpinEdit1.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function DecodeSoundexInt(AValue: Integer): string
$[StrUtils.pas
功能 返回探测整数的解码
说明 DecodeSoundexInt(SoundexInt('hello')) 相当于 Soundex('hello')
参考 <NULL>
例子 Edit2.Text := DecodeSoundexInt(SpinEdit2.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function SoundexWord(const AText: string): Word
$[StrUtils.pas
功能 返回探测文字数值
说明 没有参数ALength已经固定为4
参考 <NULL>
例子 SpinEdit2.Value := SoundexWord(Edit1.Text);
━━━━━━━━━━━━━━━━━━━━━
首部 function DecodeSoundexWord(AValue: Word): string
$[StrUtils.pas
功能 返回探测文字数值的解码
说明 DecodeSoundexWord(SoundexWord('hello')) 相当于 Soundex('hello')
参考 <NULL>
例子 Edit2.Text := DecodeSoundexWord(SpinEdit2.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function SoundexSimilar(const AText, AOther: string
ALength: TSoundexLength = 4): Boolean
$[StrUtils.pas
功能 返回两个字符串的探测字符串是否相同
说明 Result := Soundex(AText, ALength) = Soundex(AOther, ALength)
参考 <NULL>
例子 CheckBox1.Checked := SoundexSimilar(Edit1.Text, Edit2.Text, SpinEdit1.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function SoundexCompare(const AText, AOther: string
ALength: TSoundexLength = 4): Integer
$[StrUtils.pas
功能 返回比较两个字符串的探测字符串的结果
说明 Result := AnsiCompareStr(Soundex(AText, ALength), Soundex(AOther, ALength))
参考 function SysUtils.AnsiCompareStr
例子 SpinEdit2.Value := SoundexCompare(Edit1.Text, Edit2.Text, SpinEdit1.Value);
━━━━━━━━━━━━━━━━━━━━━
首部 function SoundexProc(const AText, AOther: string): Boolean
$[StrUtils.pas
功能 调用SoundexSimilar返回两个字符串的探测字符串是否相同
说明 系统变量AnsiResemblesProc的默认值
参考 function StrUtils.AnsiResemblesText
例子 [var AnsiResemblesProc: TCompareTextProc = SoundexProc;]
━━━━━━━━━━━━━━━━━━━━━





 
GZ
//------------------------------------------------------------------------------
pos():位置。
 
你的e_mail是多少,我妹給你!
 
wiseinfo@163.com
我就要发分了!!!
 
大哥问个问题:
决定系统好坏,数据库占很大方面对吗?
前台实现可以有很多种方式,但数据库必须规划好。
 
多人接受答案了。
 
顶部