FAQ VCL
Операции над строками

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как преобразовать кириллицу формата DFM (#1082) в нормальную строку?

uses
  {...,} RegularExpressions;

function DecodeFromDFMStr(s: string): string;
var
  m: TMatch;
begin
  Result := StringReplace(s, '''', '', [rfReplaceAll]);
  for m in TRegEx.Matches(Result, '#(\d{4}|\d{2})') do
    Result := StringReplace(
      Result, m.Value, Chr(m.Groups.Item[1].Value.ToInteger), []
    );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // #39'DFM '#1092#1086#1088#1084#1072#1090#39 -> 'DFM формат'
  ShowMessage(DecodeFromDFMStr('#39''DFM ''#1092#1086#1088#1084#1072#1090#39'));
end;


Как преобразовать строку с кириллицей в строку формата DFM (#1082)?

// Способ первый
function EncodeToDFMStr(s: string): string;
var
  ByteStr: UCS4String;
  ByteChr: UCS4Char;
  Flag: Boolean;
begin
  ByteStr := UnicodeStringToUCS4String(s);

  Result := '';
  Flag := (ByteStr[0] > 255) or (ByteStr[0] = 39);
  if not Flag then
    Result := Result + '''';

  for ByteChr in ByteStr do
    case ByteChr of
      0: begin // Конец строки
        if not Flag then
          Result := Result + '''';
      end;
      1..38, 40..255: begin
        if Flag then
        begin
          Result := Result + '''';
          Flag := False;
        end;
        Result := Result + Chr(ByteChr);
      end;
    else
      if not Flag then
      begin
        Result := Result + '''';
        Flag := True;
      end;
      Result := Result + '#' + ByteChr.ToString;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // 'DFM формат' -> #39'DFM '#1092#1086#1088#1084#1072#1090#39
  ShowMessage(EncodeToDFMStr('''DFM формат'''));
end;

// Способ второй
function EncodeToDFMStr(s: string): string;
var
  ByteStr: UCS4String;
  ByteChr: UCS4Char;
  Buffer: string;
  Flag, LocalFlag: Boolean;
begin
  ByteStr := UnicodeStringToUCS4String(s);

  Result := '';
  Buffer := '';
  Flag := (ByteStr[0] > 255) or (ByteStr[0] = 39);

  for ByteChr in ByteStr do
  begin
    LocalFlag := (ByteChr > 255) or (ByteChr = 39);

    if (LocalFlag <> Flag) or (ByteChr = 0) then
    begin
      if Flag then
        Result := Result + Buffer
      else
        Result := Result + QuotedStr(Buffer);

      Buffer := '';
      Flag := LocalFlag;
    end;

    if LocalFlag then
      Buffer := Buffer + '#' + ByteChr.ToString
    else
      Buffer := Buffer + Chr(ByteChr);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // 'DFM формат' -> #39'DFM '#1092#1086#1088#1084#1072#1090#39
  ShowMessage(EncodeToDFMStr('''DFM формат'''));
end;


Как сравнить два номера версии?

// Способ первый
uses
  Math;

// Сравнение версий идёт по правилам десятичных дробей:
// 0.9 < 1.0 < 1.01 < 1.1 = 1.10 < 1.11 < 1.2 = 1.20 < 2.0 < 2.5
// Последние нули можут опускаться: 1.0.0.0 = 1.0.0 = 1.0 = 1
function CompareVersionNumber(VNum1, VNum2: string): TValueSign;

  procedure EqualizeLists(var l1, l2: TStringList);
  var
    i: Integer;
  begin
    if l1.Count > l2.Count then
      for i := 0 to l1.Count - l2.Count - 1 do
        l2.Add('0')
    else if l1.Count < l2.Count then
      for i := 0 to l2.Count - l1.Count - 1 do
        l1.Add('0');
  end;

var
  i: Integer;
  iNum1, iNum2: Int64;
  lNum1, lNum2: TStringList;
begin
  lNum1 := TStringList.Create;
  lNum2 := TStringList.Create;

  try
    lNum1.Delimiter := '.';
    lNum1.DelimitedText := VNum1;

    lNum2.Delimiter := '.';
    lNum2.DelimitedText := VNum2;

    EqualizeLists(lNum1, lNum2);

    iNum1 := 0;
    iNum2 := 0;

    for i := lNum1.Count-1 downto 0 do
    begin
      iNum1 := iNum1 + Trunc(StrToInt(lNum1[i]) * Power(10, lNum1.Count - (i+1)));
      iNum2 := iNum2 + Trunc(StrToInt(lNum2[i]) * Power(10, lNum2.Count - (i+1)));
    end;

    Result := Sign(iNum2 - iNum1);
  finally
    lNum2.Free;
    lNum1.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  v1 = '1';
  v2 = '1.0.0.0';
begin
  case CompareVersionNumber(v1, v2) of
    -1: ShowMessage(v1 + ' > ' + v2);
     0: ShowMessage(v1 + ' = ' + v2);
     1: ShowMessage(v1 + ' < ' + v2);
  end;
end;

// Способ второй
uses
  StrUtils, Math;

function AdjustVersionStr(const sVer: string; const sDlm: string = '.'): string;
var
  i, cnt: Integer;
  dlmPos, dlmLen, verLen: Integer;
  sNum, sRest: string;
  sRes: string;
begin
  try
    verLen := Length(sVer);
    dlmLen := Length(sDlm);
    sRest := sVer;

    // 4 раздела строки-версии
    for i := 1 to 4 do
    begin
      dlmPos := PosEx(sDlm, sRest, 1);
      cnt := IfThen(dlmPos > 0, dlmPos-1, verLen);

      sNum := Copy(sRest, 1, cnt);
      if sNum = '' then
        sNum := '0';
      sRest := Copy(sRest, IfThen(dlmPos > 0, dlmPos+1, verLen), verLen);

      sRes := sRes + Format('%.9d', [StrToInt(sNum)]) + '.';
    end;

    Result := sRes;
  except
    result := sVer;
  end;
end;

function IsGreaterVersion(const sVer, sVerCurr: string;
  const sDlm: string = '.'): Boolean;
begin
  Result := AdjustVersionStr(sVer, sDlm) > AdjustVersionStr(sVerCurr, sDlm);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  VerCurr = '1.2.3.0';
  Ver = '1.3';
begin
  if IsGreaterVersion(Ver, VerCurr) then
    ShowMessage('Версия выше текущей');
end;

При использовании материала - ссылка на сайт обязательна