Funkcja ala Format, ale z varargs i w WinAPI pod Delphi XE8.

0

Cześć.

Rzadko o coś pytam, ale te nowsze środowiska z Unicode i przerabianie kodu żeby ANSI było obsłużóne jak należy nie do końca mi wychodzi. Poniższy kod bazuje na przykładzie @Patryk27 z dawnego wątku na konkurs o printf w Pascalu. I kod poniższy działa ok pod starym Delphi 7.

I tutaj pytanie, jak go poprawić by działał w nowszych wersjach Delphi. Docelowo pod WinAPI z użyciem vargsów jako parametrów? Gdy poprawiam wszystkie PChar na PAnsiChar, a nawet string na Ansistring to i tak działa mi tylko dla %s jednego lub wielu, a już dla pozostałych typów nie działa.

Prosił bym przykład kodu. Pewnie na nieco starszych Delphi niz XE8 będzie też problem z jego prawidłowym działaniem. Nawet %d nie zadziała. Debugguje i chyba źle coś zwraca mi funkcja sprintf. Mogłbym użyć prostego kodu:

function _FormatC(const Format : Ansistring) : Ansistring; cdecl;
const
  StackSlotSize = SizeOf(Pointer);
var
  Args : VA_List;
  Buffer : array[0..1024] of AnsiChar;
begin
  Args := VA_List(PAnsiChar(@Format) + ((SizeOf(Format) + StackSlotSize - 1) and not(StackSlotSize - 1)));
  SetString(Result, Buffer, wvsprintfA(Buffer, PAnsiChar(Format), Args));
end;

var
   FormatC : function(const Format : Ansistring) : Ansistring; cdecl varargs = _FormatC;

Ale wolę ten rozbudowany na bazie Patryka poniżej, bo obsługuje liczby ułamkowe. No chyba, że macie jakieś inne propozycje. Użycie SysUtils odpada, bo plik wynikowy spuchnie wtedy niemiłosiernie, a dla samego Format z array of const jako parametry nie ma sensu go stosować. A "portowanie" go z VCL do WinAPI jest dla mnie za cięzkie. Z góry dziękuję za wszelkie podpowiedzi z kodem.

unit useful_format;

interface

uses
  Windows;

function Internal_SimpleFormat(Format : string) : string; cdecl; forward;

var
  SimpleFormat : function(Format : string) : string; cdecl varargs = Internal_SimpleFormat;

implementation

function sprintf(S : PAnsiChar; const Format : PAnsiChar) : integer; cdecl;
varargs; external 'msvcrt.dll';

function Internal_SimpleFormat(Format : string) : string; cdecl;
var
  PC : PChar;
  Tmp : string;
  Arg : Pointer;
  Pos, Len : UINT;
  DoParse : boolean;
begin
  Pos := 1;
  Result := '';
  Arg := Pointer(Uint(@Format) + sizeof(string));
  Len := Length(Format);
  while (Pos <= Len) do
  begin
    DoParse := (Pos = 1) and (Format[Pos] = '%');
    if not DoParse then
    begin
      DoParse := Format[Pos - 1] <> '%';
    end;
    if not DoParse then
    begin
      Delete(Format, Pos, 1);
      Len := Length(Format);
    end;
    if (DoParse) and ((Copy(Format, Pos, 2) = '%d')
      or (Copy(Format, Pos, 4) = '%.1d')
      or (Copy(Format, Pos, 4) = '%.2d')
      or (Copy(Format, Pos, 4) = '%.3d')
      or (Copy(Format, Pos, 4) = '%.4d')
      or (Copy(Format, Pos, 4) = '%.5d')
      or (Copy(Format, Pos, 4) = '%.6d')
      or (Copy(Format, Pos, 4) = '%.7d')
      or (Copy(Format, Pos, 4) = '%.8d')) then
    begin
      GetMem(PC, 20);
      if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
      begin
        sprintf(PC, PChar(Copy(Format, Pos, 2)), pinteger(Arg)^);
      end
      else
      begin
        sprintf(PC, PChar(Copy(Format, Pos, 4)), pinteger(Arg)^);
      end;
      Result := Result + PC;
      FreeMem(PC);
      if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
      begin
        Inc(Pos, 2);
      end
      else
      begin
        Inc(Pos, 4);
      end;
      Arg := PChar(Arg) + SizeOf(integer);
    end
    else
    begin
      if (DoParse) and (Copy(Format, Pos, 2) = '%s') then
      begin
        Result := Result + PPChar(Arg)^;
        Inc(Pos, 2);
        Arg := PChar(Arg) + SizeOf(PChar);
      end
      else
      begin
        if (DoParse) and ((Copy(Format, Pos, 2) = '%f')
          or (Copy(Format, Pos, 4) = '%.1f')
          or (Copy(Format, Pos, 4) = '%.2f')
          or (Copy(Format, Pos, 4) = '%.3f')
          or (Copy(Format, Pos, 4) = '%.4f')
          or (Copy(Format, Pos, 4) = '%.5f')
          or (Copy(Format, Pos, 4) = '%.6f')
          or (Copy(Format, Pos, 4) = '%.7f')
          or (Copy(Format, Pos, 4) = '%.8f')
          or (Copy(Format, Pos, 4) = '%.9f')) then
        begin
          GetMem(PC, 30);
          if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
          begin
            sprintf(PC, PChar(Copy(Format, Pos, 2)), PDouble(Arg)^);
          end
          else
          begin
            sprintf(PC, PChar(Copy(Format, Pos, 4)), PDouble(Arg)^);
          end;
          Tmp := PC;
          FreeMem(PC);
          if (System.Pos('.', Tmp) > 0) then
          begin
            while (Tmp[Length(Tmp)] = '0') do
            begin
              Delete(Tmp, Length(Tmp), 1);
            end;
            if (Tmp[Length(Tmp)] = '.') then
            begin
              Delete(Tmp, Length(Tmp), 1);
            end;
          end;
          Result := Result + Tmp;
          if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
          begin
            Inc(Pos, 2);
          end
          else
          begin
            Inc(Pos, 4);
          end;
          Arg := PChar(Arg) + SizeOf(Double);
        end
        else
        begin
          if (DoParse) and
            ((Copy(Format, Pos, 2) = '%x')
            or (Copy(Format, Pos, 2) = '%X')
            or (Copy(Format, Pos, 4) = '%.1x')
            or (Copy(Format, Pos, 4) = '%.2x')
            or (Copy(Format, Pos, 4) = '%.3x')
            or (Copy(Format, Pos, 4) = '%.4x')
            or (Copy(Format, Pos, 4) = '%.5x')
            or (Copy(Format, Pos, 4) = '%.6x')
            or (Copy(Format, Pos, 4) = '%.7x')
            or (Copy(Format, Pos, 4) = '%.8x')
            or (Copy(Format, Pos, 4) = '%.1X')
            or (Copy(Format, Pos, 4) = '%.2X')
            or (Copy(Format, Pos, 4) = '%.3X')
            or (Copy(Format, Pos, 4) = '%.4X')
            or (Copy(Format, Pos, 4) = '%.5X')
            or (Copy(Format, Pos, 4) = '%.6X')
            or (Copy(Format, Pos, 4) = '%.7X')
            or (Copy(Format, Pos, 4) = '%.8X')) then
          begin
            GetMem(PC, 20);
            if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
            begin
              sprintf(PC, PChar(Copy(Format, Pos, 2)), PDWORD(Arg)^);
            end
            else
            begin
              sprintf(PC, PChar(Copy(Format, Pos, 4)), PDWORD(Arg)^);
            end;
            Result := Result + PC;
            FreeMem(PC);
            if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
            begin
              Inc(Pos, 2);
            end
            else
            begin
              Inc(Pos, 4);
            end;
            Arg := PChar(Arg) + SizeOf(DWORD);
          end
          else
          begin
            Result := Result + Format[Pos];
            Inc(Pos);
          end;
        end;
      end;
    end;
  end;
end;

end.
1

Dziwne u mnie działa po przeróbce string na AnsiString, PChar na PAnsiChar i PPChar na PPAnsiChar no i w kilku miejscach jawne rzutowanie na string ale to aby kompilator ostrzeżeń nie wyświetlał bo bez tego też działało. Testowałem na %s, %d, %x i %f w kilku miejscach pomieszane.

unit useful_format;


interface

uses
  Windows;

function Internal_SimpleFormat(Format : AnsiString) : AnsiString; cdecl; forward;

var
  SimpleFormat : function(Format : AnsiString) : AnsiString; cdecl varargs = Internal_SimpleFormat;

implementation



function sprintf(S : PAnsiChar; const Format : PAnsiChar) : integer; cdecl;
  varargs; external 'msvcrt.dll';

function Internal_SimpleFormat(Format : AnsiString) : AnsiString; cdecl;
var
  PC : PAnsiChar;
  Tmp : string;
  Arg : Pointer;
  Pos, Len : UINT;
  DoParse : boolean;
begin
  Pos := 1;
  Result := '';
  Arg := Pointer(Uint(@Format) + sizeof(AnsiString));
  Len := Length(Format);
  while (Pos <= Len) do
  begin
    DoParse := (Pos = 1) and (Format[Pos] = '%');
    if not DoParse then
    begin
      DoParse := Format[Pos - 1] <> '%';
    end;
    if not DoParse then
    begin
      Delete(Format, Pos, 1);
      Len := Length(Format);
    end;
    if (DoParse) and ((Copy(Format, Pos, 2) = '%d')
      or (Copy(Format, Pos, 4) = '%.1d')
      or (Copy(Format, Pos, 4) = '%.2d')
      or (Copy(Format, Pos, 4) = '%.3d')
      or (Copy(Format, Pos, 4) = '%.4d')
      or (Copy(Format, Pos, 4) = '%.5d')
      or (Copy(Format, Pos, 4) = '%.6d')
      or (Copy(Format, Pos, 4) = '%.7d')
      or (Copy(Format, Pos, 4) = '%.8d')) then
    begin
      GetMem(PC, 20);
      if System.Pos('.', string(Copy(Format, Pos, 2))) <> 2 then
      begin
        sprintf(PC, PAnsiChar(Copy(Format, Pos, 2)), pinteger(Arg)^);
      end
      else
      begin
        sprintf(PC, PAnsiChar(Copy(Format, Pos, 4)), pinteger(Arg)^);
      end;
      Result := Result + PC;
      FreeMem(PC);
      if System.Pos('.', string(Copy(Format, Pos, 2))) <> 2 then
      begin
        Inc(Pos, 2);
      end
      else
      begin
        Inc(Pos, 4);
      end;
      Arg := PAnsiChar(Arg) + SizeOf(integer);
    end
    else
    begin
      if (DoParse) and (Copy(Format, Pos, 2) = '%s') then
      begin
        Result := Result + PPAnsiChar(Arg)^;
        Inc(Pos, 2);
        Arg := PAnsiChar(Arg) + SizeOf(PAnsiChar);
      end
      else
      begin
        if (DoParse) and ((Copy(Format, Pos, 2) = '%f')
          or (Copy(Format, Pos, 4) = '%.1f')
          or (Copy(Format, Pos, 4) = '%.2f')
          or (Copy(Format, Pos, 4) = '%.3f')
          or (Copy(Format, Pos, 4) = '%.4f')
          or (Copy(Format, Pos, 4) = '%.5f')
          or (Copy(Format, Pos, 4) = '%.6f')
          or (Copy(Format, Pos, 4) = '%.7f')
          or (Copy(Format, Pos, 4) = '%.8f')
          or (Copy(Format, Pos, 4) = '%.9f')) then
        begin
          GetMem(PC, 30);
          if System.Pos('.', string(Copy(Format, Pos, 2))) <> 2 then
          begin
            sprintf(PC, PAnsiChar(Copy(Format, Pos, 2)), PDouble(Arg)^);
          end
          else
          begin
            sprintf(PC, PAnsiChar(Copy(Format, Pos, 4)), PDouble(Arg)^);
          end;
          Tmp := string(PC);
          FreeMem(PC);
          if (System.Pos('.', Tmp) > 0) then
          begin
            while (Tmp[Length(Tmp)] = '0') do
            begin
              Delete(Tmp, Length(Tmp), 1);
            end;
            if (Tmp[Length(Tmp)] = '.') then
            begin
              Delete(Tmp, Length(Tmp), 1);
            end;
          end;
          Result := Result + AnsiString(Tmp);
          if System.Pos('.', string(Copy(Format, Pos, 2))) <> 2 then
          begin
            Inc(Pos, 2);
          end
          else
          begin
            Inc(Pos, 4);
          end;
          Arg := PAnsiChar(Arg) + SizeOf(Double);
        end
        else
        begin
          if (DoParse) and
            ((Copy(Format, Pos, 2) = '%x')
            or (Copy(Format, Pos, 2) = '%X')
            or (Copy(Format, Pos, 4) = '%.1x')
            or (Copy(Format, Pos, 4) = '%.2x')
            or (Copy(Format, Pos, 4) = '%.3x')
            or (Copy(Format, Pos, 4) = '%.4x')
            or (Copy(Format, Pos, 4) = '%.5x')
            or (Copy(Format, Pos, 4) = '%.6x')
            or (Copy(Format, Pos, 4) = '%.7x')
            or (Copy(Format, Pos, 4) = '%.8x')
            or (Copy(Format, Pos, 4) = '%.1X')
            or (Copy(Format, Pos, 4) = '%.2X')
            or (Copy(Format, Pos, 4) = '%.3X')
            or (Copy(Format, Pos, 4) = '%.4X')
            or (Copy(Format, Pos, 4) = '%.5X')
            or (Copy(Format, Pos, 4) = '%.6X')
            or (Copy(Format, Pos, 4) = '%.7X')
            or (Copy(Format, Pos, 4) = '%.8X')) then
          begin
            GetMem(PC, 20);
            if System.Pos('.', string(Copy(Format, Pos, 2))) <> 2 then
            begin
              sprintf(PC, PAnsiChar(Copy(Format, Pos, 2)), PDWORD(Arg)^);
            end
            else
            begin
              sprintf(PC, PAnsiChar(Copy(Format, Pos, 4)), PDWORD(Arg)^);
            end;
            Result := Result + PC;
            FreeMem(PC);
            if System.Pos('.', string(Copy(Format, Pos, 2))) <> 2 then
            begin
              Inc(Pos, 2);
            end
            else
            begin
              Inc(Pos, 4);
            end;
            Arg := PAnsiChar(Arg) + SizeOf(DWORD);
          end
          else
          begin
            Result := Result + Format[Pos];
            Inc(Pos);
          end;
        end;
      end;
    end;
  end;
end;

end.

A tak w ogóle czy jest uzasadniona przyczyna aby w nowym Delphi celowo rezygnować z Unicode?

0

Ok, teraz działa. Trzeba jednak rzutować typy dokładnie, czego pod Delphi 7 robić nie trzeba było. A co do tego czy rezygnować z Unicode. Może nie trzeba, ale akurat operowałem z przyzwyczajenia na Ansi i chciałem by to w ogóle ruszyło jak należy. Także bardzo Tobie dziękuję za działające rozwiązanie.

0

Działać działa, ale trzeba się jeszcze pozbyć tych potwornych drabinek i redundancji przez każdorazowe wywoływanie Copy przy niespełnionym warunku; Źle to wygląda, a jeszcze gorzej działa, tzn. bardzo wolno.

1 użytkowników online, w tym zalogowanych: 0, gości: 1