paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-04 01:12:04 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Moved StringsReplace from sqldb to strutils

Browse Source 
* Removed unused NotYetImplemented procedure from strutils

git-svn-id: trunk@9771 -
This commit is contained in:
joost 2008-01-15 22:13:47 +00:00
parent cd4b05f3de
commit 3852af4afb
5 changed files with 66 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
packages/fcl-db/src/base/dbconst.pas
View File

@ -99,7 +99,6 @@ Resourcestring
SNoFieldIndexes = 'No index currently active';
SNotIndexField = 'Field ''%s'' is not indexed and cannot be modified';
SErrUnknownConnectorType = 'Unknown connector type';
SErrAmountStrings = 'Amount of search and replace strings don''t match';
SNoIndexFieldNameGiven = 'There are no fields selected to base the index on';
SErrCircularDataSourceReferenceNotAllowed = 'Circular datasource references are not allowed.';

2
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
View File

@ -150,7 +150,7 @@ Type
implementation
uses dbconst,ctypes;
uses dbconst,ctypes,strutils;
{ TConnectionName }

2
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -89,7 +89,7 @@ type
implementation
uses math;
uses math, strutils;
ResourceString
SErrRollbackFailed = 'Rollback transaction failed';

63
packages/fcl-db/src/sqldb/sqldb.pp
View File

@ -423,7 +423,6 @@ Procedure UnRegisterConnection(Def : TConnectionDefClass);
Procedure UnRegisterConnection(ConnectionName : String);
Function GetConnectionDef(ConnectorName : String) : TConnectionDef;
Procedure GetConnectionList(List : TSTrings);
function StringsReplace(const S: string; OldPattern, NewPattern: array of string; Flags: TReplaceFlags): string;
implementation
@ -1647,68 +1646,6 @@ begin
List.Text:=ConnDefs.Text;
end;
function StringsReplace(const S: string; OldPattern, NewPattern: array of string; Flags: TReplaceFlags): string;
var pc,pcc,lastpc : pchar;
strcount : integer;
ResStr,
CompStr : string;
Found : Boolean;
sc : integer;
begin
sc := length(OldPattern);
if sc <> length(NewPattern) then
raise exception.Create(SErrAmountStrings);
dec(sc);
if rfIgnoreCase in Flags then
begin
CompStr:=AnsiUpperCase(S);
for strcount := 0 to sc do
OldPattern[strcount] := AnsiUpperCase(OldPattern[strcount]);
end
else
CompStr := s;
ResStr := '';
pc := @CompStr[1];
pcc := @s[1];
lastpc := pc+Length(S);
while pc < lastpc do
begin
Found := False;
for strcount := 0 to sc do
begin
if (length(OldPattern[strcount])>0) and
(OldPattern[strcount][1]=pc^) and
(Length(OldPattern[strcount]) <= (lastpc-pc)) and
(CompareByte(OldPattern[strcount][1],pc^,Length(OldPattern[strcount]))=0) then
begin
ResStr := ResStr + NewPattern[strcount];
pc := pc+Length(OldPattern[strcount]);
pcc := pcc+Length(OldPattern[strcount]);
Found := true;
end
end;
if not found then
begin
ResStr := ResStr + pcc^;
inc(pc);
inc(pcc);
end
else if not (rfReplaceAll in Flags) then
begin
ResStr := ResStr + StrPas(pcc);
break;
end;
end;
Result := ResStr;
end;
{ TSQLConnector }
procedure TSQLConnector.SetConnectorType(const AValue: String);

70
rtl/objpas/strutils.pp
View File

@ -81,6 +81,9 @@ Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideStr
const
{ Default word delimiters are any character except the core alphanumerics. }
WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0'];
resourcestring
SErrAmountStrings = 'Amount of search and replace strings don''t match';
type
TStringSearchOption = (soDown, soMatchCase, soWholeWord);
@ -92,6 +95,7 @@ Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; Se
Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer;
Function PosEx(const SubStr, S: string): Integer;inline; // Offset: Cardinal = 1
Function PosEx(c:char; const S: string; Offset: Cardinal): Integer;
function StringsReplace(const S: string; OldPattern, NewPattern: array of string; Flags: TReplaceFlags): string;
{ ---------------------------------------------------------------------
Soundex Functions.
@ -198,12 +202,6 @@ implementation
---------------------------------------------------------------------}
Procedure NotYetImplemented (FN : String);
begin
Raise Exception.CreateFmt('Function "%s" (strutils) is not yet implemented',[FN]);
end;
function Hex2Dec(const S: string): Longint;
var
HexStr: string;
@ -669,6 +667,66 @@ begin
{$endif}
end;
function StringsReplace(const S: string; OldPattern, NewPattern: array of string; Flags: TReplaceFlags): string;
var pc,pcc,lastpc : pchar;
strcount : integer;
ResStr,
CompStr : string;
Found : Boolean;
sc : integer;
begin
sc := length(OldPattern);
if sc <> length(NewPattern) then
raise exception.Create(SErrAmountStrings);
dec(sc);
if rfIgnoreCase in Flags then
begin
CompStr:=AnsiUpperCase(S);
for strcount := 0 to sc do
OldPattern[strcount] := AnsiUpperCase(OldPattern[strcount]);
end
else
CompStr := s;
ResStr := '';
pc := @CompStr[1];
pcc := @s[1];
lastpc := pc+Length(S);
while pc < lastpc do
begin
Found := False;
for strcount := 0 to sc do
begin
if (length(OldPattern[strcount])>0) and
(OldPattern[strcount][1]=pc^) and
(Length(OldPattern[strcount]) <= (lastpc-pc)) and
(CompareByte(OldPattern[strcount][1],pc^,Length(OldPattern[strcount]))=0) then
begin
ResStr := ResStr + NewPattern[strcount];
pc := pc+Length(OldPattern[strcount]);
pcc := pcc+Length(OldPattern[strcount]);
Found := true;
end
end;
if not found then
begin
ResStr := ResStr + pcc^;
inc(pc);
inc(pcc);
end
else if not (rfReplaceAll in Flags) then
begin
ResStr := ResStr + StrPas(pcc);
break;
end;
end;
Result := ResStr;
end;
{ ---------------------------------------------------------------------
Soundex Functions.