Multiple Typ-Konvertierung (eleganter, als mein Weg?)

[Satty67]

Hallo,

ich benötige eine Typ-Konvertierung in alle Richtungen. Dabei soll jede Umwandlung ein Ergebnis liefern, also z.B. auch Boolean nach TDateTime (Hier gibt True Now zurück).

Die Daten liegen in einem SpeicherPuffer, stehen als Quelle somit als Cast(Pointer) bereit. Bei der Rückgabe benötige ich einmal einen Weg, wieder in den Puffer zu schreiben (Puffergröße ist immer ausreichend), als auch eine Funktions-Rückgabe mit korrektem Daten-Typ (allerdings ohne Bereichs-Prüfung, Byte := LongInt reicht also).

Ich hab' es inzwischen gelöst, aber je öfter ich mir den Code anschaue, desto mehr denke ich, das ist umständlich
Kann man das auch eleganter lösen?

Hier mal mein Werk (wenn es zu lang ist, klemme ich es als Anlage an, einfach was sagen):

Delphi-Quellcode:

unit stTypChange;

interface

uses SysUtils, stConst, stTypes;

procedure ConvertPtr(SourcePtr, TargetPtr : Pointer; SourceTyp, TargetTyp : TstDataTyp; TargetSize: Integer);

function Pointer2String   (aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): AnsiString;
function Pointer2Boolean  (aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Boolean;
function Pointer2Integer  (aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Int64;
function Pointer2Float    (aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Double;
function Pointer2Currency (aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Currency;
function Pointer2DateTime (aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): TDateTime;

function DateTimeToStrDef(DateTime: TDateTime; Default: String) : String;
function StrToDateTimeDef(Text : String; Default : TDateTime): TDateTime;
function StrToFloatDef(Text : String; Default : Double): Double;
function StrToCurrDef(Text : String; Default : Currency) : Currency;

implementation

procedure ConvertPtr(SourcePtr, TargetPtr : Pointer; SourceTyp, TargetTyp : TstDataTyp; TargetSize: Integer);
begin
  case TargetTyp of
   st_Boolean  : Boolean(TargetPtr^)  := Pointer2Boolean (SourcePtr, SourceTyp, TargetSize);
   st_Byte     : Byte(TargetPtr^)     := Pointer2Integer (SourcePtr, SourceTyp, TargetSize);
   st_Word     : Word(TargetPtr^)     := Pointer2Integer (SourcePtr, SourceTyp, TargetSize);
   st_SmallInt : SmallInt(TargetPtr^) := Pointer2Integer (SourcePtr, SourceTyp, TargetSize);
   st_Integer  : LongInt(TargetPtr^)  := Pointer2Integer (SourcePtr, SourceTyp, TargetSize);
   st_LargeInt : Int64(TargetPtr^)    := Pointer2Integer (SourcePtr, SourceTyp, TargetSize);
   st_Real48   : Real48(TargetPtr^)   := Pointer2Float   (SourcePtr, SourceTyp, TargetSize);
   st_Double   : Double(TargetPtr^)   := Pointer2Float   (SourcePtr, SourceTyp, TargetSize);
   st_DateTime : TDateTime(TargetPtr^):= Pointer2DateTime(SourcePtr, SourceTyp, TargetSize);
   st_Currency : Currency(TargetPtr^) := Pointer2Currency(SourcePtr, SourceTyp, TargetSize);
   st_Chars    : StrCopy(PChar(TargetPtr), PChar(SourcePtr));
   st_ShortStr : ShortString(TargetPtr^) := PChar(SourcePtr);
  end;
end;

{<--- TO STRING --->}
function Pointer2String(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): AnsiString;
begin
  case AsTyp of
    st_Boolean  : if Boolean(aPtr^) then Result := BoolTrueString else Result := BoolFalseString;
    st_Byte     : Result := IntToStr(Byte(aPtr^));
    st_Word     : Result := IntToStr(Word(aPtr^));
    st_SmallInt : Result := IntToStr(SmallInt(aPtr^));
    st_Integer  : Result := IntToStr(Integer(aPtr^));
    st_LargeInt : Result := IntToStr(Int64(aPtr^));
    st_Real48   : Result := FloatToStrF(Real48(aPtr^), ffFixed, 15, Size);
    st_Double   : Result := FloatToStrF(Double(aPtr^), ffFixed, 15, Size);
    st_DateTime : Result := DateTimeToStrDef(TDateTime(aPtr^),'');
    st_Currency : Result := Format('%m',[Currency(aPtr^)]);
    st_Chars    : Result := PChar(aPtr);
    st_ShortStr : Result := ShortString(aPtr^);
  end;
end;

{<--- TO BOOLEAN --->}
function Pointer2Boolean(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Boolean;
begin
  case AsTyp of
    st_Boolean  : Result := Boolean(aPtr^);
    st_Byte     : Result := Byte(aPtr^)     <> 0;
    st_Word     : Result := Word(aPtr^)     <> 0;
    st_SmallInt : Result := SmallInt(aPtr^) <> 0;
    st_Integer  : Result := Integer(aPtr^)  <> 0;
    st_LargeInt : Result := Int64(aPtr^)    <> 0;
    st_Real48   : Result := Real48(aPtr^)   <> 0;
    st_Double   : Result := Double(aPtr^)   <> 0;
    st_DateTime : Result := Double(aPtr^)   <> 0;
    st_Currency : Result := Currency(aPtr^) <> 0;
    st_Chars    : Result := UpperCase(PChar(aPtr)) = UpperCase(BoolTrueString);
    st_ShortStr : Result := UpperCase(ShortString(aPtr^)) = UpperCase(BoolTrueString);
  else
    Result := False;
  end;
end;

{<--- TO INTEGER --->}
function Pointer2Integer(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Int64;
begin
  case AsTyp of
    st_Boolean  : if Boolean(aPtr^) then Result := 1 else Result := 0;
    st_Byte     : Result := Byte(aPtr^);
    st_Word     : Result := Word(aPtr^);
    st_SmallInt : Result := SmallInt(aPtr^);
    st_Integer  : Result := Integer(aPtr^);
    st_LargeInt : Result := Int64(aPtr^);
    st_Real48   : Result := Trunc(Real48(aPtr^));
    st_Double   : Result := Trunc(Double(aPtr^));
    st_DateTime : Result := Trunc(Double(aPtr^));
    st_Currency : Result := Trunc(Currency(aPtr^));
    st_Chars    : Result := StrToInt64Def(PChar(aPtr), 0);
    st_ShortStr : Result := StrToInt64Def(ShortString(aPtr^),0);
  else
    Result := 0;
  end;
end;

{<--- TO FLOAT --->}
function Pointer2Float(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Double;
begin
  case AsTyp of
    st_Boolean  : if Boolean(aPtr^) then Result := 1 else Result := 0;
    st_Byte     : Result := Byte(aPtr^);
    st_Word     : Result := Word(aPtr^);
    st_SmallInt : Result := SmallInt(aPtr^);
    st_Integer  : Result := Integer(aPtr^);
    st_LargeInt : Result := Int64(aPtr^);
    st_Real48   : Result := Real48(aPtr^);
    st_Double   : Result := Double(aPtr^);
    st_DateTime : Result := Double(aPtr^);
    st_Currency : Result := Currency(aPtr^);
    st_Chars    : Result := StrToFloatDef(PChar(aPtr),0);
    st_ShortStr : Result := StrToFloatDef(ShortString(aPtr^),0);
  else
    Result := 0;
  end;
end;

{<--- TO CURRENCY --->}
function Pointer2Currency(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Currency;
begin
  case AsTyp of
    st_Boolean  : if Boolean(aPtr^) then Result := 1 else Result := 0;
    st_Byte     : Result := Byte(aPtr^);
    st_Word     : Result := Word(aPtr^);
    st_SmallInt : Result := SmallInt(aPtr^);
    st_Integer  : Result := Integer(aPtr^);
    st_LargeInt : Result := Int64(aPtr^);
    st_Real48   : Result := Real48(aPtr^);
    st_Double   : Result := Double(aPtr^);
    st_DateTime : Result := Double(aPtr^);
    st_Currency : Result := Currency(aPtr^);
    st_Chars    : Result := StrToCurrDef(PChar(aPtr), 0);
    st_ShortStr : Result := StrToCurrDef(ShortString(aPtr^), 0);
  else
    Result := 0;
  end;
end;

{<--- TO DATETIME --->}
function Pointer2DateTime (aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): TDateTime;
begin
  case AsTyp of
    st_Boolean  : if Boolean(aPtr^) then Result := Now else Result := 0;
    st_Byte     : Result := Byte(aPtr^);
    st_Word     : Result := Word(aPtr^);
    st_SmallInt : Result := SmallInt(aPtr^);
    st_Integer  : Result := Integer(aPtr^);
    st_LargeInt : Result := Int64(aPtr^);
    st_Real48   : Result := Real48(aPtr^);
    st_Double   : Result := Double(aPtr^);
    st_DateTime : Result := Double(aPtr^);
    st_Currency : Result := Currency(aPtr^);
    st_Chars    : Result := StrToDateTimeDef(PChar(aPtr), 0);
    st_ShortStr : Result := StrToDateTimeDef(ShortString(aPtr^), 0);
  else
    Result := 0;
  end;
end;

{********************************************************
  StringUmwandlung mit Exception-Behandlung und Default
 ********************************************************}

{<--- DateTime > String --->}
function DateTimeToStrDef(DateTime: TDateTime; Default: String) : String;
begin
  try
    Result := DateTimeToStr(DateTime)
  except
    on EInvalidOp do Result := Default;
  end;
end;

{<--- String > DateTime --->}
function StrToDateTimeDef(Text : String; Default : TDateTime): TDateTime;
begin
  try
    Result := StrToDateTime(Text)
  except
    on EConvertError do Result := default;
  end;
end;

{<--- String > Float --->}
function StrToFloatDef(Text : String; Default : Double): Double;
begin
  try
    Result := StrToFloat(Text)
  except
    on EConvertError do Result := Default;
  end;
end;

{<--- String > Currency --->}
function CleanCurrStr(Str : String): String;
var
  i : Integer;
begin
  Result := Str;
  for i := Length(Result) downto 1 do
    if Pos(Result[i],'+-0123456789'+DecimalSeparator) < 1 then Delete(Result, i,1);
  (*
  Result := '';
  for i := 1 to Length(Str) do
    if Pos(Str[i],'+-0123456789'+DecimalSeparator) > 0 then Result := Result + Str[i];
  *)
end;

function StrToCurrDef(Text : String; Default : Currency) : Currency;
begin
  try
    Result := StrToCurr(CleanCurrStr(Text))
  except
    on EConvertError do Result := default;
  end;
end;

end.

PS: st_Chars ist entweder @String[1] oder ein PChar
PPS: TargetSize ist z.Z. noch irreführend. Größe muss nicht (mehr) beschränkt werden. Dient z.Z. noch als optionale Angabe, z.B. für Nachkommastellen.

[himitsu]

all zu kompliziert isses jetzt garnicht ... schau die mal den Typ Variant an ... der hat intern auch sowas .... nur noch viel viel viel größer/aufwendiger.

PS: bei aPtr und Co. ich würde die Dereferenzierung andersrum machen ... wenn du statt dem untypisieren Pointer mal einen typisierten Zeiger hast, dann knallt es da womöglich oder der Compiler sagt gleich nö.

z.B. statt Boolean(TargetPtr^) dann PBoolean(TargetPtr)^

Delphi-Quellcode:

function Pointer2String(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): AnsiString;
    st_Currency : Result := CurrToStr(PCurrency(aPtr)^); 
// StrToCurr hast später ja schon genutzt, warum dann hier Format-%m ?
// CurrToStr paßt dich zum IntToStr/FloatToStr besser dazu ^^

function Pointer2Boolean(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Boolean; 
    st_Byte     : Result := PByte(aPtr)^ <> 0;
    ...
    st_Currency : Result := PCurrency(aPtr)^ <> 0;
    st_Chars    : if not TryStrToBool(PChar(aPtr), Result) then Result := False;
    st_ShortStr : if not TryStrToBool(PShortString(aPtr)^, Result) then Result := False;
  else 

function Pointer2Integer(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Int64;
    st_Chars    : if not TryStrToInt64(PChar(aPtr), Result) then Result := 0;
    st_ShortStr : if not TryStrToInt64(PShortString(aPtr)^, Result) then Result := 0;
  else 

function Pointer2Float(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Double;
begin
  case AsTyp of
    st_Boolean  : if Boolean(aPtr^) then Result := 1 else Result := 0;
    st_Chars    : if not TryStrToFloat(PChar(aPtr), Result) then Result := 0;
    st_ShortStr : if not TryStrToFloat(PShortString(aPtr)^, Result) then Result := 0;
  else 

function CleanCurrStr(Str : String): String;
begin
  Result := Str;
  for i := Length(Str) downto 1 do
    if not (Str[i] in ['+-0123456789']) and (Str[i] <> DecimalSeparator) then
      Delete(Result, i, 1);
end;

und dann halt noch bei Pointer2Currency und Pointer2DateTime die Sache mit den Exceptions ... siehe oben die Try-Funktionen


[add]
statt Try-Except gibt es oftmal gleich hübsche Funktionen ala TryStrToInt oder (mißt, fällt mir grad ein) StrToIntDef (Def=Default)
und was passiert, wenn mal eine andere Exception auftritt, als die, welche du abfängst? genau, Result wäre undefiniert

Delphi-Quellcode:

function Pointer2Boolean(aPtr : Pointer; AsTyp : TstDataTyp; Size : Integer): Boolean; 
    st_Byte     : Result := PByte(aPtr)^ <> 0;
    ...
    st_Currency : Result := PCurrency(aPtr)^ <> 0;
    st_Chars    : Result := StrToBoolDef(PChar(aPtr), Result, False);
    st_ShortStr : Result := StrToBoolDef(PShortString(aPtr)^, Result, False);
  else

[Satty67]

Zitat von himitsu:

statt Boolean(TargetPtr^) dann PBoolean(TargetPtr)^
[...]TryStrToBool

Die aktuelle Anwendung hat zwar immer einen untypisierten Pointer, aber mal will den Code ja woanders wieder verwenden. Das ändere ich.

TryStrTo... kennt Delphi 5 nicht, wobei ich mir die Funktion auch selber basteln könnte. Kann man immer gebrauchen.

Den Rest schaue ich mir in Ruhe an.

Danke schonmal.

€:
// StrToCurr hast später ja schon genutzt, warum dann hier Format-%m ?
// CurrToStr paßt dich zum IntToStr/FloatToStr besser dazu ^^

Currency(Pointer)2String soll den landestypischen Currency String ausgeben. String(Pointer)2Currency wenn möglich den genauen Currency-Typ (Quelle kann "1,23 Euro" sein). Aber lese das morgen nochmal in Ruhe, wenn ich die Unit anpasse.

Glaube heute Abend mache ich mehr kaputt, wenn ich mich ranwage

[himitsu]

sie oben mein [add]

kennt D5 StrToBoolDef und Co.?


spätere/viele Delphi-Versionen kennen für viele Typen derartige Funktionen, wie StrToIntDef und TryStrToIn

Delphi-Quellcode:

function StrToBool(const S: string): Boolean; overload;
function StrToBoolDef(const S: string; const Default: Boolean): Boolean; overload;
function TryStrToBool(const S: string; out Value: Boolean): Boolean; overload;

function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): string;

[Satty67]

StrToIntDef/StrToInt64Def ist das einzige, StrToFloatDef hab' ich selber schon mal gebastelt... das war's dann mit sicherer TypUmwandlung.

Aber denke mit EConvertError und EInvalidOp hat man das meiste abgedeckt, wenn's trotzdem noch knallt hat man wohl den Pointer versemmelt? Denke die zu erwartenden Fehler müssen erstmal reichen. Später erweitern ist aber drin.

Delphi 2009 Trial hatte ich ja 4 Wochen in der Mangel... ich warte noch mit einem Update

[himitsu]

Zitat von Satty67:

Aber denke mit EConvertError und EInvalidOp hat man das meiste abgedeckt, wenn's trotzdem noch knallt hat man wohl den Pointer versemmelt? Denke die zu erwartenden Fehler müssen erstmal reichen.

notfalls könnte man das on-do auch weglassen und alle exceptions behandeln
try Result := StrToInt64(PChar(aPtr)) except Result := 0; end; ansonsten dann wenigstens etwas machen, wenn man die Exception nicht behandeln will und wenn es auch nur das erneute auslösen dieder wäre ... besser als sie unter den tisch zu kehren und so das Result in einem undefinierten Zustand zu lassen
try Result := StrToInt64(PChar(aPtr)) except on EConvertError do Result := 0; else Raise end;

[Satty67]

Selbst gesehen hab' ich noch (BoolTrue/FalseString kann auch JA/NEIN, EIN/AUS sein)

Delphi-Quellcode:

if UpperCase(PChar(aPtr)) = UpperCase(BoolTrueString) then Result := True else Result := False; 
// wird zu
Result := UpperCase(PChar(aPtr)) = UpperCase(BoolTrueString);

Was (in D5?) nicht geht ist
Str[i] in ['+-0123456789'] aber den Weg über downto und Delete übernehme ich.

Die Zeilen mit except habe ich durch ..To..Def Functionen (Eigenbau) ersetzt.

Das ganze wirkt schon wesentlich übersichtlicher.

***

Cast:

PByte(aPtr)^ wird gleich angemeckert, muss erst suchen, wo das in D5 definiert ist (Unit Types gibt es noch nicht). Notfalls halt auch selber anlegen.

Dabei hab' ich mich allerdings gefragt, ob es nötig ist. Wenn ich ein typisierten Pointer übergebe, meckert D5 ja nur, wenn der Platz nicht reicht... das wäre ja im Prinzip auch OK so. Komplett alles müssen die Funktionen nicht abfangen, das macht ja kaum eine Funktion. Etwas Sorgfalt muss ja auch im aufrufenden Code sein (wie z.B. genug Platz im Speicherbereich)