» Delphi code part 2 - Strings - Blog Archive

Delphi code part 2 - Strings

March 6th, 2007 by William Yang

Here is the part of my old delphi codes, its a unit I use frequently for string manipulation. Some are out of date, newer version of Delphi comes with better codes, same are not as smart as other units written by smart Russians, like faststrings, etc. None the less, they are useful if you like to learn the basics of Delphi or Pascal.

Show Code | Download StrMan.pas

{ ---------------------------------------------------
String Manager Copyright (r) by DreamFactory
Version : 1.75 Author : William Yang
Last Update 25 - Aug - 97
--------------------------------------------------- }
unit StrMan; {String Manager}
interface
{-- Declaretion Part --}
uses Windows, SysUtils, Math, Classes, Registry;
type
TCharSet = set of Char;
const
Decimals = ['0'..'9'];
FloatNums = ['0'..'9', '.'];
Operators = ['+', '-', '*', '/'];
HexDecimals = ['0'..'9', 'A'..'F'];
Letters = ['a'..'z', 'A'..'Z'];
Symbols = ['"', '''', '<', '>', '{', '}', '[', ']', '(', ',', ')'];
Masks : array[1..3] of Char = ('*', '?', '#');
function ReplaceOne(Src, Ch : String; iStart, iCount : Integer ) : String;
function FillStr(Amount : Byte; C : Char) : String;
function TitleCase(SourceStr : String) : String;
function ReplaceAll(Source , Target, ChangeTo : String) : String ;
function Instr(iStart : Integer; Src, Find: String) : Integer;
function CompareStrAry(Source : String; CmpTo : Array of string) : Integer;
function LowCaseStr(S : String) : String;
function LoCase(C : Char) : Char;
procedure StrSplit(SrcStr : String; BreakDownPos : Integer;
var S1, S2 : String);
function LeftStr(S : String; ToPos : Integer) : String;
function RightStr(S : String; ToPos : Integer) : String;
function CharCount(S : String; C : Char) : Integer;
function RemoveChars(S : String; C : TCharSet) : String;
function StrBrief(AString: String; AMaxChar: Integer): String;
function EStrToInt(S : String) : Integer;
function EStrToFloat(S : String) : Real;
function LastDir(Dir: String): String;
function RPos(C: String; Src : String) : Integer; overload;
function RPos(C: String; Src : String; nStart: Integer) : Integer; overload;
function ReturnLine(SList: TStringList; Find: String) : String;
procedure SplitStrC (S:string; C : char; var head, queue : string);
procedure Split(StringList: TStringList; S : string; C : char);
function AppPath: String;
function ReadBetween(Src, Mark1, Mark2: String): String;
procedure RemoveQuate(var Src: String);
function strFileLoad(const aFile: String): String;
procedure strFileSave(const aFile,aString: String);
function JoinStrings(AStrings: TStrings): String; overload;
function JoinStrings(strings: TStrings; delimiter: String): String; overload;
function AddSlashes(AString: String): String;
function StripSlashes(AString: String): String;
implementation
function StrBrief(AString: String; AMaxChar: Integer): String;
begin
if Length(AString)<=AMaxChar then
Result := AString
else
begin
Result := Copy(AString, 0, AMaxChar-3) + '...';
end;
end;
function AddSlashes(AString: String): String;
begin
Result := ReplaceAll(AString, '''', '\''');
Result := ReplaceAll(Result, '"', '\"');
end;
function StripSlashes(AString: String): String;
begin
Result := ReplaceAll(AString, '\''', '''');
Result := ReplaceAll(Result, '\"', '"');
end;
function JoinStrings(AStrings: TStrings): String;
var
i: Integer;
begin
result := '';
for i := 0 to AStrings.Count-2 do
begin
result := result + AStrings[i] + '\';
end;
result := result + AStrings[AStrings.Count-1];
end;
function JoinStrings(strings: TStrings; delimiter: String): String;
var
i: Integer;
begin
if strings.Count=0 then Exit;
Result := strings[0];
if strings.Count>0 then
for i := 1 to strings.Count-1 do
begin
Result := Result + delimiter + strings[i]
end;
end;
function strFileLoad(const aFile: String): String;
var
aStr : TStrings;
begin
Result:='';
aStr:=TStringList.Create;
try
aStr.LoadFromFile(aFile);
Result:=aStr.Text;
finally
aStr.Free;
end;
end;
procedure strFileSave(const aFile,aString: String);
var
Stream: TStream;
begin
Stream := TFileStream.Create(aFile, fmCreate);
try
Stream.WriteBuffer(Pointer(aString)^,Length(aString));
finally
Stream.Free;
end;
end;
procedure RemoveQuate(var Src: String);
begin
if Src='' then Exit;
if Src[1]='"' then Delete(Src, 1, 1);
if Src[Length(Src)]='"' then Delete(Src, Length(Src), 1);
if Src[1]='''' then Delete(Src, 1, 1);
if Src[Length(Src)]='''' then Delete(Src, Length(Src), 1);
end;
function ReadBetween(Src, Mark1, Mark2: String): String;
var
i,j : Integer;
begin
if Mark1='' then i := 1 else i := Pos(Mark1, Src);
if Mark2='' then j := Length(Src) else j := InStr(i + Length(Mark1), Src, Mark2);
if j<=0 then j := Length(Src)+1;
if (i >0) and (j > 0) then
Result := Copy(Src, i + Length(Mark1), j-i-Length(Mark1));
end;
function AppPath: String;
begin
Result := ExtractFilepath(ParamStr(0));
end;
function LastDir(Dir: String): String;
begin
if Dir[Length(Dir)]='\' then
Delete(Dir, Length(Dir), 1);
Result := RightStr(Dir, RPos('\', Dir)+1);
end;
procedure SplitStrC (S:string; C : char; var head, queue : string);
var
I : integer;
Quated: Boolean;
begin
head:=''; queue:='';
Quated := False;
for i := 1 to Length(S) do // Iterate
begin
if S[i]='"' then
begin
if Quated then
begin
if head<>'' then Break;
Quated := False;
end
else
begin
if i=1 then Quated := True
end;
end
else if S[i]=C then
begin Break end
else
Head := Head + S[i];
end; // for
delete(S,1,i);
queue := S;
end;
procedure Split(StringList: TStringList; S : string; C : char);
var
Line: String;
begin
while S <> '' do
begin
SplitStrC(S, C, Line, S);
StringList.Add(Trim(Line));
end;
end;
function ReturnLine(SList: TStringList; Find: String) : String;
var
i :Integer;
s: String;
begin
Result := '';
for i := 0 to SList.Count - 1 do
begin
s := SList[i];
if Pos(Find, s) > 0 then
begin
Result := SList[i];
Exit;
end;
end;
end;
function EStrToFloat(S : String) : Real;
var
i : Integer;
r : String;
begin
r := '';
for i := 1 to Length(S) do
if s[i] in FloatNums then
r := r + s[i];
if r = '' then
Result := 0
else
Result := StrToFloat(r);
end;
function EStrToInt(S: String) : Integer;
var
i : Integer;
r : String;
begin
r := '';
for i := 1 to Length(S) do
if s[i] in Decimals then
r := r + s[i];
if r = '' then
Result := 0
else
Result := StrToInt(r);
end;
function RemoveChars(S : String; C : TCharSet) : String;
var
j : Integer;
begin
// Result := S;
j := 1;
Result := '';
while j <= Length(S) do
begin
if not (S[j] in C) then
Result := Result + S[j];
Inc(j);
end;
end;
function ReplaceOne(Src, Ch : String; iStart, iCount : Integer) : String;
var mResult : String;
begin
mResult := Src;
Delete(mResult, iStart, iCount);
Insert(Ch, mResult, iStart);
ReplaceOne := mResult;
end;
function Instr(iStart : Integer; Src, Find: String) : Integer;
var
CS : String;
begin
CS := Copy(Src, iStart, Length(Src)-iStart+1);
if Pos(Find, CS) <> 0 then
Result := Pos(Find, CS) + iStart - 1
else
Result := 0;
end;
function LeftStr(S : String; ToPos : Integer) : String;
begin
Result := Copy(S, 1, ToPos);
end;
function RightStr(S : String; ToPos : Integer) : String;
begin
Result := Copy(S, ToPos, Length(S) - ToPos + 1);
end;
procedure StrSplit(SrcStr : String; BreakDownPos : Integer;
var S1, S2 : String);
begin
S1 := LeftStr(SrcStr, BreakDownPos - 1);
S2 := RightStr(SrcStr, BreakDownPos - 1);
end;
function ReplaceAll(Source , Target, ChangeTo : String) : String ;
var
Index: Integer;
Src, Tgt, Cht : String;
begin
Src := Source;
Tgt := Target;
Cht := ChangeTo;
Index := Pos(Tgt, Src);
while Index > 0 do
begin
Src := ReplaceOne(Src, Cht, Index, Length(Tgt));
Index := Index + Length(Cht);
Index := Instr(Index, Src, Tgt);
end;
Result := Src;
end;
function LoCase(C : Char) : Char;
begin
if (Ord(C) >= Ord('A')) and (Ord(C) <= Ord('Z')) then
Result := Chr(Ord(C) - (Ord('A') - Ord('a')))
else LoCase := C;
end;
function LowCaseStr(S : String) : String;
var i : Integer;
begin
for i := 1 to Length(S) do
S[i] := LoCase(S[i]);
end;
{Make The First Letter Of Each Word To Upper Case}
function TitleCase(SourceStr : String) : String;
var
I : Integer;
First : boolean;
begin
Result := SourceStr;
First := True;
for I := 1 to Length(SourceStr) do
begin
if First then
Result[I] := UpCase(Result[I])
else
Result[I] := LoCase(Result[I]);
First := False;
if Result[I] in [' ', '=', '"', '''', ',', ';', '.'] then First := True;
end;
TitleCase := Result;
end;
{Fill The String With Parameter 'C'}
function FillStr(Amount : Byte; C : Char) : String;
var R : String;
i : byte;
begin
for i :=1 to Amount do
R := R + C;
Result := R;
end;
function CompareStrAry(Source : String; CmpTo : Array of string) : integer;
var i : Integer;
begin
Result := -1;
for i := Low(CmpTo) to High(CmpTo) do
begin
if LowCaseStr(Source) = LowCaseStr(CmpTo[i]) then
begin
Result := i;
Exit;
end;
end;
end;
function RPos(C: String; Src : String) : Integer;
begin
result := RPos(C, Src, 1);
end;
function RPos(C: String; Src : String; nStart: Integer) : Integer;
var
i : integer;
begin
Result := 0;
for i := Length(Src) downto nStart do
if Src[i] = C then
begin
Result := i;
Break;
end;
end;
function CharCount(S : String; C : Char) : Integer;
var i : Integer;
begin
Result := 0;
for i := 1 to Length(S) do
if S[i] = C then Result := Result + 1;
end;
end.

This entry was posted on Tuesday, March 6th, 2007 at 10:53 am and is filed under Delphi, Delphi code. You can follow any responses to this entry through the RSS 2.0 feed. You can leave a response, or trackback from your own site.

Tiaon Lab

Delphi code part 2 - Strings

Leave a Reply

Pages