|
|
@@ -0,0 +1,333 @@
|
|
|
+{ %norun }
|
|
|
+
|
|
|
+{$mode delphi}
|
|
|
+
|
|
|
+uses
|
|
|
+ sysutils;
|
|
|
+
|
|
|
+{$define use_inline }
|
|
|
+
|
|
|
+function IndyMin(const AValueOne, AValueTwo: Int32): Int32;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
|
|
|
+begin
|
|
|
+ if AValueOne > AValueTwo then begin
|
|
|
+ Result := AValueTwo;
|
|
|
+ end else begin
|
|
|
+ Result := AValueOne;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function IndyMin(const AValueOne, AValueTwo: Int64): Int64;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
|
|
|
+begin
|
|
|
+ if AValueOne > AValueTwo then begin
|
|
|
+ Result := AValueTwo;
|
|
|
+ end else begin
|
|
|
+ Result := AValueOne;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
|
|
|
+begin
|
|
|
+ if AValueOne > AValueTwo then begin
|
|
|
+ Result := AValueTwo;
|
|
|
+ end else begin
|
|
|
+ Result := AValueOne;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function IndyMax(const AValueOne, AValueTwo: Int64): Int64;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
|
|
|
+begin
|
|
|
+ if AValueOne < AValueTwo then begin
|
|
|
+ Result := AValueTwo;
|
|
|
+ end else begin
|
|
|
+ Result := AValueOne;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function IndyMax(const AValueOne, AValueTwo: Int32): Int32;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
|
|
|
+begin
|
|
|
+ if AValueOne < AValueTwo then begin
|
|
|
+ Result := AValueTwo;
|
|
|
+ end else begin
|
|
|
+ Result := AValueOne;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
|
|
|
+begin
|
|
|
+ if AValueOne < AValueTwo then begin
|
|
|
+ Result := AValueTwo;
|
|
|
+ end else begin
|
|
|
+ Result := AValueOne;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
+var
|
|
|
+ LAvailable: Integer;
|
|
|
+begin
|
|
|
+ Assert(AIndex >= 1);
|
|
|
+ LAvailable := IndyMax(Length(ABuffer)-AIndex+1, 0);
|
|
|
+ if ALength < 0 then begin
|
|
|
+ Result := LAvailable;
|
|
|
+ end else begin
|
|
|
+ Result := IndyMin(LAvailable, ALength);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
+begin
|
|
|
+ if ACharPos < 1 then begin
|
|
|
+ raise Exception.Create('Invalid ACharPos');{ do not localize }
|
|
|
+ end;
|
|
|
+ Result := ACharPos <= Length(AString);
|
|
|
+ if Result then begin
|
|
|
+ Result := AString[ACharPos] = AValue;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+{$HINTS OFF}
|
|
|
+function IsNumeric(const AString: string): Boolean; overload;
|
|
|
+var
|
|
|
+ LCode: Integer;
|
|
|
+ LVoid: Int64;
|
|
|
+begin
|
|
|
+ Val(AString, LVoid, LCode);
|
|
|
+ Result := LCode = 0;
|
|
|
+end;
|
|
|
+{$HINTS ON}
|
|
|
+
|
|
|
+function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean; overload;
|
|
|
+var
|
|
|
+ I: Integer;
|
|
|
+ LLen: Integer;
|
|
|
+begin
|
|
|
+ Result := False;
|
|
|
+ LLen := IndyLength(AString, ALength, AIndex);
|
|
|
+ if LLen > 0 then begin
|
|
|
+ for I := 0 to LLen-1 do begin
|
|
|
+ if not IsNumeric(AString[AIndex+i]) then begin
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ Result := True;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function IsNumeric(const AChar: Char): Boolean; overload;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
+begin
|
|
|
+ // TODO: under XE3.5+, use TCharHelper.IsDigit() instead
|
|
|
+ // TODO: under D2009+, use TCharacter.IsDigit() instead
|
|
|
+
|
|
|
+ // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
|
|
|
+ Result := (AChar >= '0') and (AChar <= '9'); {Do not Localize}
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function StripNo(const AData : String): String; inline;
|
|
|
+var
|
|
|
+ i : Integer;
|
|
|
+ LPos : Integer;
|
|
|
+begin
|
|
|
+ LPos := 1;
|
|
|
+ for i := 1 to Length(AData) do begin
|
|
|
+ LPos := i;
|
|
|
+ if (not IsNumeric(AData[i])) and (not CharEquals(AData, i, ',')) then begin
|
|
|
+ Break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ Result := Copy(AData, LPos, Length(AData));
|
|
|
+end;
|
|
|
+
|
|
|
+function TextStartsWith(const S, SubS: string): Boolean;
|
|
|
+var
|
|
|
+ LLen: Integer;
|
|
|
+ {$IFDEF WINDOWS}
|
|
|
+ {$IFDEF COMPARE_STRING_MISMATCH}
|
|
|
+ LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
|
|
|
+ P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
|
|
|
+ {$ENDIF}
|
|
|
+ {$ENDIF}
|
|
|
+begin
|
|
|
+ LLen := Length(SubS);
|
|
|
+ Result := LLen <= Length(S);
|
|
|
+ if Result then
|
|
|
+ begin
|
|
|
+ {$IFDEF DOTNET}
|
|
|
+ Result := System.String.Compare(S, 0, SubS, 0, LLen, True) = 0;
|
|
|
+ {$ELSE}
|
|
|
+ {$IFDEF WINDOWS}
|
|
|
+ {$IFDEF COMPARE_STRING_MISMATCH}
|
|
|
+ // explicit convert to Ansi/Unicode
|
|
|
+ LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
|
|
|
+ LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
|
|
|
+ LLen := Length(LSubS);
|
|
|
+ Result := LLen <= Length(LS);
|
|
|
+ if Result then begin
|
|
|
+ P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
|
|
|
+ P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
|
|
|
+ Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
|
|
|
+ end;
|
|
|
+ {$ELSE}
|
|
|
+ Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S), LLen, PChar(SubS), LLen) = 2;
|
|
|
+ {$ENDIF}
|
|
|
+ {$ELSE}
|
|
|
+ Result := AnsiCompareText(Copy(S, 1, LLen), SubS) = 0;
|
|
|
+ {$ENDIF}
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure IdDelete(var s: string; AOffset, ACount: Integer);
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
+begin
|
|
|
+ Delete(s, AOffset, ACount);
|
|
|
+end;
|
|
|
+
|
|
|
+function TextEndsWith(const S, SubS: string): Boolean;
|
|
|
+var
|
|
|
+ LLen: Integer;
|
|
|
+ {$IFDEF WINDOWS}
|
|
|
+ {$IFDEF COMPARE_STRING_MISMATCH}
|
|
|
+ LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
|
|
|
+ P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
|
|
|
+ {$ELSE}
|
|
|
+ P: PChar;
|
|
|
+ {$ENDIF}
|
|
|
+ {$ENDIF}
|
|
|
+begin
|
|
|
+ LLen := Length(SubS);
|
|
|
+ Result := LLen <= Length(S);
|
|
|
+ if Result then
|
|
|
+ begin
|
|
|
+ {$IFDEF DOTNET}
|
|
|
+ Result := System.String.Compare(S, Length(S)-LLen, SubS, 0, LLen, True) = 0;
|
|
|
+ {$ELSE}
|
|
|
+ {$IFDEF WINDOWS}
|
|
|
+ {$IFDEF COMPARE_STRING_MISMATCH}
|
|
|
+ // explicit convert to Ansi/Unicode
|
|
|
+ LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
|
|
|
+ LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
|
|
|
+ LLen := Length(LSubS);
|
|
|
+ Result := LLen <= Length(S);
|
|
|
+ if Result then begin
|
|
|
+ P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
|
|
|
+ P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
|
|
|
+ Inc(P1, Length(LS)-LLen);
|
|
|
+ Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
|
|
|
+ end;
|
|
|
+ {$ELSE}
|
|
|
+ P := PChar(S);
|
|
|
+ Inc(P, Length(S)-LLen);
|
|
|
+ Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P, LLen, PChar(SubS), LLen) = 2;
|
|
|
+ {$ENDIF}
|
|
|
+ {$ELSE}
|
|
|
+ Result := AnsiCompareText(Copy(S, Length(S)-LLen+1, LLen), SubS) = 0;
|
|
|
+ {$ENDIF}
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+const
|
|
|
+ IdFetchDelimDefault = ' '; {Do not Localize}
|
|
|
+ IdFetchDeleteDefault = True;
|
|
|
+ IdFetchCaseSensitiveDefault = True;
|
|
|
+
|
|
|
+function FetchCaseInsensitive(var AInput: string; const ADelim: string;
|
|
|
+ const ADelete: Boolean): string;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
+var
|
|
|
+ LPos: Integer;
|
|
|
+begin
|
|
|
+ if ADelim = #0 then begin
|
|
|
+ // AnsiPos does not work with #0
|
|
|
+ LPos := Pos(ADelim, AInput);
|
|
|
+ end else begin
|
|
|
+ //? may be AnsiUpperCase?
|
|
|
+ LPos := Pos(UpperCase(ADelim), UpperCase(AInput));
|
|
|
+ end;
|
|
|
+ if LPos = 0 then begin
|
|
|
+ Result := AInput;
|
|
|
+ if ADelete then begin
|
|
|
+ AInput := ''; {Do not Localize}
|
|
|
+ end;
|
|
|
+ end else begin
|
|
|
+ Result := Copy(AInput, 1, LPos - 1);
|
|
|
+ if ADelete then begin
|
|
|
+ //faster than Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
|
|
|
+ //remaining part is larger than the deleted
|
|
|
+ AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
|
|
|
+ const ADelete: Boolean = IdFetchDeleteDefault;
|
|
|
+ const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
|
|
|
+{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
+var
|
|
|
+ LPos: Integer;
|
|
|
+begin
|
|
|
+ if ACaseSensitive then begin
|
|
|
+ if ADelim = #0 then begin
|
|
|
+ // AnsiPos does not work with #0
|
|
|
+ LPos := Pos(ADelim, AInput);
|
|
|
+ end else begin
|
|
|
+ LPos := Pos(ADelim, AInput);
|
|
|
+ end;
|
|
|
+ if LPos = 0 then begin
|
|
|
+ Result := AInput;
|
|
|
+ if ADelete then begin
|
|
|
+ AInput := ''; {Do not Localize}
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else begin
|
|
|
+ Result := Copy(AInput, 1, LPos - 1);
|
|
|
+ if ADelete then begin
|
|
|
+ //slower Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
|
|
|
+ //remaining part is larger than the deleted
|
|
|
+ AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end else begin
|
|
|
+ Result := FetchCaseInsensitive(AInput, ADelim, ADelete);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function ExtractRecFormat(const ARecFM : String): String;
|
|
|
+ {$IFDEF USE_INLINE} inline; {$ENDIF}
|
|
|
+begin
|
|
|
+ Result := ARecFM;
|
|
|
+ if TextStartsWith(Result, '<') then begin
|
|
|
+ IdDelete(Result, 1, 1);
|
|
|
+ end;
|
|
|
+ if TextEndsWith(Result, '>') then begin
|
|
|
+ Result := Fetch(Result, '>');
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure test;
|
|
|
+var
|
|
|
+ LTmp: string;
|
|
|
+ s: string;
|
|
|
+begin
|
|
|
+ LTmp:='ac';
|
|
|
+ s:=ExtractRecFormat(StripNo(LTmp));
|
|
|
+end;
|
|
|
+
|
|
|
+begin
|
|
|
+end.
|
Jonas Maebe