delphi 高人写的实用单元 uStrUtils  
官方Delphi 学习QQ群： 682628230（三千人）
频道

  1. 人气：
  2. 放大
  3. 缩小
  4. 二维码
  5. 赞赏

delphi 高人写的实用单元 uStrUtils

unit uStrUtils;

interface

uses
  SysUtils, Classes, System.RegularExpressions, StrUtils, StdCtrls, System.NetEncoding, DateUtils;

Type
  TDoGroup = reference to procedure(const AStrs: string);
  TArrayString = array of string;
  TArrayChar = array of Char;

function GetRegExpStr(AText, aRegExp: string): string;
{ 从aText中按aRegExp规则得到字串，
  但字串要是唯一的，否则，返回空.
}

function GetStrsByRegExp(AText, APattern: string): TStringList;
function GetStrsByRegExpEx(AText, APattern: string): TStringList;

function GetTextByRegExp(AText, APattern: string): string;

// 原字符串 要替换的子串 替换后的子串
function ReplaceAll(const strSource, strCutSub, strInsertSub: string): string;
function ReplaceByReg(const ASource, ACutSub, AInsterSub: string): string;

function ClearAllSpace(const s: string): string;
function ClearAllBlank(const s: string): string;
function ClearAllSpaceToOne(const s: string): string;

function TextNewLine(const AStr: string): string;

function GetStrBetween(AStr, ABegin, AEnd: string): string;

function IsEmptyStr(const AStr: string): Boolean;
function IsNotEmptyStr(const AStr: string): Boolean; inline;

function IncludeStr(const AStr, ASub: string): Boolean;
function NotIncludeStr(const AStr, ASub: string): Boolean;

function IncludeAnyStr(const AStr: string; ASubList: TStringList): Boolean;
function NotIncludeAnyStr(const AStr: string; ASubList: TStringList): Boolean;

function AnyStrPos(AStr: String; ASubList: TStringList): integer;

procedure SaveTextToFile(const AFileName, AText: string);
function LoadTextFromFile(AFileName: string): string;

procedure AddTextToFile(const AFileName, AText: String);

procedure LoadTextToList(AStrs: TStrings; const AFileName: string); overload;
procedure LoadTextToList(AMemo: TMemo; const AFileName: string); overload; inline;

procedure AddStrsToList(const AStrs: string; AList: TStringList);

function GetRandNumStr(ACount: integer): string;

function JoinStrsBySymbol(AStrList: TStringList; ASymbol: string = ';'): string; overload;
function JoinStrsBySymbol(AList: TStrings; ASymbol: string = ';'): string; overload; inline;
function JoinStrsBySymbol(AMemo: TMemo; ASymbol: string = ';'): string; overload; inline;

function Convert(const Bytes: TBytes): RawByteString;

function LoadAnsiStringToStream(AStr: AnsiString; AStream: TStream): integer;
function LoadRawByteStringToStream(AStr: RawByteString; AStream: TStream): integer;

procedure DeleteBlanks(AStrList: TStringList); overload;
procedure DeleteBlanks(AList: TStrings); overload; inline;
procedure DeleteBlanks(AMemo: TMemo); overload; inline;

procedure TrimList(AStrList: TStringList); overload;
procedure TrimList(AList: TStrings); overload; inline;
procedure TrimList(AMemo: TMemo); overload; inline;

procedure RemoveDuplicates(AStrList: TStringList); overload;
procedure RemoveDuplicates(AList: TStrings); overload; inline;
procedure RemoveDuplicates(AMemo: TMemo); overload; inline;

function TextToHtml(const AStr: string): string;
function HttpEncodeX(const AStr: string): string;
function TextToStrs(const AText: string): TStringList;

function ConvUrl(const AStr: string): string;

function CheckStrByRegPattern(const AStr, ARegPattern: string): Boolean;

function GenNewGUID: string;

procedure LowerCaseList(AStrList: TStringList); overload;
procedure LowerCaseList(AList: TStrings); overload; inline;
procedure LowerCaseList(AMemo: TMemo); overload; inline;

procedure DivStrsGroup(AStrs: string; AGroupLength: integer; ADoGroup: TDoGroup);

function HasTwoSubStr(AStrs: string; ASub: string): Boolean;
function HalfStr(AStr: string): string;

function GetCallAndMobNum(s: string; var ACall, AMobNum: string): Boolean;

function SearchStrsInText(AText: string; ArrString: TArrayString): Boolean;

function IncludeAnyText(AText: string; ASubStrs: TStringList): Boolean;

function CheckPatternListInText(AForText: string; APatternList: TStringList): Boolean;

{ 从右边开始查找,Result返回正常的Position }
function ALeftPosEx(const ASubStr, s: string; ARightOffset: integer = 1): integer;

function StrToUCS2LE(const AStr: string): String;

function CompareText(const S1, S2: string; ACaseSensitive: Boolean = true): Boolean;

function RepeatAtr(AStr: string; ACount: integer): string;

function CharInArray(C: Char; ArrChar: TArrayChar): Boolean;
function DateTimeToGMT(const ADate: TDateTime): string;

implementation

uses Math, HttpApp;

function GetStrBetween(AStr, ABegin, AEnd: string): string;

var
  BeginPos: integer;
  EndPos: integer;
begin
  Result := '';
  try
    BeginPos := PosEx(ABegin, AStr, 1);
    if BeginPos > 0 then
    begin
      BeginPos := BeginPos + Length(ABegin);
      EndPos := PosEx(AEnd, AStr, BeginPos);
      if EndPos > 0 then
        Result := Copy(AStr, BeginPos, EndPos - BeginPos)
    end;
  except
    on e: Exception do
    begin
      Result := '';
    end;

  end;
end;

function IsEmptyStr(const AStr: string): Boolean;
begin
  Result := Length(trim(AStr)) = 0;
end;

function IsNotEmptyStr(const AStr: string): Boolean;
begin
  Result := Length(trim(AStr)) > 0;
end;

function ReplaceAll(const strSource, strCutSub, strInsertSub: string): string;

// 原字符串 要替换的子串 替换后的子串
var
  iPos: integer;

  iCutLength: integer;
  iInsertLength: integer;

  strPrior, strNext, strMidResult: string;

begin
  strMidResult := strSource;
  Result := strSource;

  { iPos := PosEx(strCutSub, strInsertSub);
    if iPos > 0 then
    raise Exception.Create('替换后的字符串不可包含替换前的字符串(将导致ReplaceAll死循环)!'); }

  iCutLength := Length(strCutSub);
  iInsertLength := Length(strInsertSub);

  iPos := PosEx(strCutSub, strMidResult);
  while iPos > 0 do
  begin

    strPrior := Copy(strMidResult, 1, iPos - 1);

    strNext := Copy(strMidResult, iPos + iCutLength, Length(strMidResult));

    strMidResult := strPrior + strInsertSub + strNext;

    iPos := PosEx(strCutSub, strMidResult, iPos + iInsertLength);

  end;

  Result := strMidResult;

end;

function ReplaceByReg(const ASource, ACutSub, AInsterSub: string): string;
begin
  Result := TRegEx.Replace(ASource, ACutSub, AInsterSub);
end;

function ClearAllSpace(const s: string): string;
begin
  Result := trim(s);
  Result := ReplaceAll(Result, ' ', '');
  Result := ReplaceAll(Result, '　', '');
end;

function TextNewLine(const AStr: string): string;

var
  BStrs: TStringList;
  s: string;
begin
  Result := '';
  BStrs := TStringList.Create;
  try
    s := ReplaceAll(AStr, #13#10, ';');
    s := ReplaceAll(s, #13, ';');
    s := ReplaceAll(s, #10, ';');
    s := ReplaceAll(s, ',', ';');
    s := ReplaceAll(s, '，', ';');
    s := ReplaceAll(s, '；', ';');
    s := ReplaceAll(s, '/', ';');
    s := ReplaceAll(s, '　', ';');
    s := ReplaceAll(s, ' ', ';');
    BStrs.Delimiter := ';';
    BStrs.DelimitedText := s;
    // RemoveDuplicates(BStrs);
    Result := trim(BStrs.Text);
  finally
    BStrs.Free;
  end;
end;

function ClearAllBlank(const s: string): string;
begin
  Result := trim(s);
  Result := ReplaceAll(Result, ' ', '');
  Result := ReplaceAll(Result, '　', '');
  Result := ReplaceAll(Result, #9, '');
  Result := ReplaceAll(Result, #10, '');
  Result := ReplaceAll(Result, #13, '');
end;

function ClearAllSpaceToOne(const s: string): string;
var
  sR: string;
  nOld: integer;
  nNew: integer;
begin
  sR := trim(s);

  sR := ReplaceAll(sR, '　', ' ');
  sR := ReplaceAll(sR, #9, ' ');
  sR := ReplaceAll(sR, #10, ' ');
  sR := ReplaceAll(sR, #13, ' ');
  sR := ReplaceAll(sR, '?', ' ');
  sR := ReplaceAll(sR, '？', ' ');
  sR := ReplaceAll(sR, '（', '(');
  sR := ReplaceAll(sR, '）', ')');

  repeat
    nOld := Length(sR);
    sR := ReplaceAll(sR, '  ', ' ');
    nNew := Length(sR);
  until nNew = nOld;

  Result := sR;

end;

function GetRegExpStr(AText, aRegExp: string): string;

var
  matchs: TMatchCollection;
begin
  Result := '';
  try
    matchs := TRegEx.Matches(AText, aRegExp);
    if matchs.Count > 0 then
      Result := matchs[0].Groups[1].Value;
  except
    Result := '';
  end;
end;

function GetStrsByRegExp(AText, APattern: string): TStringList;
var
  matchs: TMatchCollection;
  match: TMatch;
begin
  Result := TStringList.Create;
  try
    matchs := TRegEx.Matches(AText, APattern);
    for match in matchs do
      Result.Add(match.Groups[1].Value);
  except
  end;
end;

function GetStrsByRegExpEx(AText, APattern: string): TStringList;
var
  matchs: TMatchCollection;
  match: TMatch;
begin
  Result := TStringList.Create;
  try
    matchs := TRegEx.Matches(AText, APattern);
    for match in matchs do
      Result.Add(match.Groups[0].Value);
  except
  end;
end;

function GetTextByRegExp(AText, APattern: string): string;
var
  BStrs: TStringList;
begin
  BStrs := GetStrsByRegExp(AText, APattern);
  try
    Result := trim(BStrs.Text);
  finally
    BStrs.Free;
  end;
end;

function AnyStrPos(AStr: String; ASubList: TStringList): integer;
var
  s: string;
begin
  Result := 0;
  for s in ASubList do
  begin
    Result := PosEx(s, AStr);
    if Result > 0 then
      exit;
  end;
end;

procedure SaveTextToFile(const AFileName, AText: string);

var
  BTextFile: TextFile;
begin
  try
    AssignFile(BTextFile, AFileName);
    Rewrite(BTextFile);
    Write(BTextFile, AText);
  finally
    CloseFile(BTextFile);
  end;
end;

function LoadTextFromFile(AFileName: string): string;

var
  M: TFileStream;
  B: TStringStream;
begin
  Result := '';
  if FileExists(AFileName) then
  begin
    M := TFileStream.Create(AFileName, fmOpenRead);
    B := TStringStream.Create;
    try
      B.LoadFromStream(M);
      Result := B.DataString;
    finally
      M.Free;
      B.Free;
    end;
  end;
end;

procedure AddTextToFile(const AFileName, AText: String);

var
  BTextFile: TextFile;
begin
  try
    AssignFile(BTextFile, AFileName);
    if not FileExists(AFileName) then
    begin
      Rewrite(BTextFile);
      write(BTextFile, '');
    end;
    Append(BTextFile);
    write(BTextFile, AText);
  finally
    CloseFile(BTextFile);
  end;

end;

procedure LoadTextToList(AStrs: TStrings; const AFileName: string); overload;
begin
  if FileExists(AFileName) then
    AStrs.LoadFromFile(AFileName);
end;

procedure LoadTextToList(AMemo: TMemo; const AFileName: string); overload;
begin
  LoadTextToList(AMemo.lines, AFileName);
end;

procedure AddStrsToList(const AStrs: string; AList: TStringList);

var
  BStrs: TStringList;
begin
  BStrs := TStringList.Create;
  try
    BStrs.Text := trim(AStrs);
    AList.AddStrings(BStrs);
  finally
    BStrs.Free;
  end;
end;

function GetRandNumStr(ACount: integer): string;

var
  i: integer;
begin
  Randomize;
  Result := inttostr(RandomRange(1, 9));
  for i := 2 to ACount do
    Result := Result + inttostr(RandomRange(0, 9));
end;

function JoinStrsBySymbol(AStrList: TStringList; ASymbol: string = ';'): string;
var
  nCount: integer;
  i: integer;
begin

  Result := '';
  nCount := AStrList.Count;

  if nCount > 1 then
    for i := 0 to nCount - 2 do
      Result := Result + AStrList[i] + ASymbol;

  if nCount > 0 then
    Result := Result + AStrList[nCount - 1];

end;

function JoinStrsBySymbol(AList: TStrings; ASymbol: string = ';'): string; overload; inline;
begin
  Result := JoinStrsBySymbol(TStringList(AList), ASymbol);
end;

function JoinStrsBySymbol(AMemo: TMemo; ASymbol: string = ';'): string; overload; inline;
begin
  Result := JoinStrsBySymbol(TStringList(AMemo.lines), ASymbol);
end;

function Convert(const Bytes: TBytes): RawByteString;
begin
  SetLength(Result, Length(Bytes));
  Move(Bytes[0], Result[1], Length(Bytes))
end;

function LoadAnsiStringToStream(AStr: AnsiString; AStream: TStream): integer;

var
  BLength: integer;
  Raw: RawByteString;
begin
  Raw := AStr;
  BLength := Length(Raw);
  AStream.Position := 0;
  AStream.Write(Raw[1], BLength);
  Result := BLength;
end;

function LoadRawByteStringToStream(AStr: RawByteString; AStream: TStream): integer;

var
  BLength: integer;
begin
  BLength := Length(AStr);
  AStream.Position := 0;
  AStream.Write(AStr[1], BLength);
  Result := BLength;
end;

function IncludeStr(const AStr, ASub: string): Boolean;
begin
  Result := PosEx(ASub, AStr) > 0;
end;

function NotIncludeStr(const AStr, ASub: string): Boolean;
begin
  Result := not IncludeStr(AStr, ASub);
end;

function IncludeAnyStr(const AStr: string; ASubList: TStringList): Boolean;
var
  i: integer;
begin
  Result := False;
  for i := 0 to ASubList.Count - 1 do
  begin
    Result := IncludeStr(AStr, ASubList.Strings[i]);
    if Result then
      Break;
  end;
end;

function NotIncludeAnyStr(const AStr: string; ASubList: TStringList): Boolean;
begin
  Result := not IncludeAnyStr(AStr, ASubList);
end;

procedure DeleteBlanks(AStrList: TStringList);
var
  i: integer;
  s: string;
  BStrs: TStringList;
begin

  BStrs := TStringList.Create;
  try

    BStrs.BeginUpdate;

    for i := 0 to AStrList.Count - 1 do
    begin
      s := AStrList[i];
      if Length(trim(s)) > 0 then
        BStrs.Add(s);
    end;

    BStrs.EndUpdate;

    AStrList.Assign(BStrs);

  finally
    BStrs.Free;
  end;
end;

procedure DeleteBlanks(AMemo: TMemo); overload;
begin
  DeleteBlanks(TStringList(AMemo.lines));
end;

procedure TrimList(AStrList: TStringList);
var
  i: integer;
  s: string;
  BStrs: TStringList;
begin
  BStrs := TStringList.Create;
  try
    BStrs.BeginUpdate;
    for i := 0 to AStrList.Count - 1 do
    begin
      s := trim(AStrList[i]);
      if Length(s) > 0 then
        BStrs.Add(s);
    end;
    BStrs.EndUpdate;
    AStrList.Assign(BStrs);
  finally
    BStrs.Free;
  end;
end;

procedure TrimList(AList: TStrings); overload; inline;
begin
  TrimList(TStringList(AList));
end;

procedure TrimList(AMemo: TMemo); overload; inline;
begin
  TrimList(TStringList(AMemo.lines));
end;

procedure DeleteBlanks(AList: TStrings); overload;
begin
  DeleteBlanks(TStringList(AList));
end;

procedure RemoveDuplicates(AStrList: TStringList);

var
  buffer: TStringList;
  cnt: integer;
begin
  // AStrList.Sort;
  buffer := TStringList.Create;
  try
    buffer.Sorted := true;
    buffer.Duplicates := dupIgnore;
    buffer.BeginUpdate;
    for cnt := 0 to AStrList.Count - 1 do
      buffer.Add(trim(AStrList[cnt]));
    buffer.EndUpdate;
    AStrList.Assign(buffer);
  finally
    FreeAndNil(buffer);
  end;
end;

procedure RemoveDuplicates(AList: TStrings); overload;
begin
  RemoveDuplicates(TStringList(AList));
end;

procedure RemoveDuplicates(AMemo: TMemo); overload;
begin
  RemoveDuplicates(TStringList(AMemo.lines));
end;

function TextToHtml(const AStr: string): string;

var
  BStrs: TStringList;
  i: integer;
  s: string;
  sTemp: string;
begin
  BStrs := TStringList.Create;
  try
    BStrs.Text := AStr;
    for i := 0 to BStrs.Count - 1 do
    begin
      s := BStrs[i];
      if Length(s) = 0 then
        sTemp := '
'
      else
        sTemp := ReplaceAll(s, ' ', ' ');
      Result := Result + '
' + sTemp + '
' + #13#10;
    end;
  finally
    BStrs.Free;
  end;
end;

function HttpEncodeX(const AStr: string): string;
var
  s: string;
begin
  s := Tnetencoding.URL.Encode(String(UTF8Encode(AStr)));
  // s := String(HttpEncode(AnsiString(UTF8Encode(AStr))));
  s := ReplaceAll(s, '+', '%20');
  s := ReplaceAll(s, '$', '%24');
  Result := ReplaceAll(s, '@', '%40');
end;

function TextToStrs(const AText: string): TStringList;

var
  s: string;
begin

  Result := TStringList.Create;

  s := ReplaceAll(AText, #13#10, ';');
  s := ReplaceAll(s, #13, ';');
  s := ReplaceAll(s, #10, ';');
  s := ReplaceAll(s, ',', ';');
  s := ReplaceAll(s, '，', ';');
  s := ReplaceAll(s, '；', ';');
  s := ReplaceAll(s, '/', ';');
  s := ReplaceAll(s, ' ', ';');
  s := ReplaceAll(s, '　', ';');

  Result.Delimiter := ';';
  Result.DelimitedText := s;

  DeleteBlanks(Result);

end;

function ConvUrl(const AStr: string): string;

var
  s: string;
  BStrs: TStringList;
  C: string;
begin
  s := ReplaceAll(AStr, '&#', ';');
  BStrs := TextToStrs(s);
  try
    BStrs.Text := trim(BStrs.Text);
    Result := '';
    for C in BStrs do
      Result := Result + Chr(StrToIntdef(C, 13));
  finally
    BStrs.Free;
  end;
end;

function CheckStrByRegPattern(const AStr, ARegPattern: string): Boolean;
begin
  Result := TRegEx.match(AStr, ARegPattern).Success;
end;

function GenNewGUID: string;

var
  GUID: TGUID;
begin
  CreateGUID(GUID);
  Result := GUIDToString(GUID);
end;

procedure LowerCaseList(AStrList: TStringList);

var
  i: integer;
begin
  AStrList.BeginUpdate;
  for i := 0 to AStrList.Count - 1 do
    AStrList[i] := LowerCase(AStrList[i]);
  AStrList.EndUpdate;
end;

procedure LowerCaseList(AList: TStrings); overload;
begin
  LowerCaseList(TStringList(AList));
end;

procedure LowerCaseList(AMemo: TMemo); overload;
begin
  LowerCaseList(TStringList(AMemo.lines));
end;

procedure DivStrsGroup(AStrs: string; AGroupLength: integer; ADoGroup: TDoGroup);
var

  s: string;
  sErrMsg: string;
  nBegin: integer;
  nEnd: integer;
  nlength: integer;
  nPos: integer;
  nFoundPos: integer;

  BOver: Boolean;

begin

  nlength := Length(AStrs);

  if nlength = 0 then
    exit;

  nBegin := 1;
  nPos := 1;

  repeat

    nPos := nPos + AGroupLength;
    BOver := False;
    nFoundPos := 0;

    if nPos > nlength then
    begin
      nPos := nlength;
      BOver := true;
    end;

    while (nPos >= nBegin) do
    begin

      if AStrs[nPos] = ';' then
        nFoundPos := nPos;

      if (nFoundPos > 0) and (AStrs[nPos] <> ';') then
        Break;

      dec(nPos);
    end;

    if nFoundPos > 0 then
      nEnd := nFoundPos - 1
    else
    begin
      if not BOver then
      begin
        sErrMsg := '分组最大长度小于最小分隔符字串！' + #13#10;
        sErrMsg := sErrMsg + '开始位置:' + inttostr(nBegin) + #13#10;
        raise Exception.Create(sErrMsg)
      end
      else
      begin
        nFoundPos := nlength;
        nEnd := nlength;
      end;
    end;

    s := trim(Copy(AStrs, nBegin, (nEnd - nBegin + 1)));

    if (Length(s) > 0) or (Length(s) = 1) and (s <> ';') then
      ADoGroup(s);

    nPos := nFoundPos + 1;
    nBegin := nFoundPos + 1;

  until nBegin >= nlength;

end;

function HasTwoSubStr(AStrs: string; ASub: string): Boolean;
var
  nLenSub: integer;
  nPos: integer;
begin
  Result := true;
  nLenSub := Length(ASub);
  nPos := PosEx(ASub, AStrs);
  if nPos > 0 then
  begin
    nPos := PosEx(ASub, AStrs, nPos + nLenSub);
    Result := nPos > 0;
  end;
end;

function HalfStr(AStr: string): string;
var
  n: integer;
begin
  n := Length(AStr);
  Result := Copy(AStr, 1, n div 2);
end;

function GetCallAndMobNum(s: string; var ACall, AMobNum: string): Boolean;
var
  nPos: integer;
  nLen: integer;

begin

  Result := False;

  nLen := Length(s);
  nPos := PosEx(',', s);

  if (nPos > 0) then
  begin
    AMobNum := trim(Copy(s, nPos + 1, nLen - nPos));

    if nPos = 1 then
      ACall := ''
    else
      ACall := trim(Copy(s, 1, nPos - 1));

  end
  else
  begin
    ACall := '';
    AMobNum := s;
  end;

  if (Length(AMobNum) = 11) and (StrToInt64Def(AMobNum, -1) > 10000000000) then
  begin
    Result := true;
  end

end;

function SearchStrsInText(AText: string; ArrString: TArrayString): Boolean;
var
  nHigh: integer;
  i: integer;
  sText: string;
  sArrString: string;
begin
  Result := False;
  nHigh := high(ArrString);
  sText := LowerCase(AText);
  for i := 0 to nHigh do
  begin
    sArrString := LowerCase(ArrString[i]);
    if PosEx(sArrString, sText) > 0 then
    begin
      Result := true;
      Break;
    end;
  end;
end;

function IncludeAnyText(AText: string; ASubStrs: TStringList): Boolean;
var
  s: string;
  sLow: string;
  sLowText: string;
begin
  Result := False;
  sLowText := LowerCase(AText);
  for s in ASubStrs do
  begin
    sLow := LowerCase(s);
    if PosEx(sLow, sLowText) > 0 then
    begin
      Result := true;
      Break;
    end;
  end;
end;

function CheckPatternListInText(AForText: string; APatternList: TStringList): Boolean;
var
  s: string;
  ss: string;
  sText: string;
begin

  sText := LowerCase(AForText);

  Result := False;
  for s in APatternList do
  begin

    ss := trim(LowerCase(s));

    if Length(ss) = 0 then
      Continue;

    if PosEx(ss, sText) > 0 then
    begin
      Result := true;
      exit;
    end;

  end;

end;

function ALeftPosEx(const ASubStr, s: string; ARightOffset: integer = 1): integer;
var
  i, LIterCnt, L, LS, J: integer;
  PSubStr, PS: PChar;
begin

  if ASubStr = '' then
    exit(0);

  LIterCnt := Length(s) - ARightOffset - Length(ASubStr) + 1;

  if (ARightOffset > 0) and (LIterCnt >= 0) then
  begin
    L := Length(ASubStr);
    LS := Length(s);

    PSubStr := PChar(ASubStr);
    inc(PSubStr, L - 1);

    PS := PChar(s);
    inc(PS, LS - ARightOffset);

    for i := 0 to LIterCnt do
    begin
      J := 0;
      while (J >= 0) and (J < L) do
      begin
        if (PS - i - J)^ = (PSubStr - J)^ then
          inc(J)
        else
          J := -1;
      end;
      if J >= L then
        exit(LS - i - (L - 1) - (ARightOffset - 1));
    end;
  end;

  Result := 0;
end;

function StrToUCS2LE(const AStr: string): String;
var
  n: integer;
  src: PByte;
  desc: PChar;
  s: string;
begin

  n := Length(AStr) * 2;
  SetLength(Result, n * 2);
  desc := @Result[1];
  src := @AStr[1];
  while n > 0 do
  begin
    s := IntToHex(integer(src^), 2);
    desc^ := s[1];
    inc(desc);
    desc^ := s[2];
    inc(desc);
    inc(src);
    dec(n);
  end;

end;

function CompareText(const S1, S2: string; ACaseSensitive: Boolean = true): Boolean;
begin
  if ACaseSensitive then
    Result := SameStr(S1, S2)
  else
    Result := sameText(S1, S2);
end;

function RepeatAtr(AStr: string; ACount: integer): string;
var
  i: integer;
begin
  Result := '';
  for i := 1 to ACount do
  begin
    Result := Result + AStr;
  end;
end;

function CharInArray(C: Char; ArrChar: TArrayChar): Boolean;
var
  i: integer;
begin
  Result := False;
  for i := 0 to high(ArrChar) do
  begin
    if C = ArrChar[i] then
    begin
      Result := true;
      exit;
    end;
  end;
end;

function DateTimeToGMT(const ADate: TDateTime): string;
const
  WEEK: array [1 .. 7] of PChar = ('Sun', 'Mon', 'Tues', 'Wed', 'Thur', 'Fri', 'Sat');
  MonthDig: array [1 .. 12] of PChar = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug',
    'Sep', 'Oct', 'Nov', 'Dec');
var
  wWeek, wYear, wMonth, wDay, wHour, wMin, wSec, wMilliSec: Word;
  sWeek, sMonth: string;
begin
  DecodeDateTime(ADate, wYear, wMonth, wDay, wHour, wMin, wSec, wMilliSec);
  wWeek := DayOfWeek(ADate);
  sWeek := WEEK[wWeek];
  sMonth := MonthDig[wMonth];
  Result := Format(' %s, %d %s %d %d:%d:%d GMT', [sWeek, wDay, sMonth, wYear, wHour, wMin, wSec]);
end;

end.

推荐分享
最新信息 delphi13 多线程优化 TThreade... delphi 如何 FastMM配置 delphi13 FireDAC增强 并行备份... delphi12 Embarcadero ld... delphi 查看 cpu 核心数
热门信息 delphi 动态数组的使用 delphi多线程TThread详解 delphi try except语句 和 try finally语... delphi中常用字符串处理函数 delphi Inc函数和Dec函数的用法
推荐区 txt文本处理 查询128 说一段 简搜 短笑话 IP查询 正则大全 在线加密解密工具 在线文本筛选工具 1234828网址导航 windows库
图文皆来源于网络，内容仅做公益性分享，版权归原作者所有，如有侵权请告知删除！
  1. 关于我们
  2. 联系我们
 

Copyright © 2014 DelphiW.com 开发 源码 文档 技巧 All Rights Reserved
晋ICP备14006235号-8 晋公网安备 14108102000087号

执行时间: 0.054666042327881 seconds