Delphi code part 2 - Strings
March 6th, 2007 by William YangHere 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.

