PageRenderTime 28ms CodeModel.GetById 26ms app.highlight 1ms RepoModel.GetById 0ms app.codeStats 0ms

/donations/source/common/JclStringsDonations.pas

https://github.com/the-Arioch/jcl
Pascal | 160 lines | 113 code | 31 blank | 16 comment | 16 complexity | 78470adf211c30c383079c1943a54220 MD5 | raw file
Possible License(s): BSD-3-Clause
  1unit JclStringsDonations;
  2
  3interface
  4
  5uses
  6  Classes, JclStrings, JclSysUtils;
  7
  8const
  9  AnsiQuoteChars  = AnsiString('"''');
 10
 11{ TODO : Author: Mario R. Carro <ochnap2@yahoo.com.ar> }
 12procedure StrToStrings(S, Sep: AnsiString; const List: TStrings;
 13  const AllowEmptyString: Boolean = True; const QuoteChars: String = '';
 14  const CaseSensitive: Boolean = True); overload;
 15
 16{ TODO : Author: Mario R. Carro <ochnap2@yahoo.com.ar> }
 17procedure StrIToStrings(S, Sep: AnsiString; const List: TStrings;
 18  const AllowEmptyString: Boolean = True; const QuoteChars: String = '');
 19
 20{ TODO : Author: Peter Panino <peter-panino@aon.at> }
 21function MyStrToken(var S: AnsiString; Separator: AnsiString): AnsiString;
 22{ TODO : Author: Peter Panino <peter-panino@aon.at> }
 23procedure StrTokenToStrings(S, Separator: AnsiString; const List: TStrings); overload;
 24
 25implementation
 26
 27//--------------------------------------------------------------------------------------------------
 28
 29procedure StrToStrings(S, Sep: AnsiString; const List: TStrings;
 30  const AllowEmptyString: Boolean = True; const QuoteChars: String = '';
 31  const CaseSensitive: Boolean = True);
 32var
 33  FindNextStr: function (const Substr, S: AnsiString; const Index: Integer): Integer;
 34  A, B, L, LS, LQ, Q: Integer;
 35
 36  function FindNextQuote(From: Integer): Integer;
 37  var
 38    I, QI: Integer;
 39  begin
 40    Result := 0;
 41    if Q < 0 then
 42    begin
 43      // Find the nearest opening quote.
 44      for I := 1 to LQ do
 45      begin
 46        QI := FindNextStr(QuoteChars[I], S, From + 1);
 47        if (QI > 0) and ((Result = 0) or (QI < Result)) then
 48          Result := QI;
 49      end;
 50    end
 51    else
 52    begin
 53      // Find the next quote of an item (closing o nested).
 54      QI := FindNextStr(S[Q], S, From + 1);
 55      if QI > 0 then
 56        Result := QI;
 57    end;
 58  end;
 59
 60begin
 61  Assert(List <> nil);
 62
 63  List.Clear;
 64
 65  if S = '' then
 66    Exit;
 67
 68  if CaseSensitive then
 69    FindNextStr := StrSearch
 70  else
 71    FindNextStr := StrFind;
 72
 73  L := Length(Sep);
 74  LS := Length(S);
 75  LQ := Length(QuoteChars);
 76
 77  // Q = -1 means no quote found so far,
 78  // but need to check for them.
 79  // Q = 0 means don't bother about quotes,
 80  // or, in the repeat, no more quotes.
 81  Q := iff(LQ > 0, -1, 0);
 82
 83  B := -L;
 84  repeat
 85    A := B + L + 1;
 86    B := FindNextStr(Sep, S, A) - 1;
 87    if B < 0 then B := LS;
 88
 89    // Need to check for (more) quotes?
 90    if (Q <> 0) and (Q < B) then
 91    begin
 92      if Q < 0 then
 93        Q := FindNextQuote(A);
 94
 95      if (Q > 0) and (Q < B) then
 96      begin
 97        Q := FindNextQuote(Q);
 98
 99        // Jump over nested quotes.
100        while (Q < LS) and (S[Q + 1] = S[Q]) do
101          Q := FindNextQuote(Q);
102
103        B := FindNextStr(Sep, S, Q + 1) - 1;
104        if B < 0 then B := LS;
105        Q := -1;
106      end;
107    end;
108
109    List.Add(Copy(S, A, B - A + 1));
110  until B = LS;
111end;
112
113//--------------------------------------------------------------------------------------------------
114
115procedure StrIToStrings(S, Sep: AnsiString; const List: TStrings;
116  const AllowEmptyString: Boolean = True; const QuoteChars: String = '');
117begin
118  StrToStrings(S, Sep, List, AllowEmptyString, QuoteChars, False);
119end;
120
121//--------------------------------------------------------------------------------------------------
122
123function MyStrToken(var S: AnsiString; Separator: AnsiString): AnsiString;
124var
125  I: Integer;
126begin
127  I := Pos(Separator, S);
128  if I <> 0 then
129  begin
130    Result := Copy(S, 1, I - 1);
131    Delete(S, 1, I + Length(Separator) - 1);
132  end
133  else
134  begin
135    Result := S;
136    S := '';
137  end;
138end;
139
140//--------------------------------------------------------------------------------------------------
141
142procedure StrTokenToStrings(S, Separator: AnsiString; const List: TStrings);
143var
144  Token: AnsiString;
145begin
146  Assert(List <> nil);
147
148  if List = nil then
149    Exit;
150
151  List.Clear;
152  while S <> '' do
153  begin
154    Token := MyStrToken(S, Separator);
155    if Token <> '' then {if S starts with Separator}
156      List.Add(Token);
157  end;
158end;
159
160end.