unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
TypInfo;
// y2string wandelt verschiedene Typen in String um
// 1. Parameter ist der Typ
// 2. Parameter ist der typlose Parameter
function y2string(typ: TTypeKind;
const y):
string;
begin
case typ
of
tkInteger: Result := IntToStr(Integer(y));
tkChar: Result := Char(y);
tkString: Result :=
string(y);
tkClass: Result := TObject(y).ClassName;
else
Result := GetEnumName(TypeInfo(TTypeKind), Ord(typ)) + '
wird nicht unterstützt.';
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
z1: Integer;
z2:
string;
z3: char;
z4: double;
begin
// Test von y2string
z1 := 1;
z2 := '
Zwei';
z3 := '
D';
z4 := 0.5;
Memo1.Lines.Add(y2string(tkInteger, z1));
// Ausgabe: '1'
Memo1.Lines.Add(y2string(tkString, z2));
// Ausgabe: 'Zwei'
Memo1.Lines.Add(y2string(tkChar, z3));
// Ausgabe: 'D'
Memo1.Lines.Add(y2string(tkClass, Self));
// Ausgabe: 'TForm1'
Memo1.Lines.Add(y2string(tkClass, Sender));
// Ausgabe: 'TButton'
Memo1.Lines.Add(y2string(tkFloat, z4));
// Ausgabe: 'tkFloat wird nicht unterstützt.'
end;
// Gibt 1. Parameter als HexDump aus
function HexDump(
const y; size: Integer):
string;
type
TBytes =
array[0..MaxInt - 1]
of Byte;
var
i, j: Integer;
s:
string;
begin
// // Das würde reichen. Der Rest ist nur Optik ;-)
// for i := 0 to size - 1 do
// begin
// j := TBytes(y)[i];
// Result := Result + IntToHex(j, 2) + ' ';
// end;
Result := '
Größe: ' + IntToStr(size) + '
Bytes' + sLineBreak;
for i := 0
to size - 1
do
begin
if (i
mod 16) = 0
then Result := Result + IntToHex(i, 4) + '
: ';
// Das i. Byte von y ermitteln
j := TBytes(y)[i];
// Hex Zahl ausgeben
Result := Result + IntToHex(j, 2) + '
';
// lesbaren Bereich rechts ausgeben
if j > 31
then s := s + Chr(j)
else s := s + '
.';
// nach 8 Bytes Leerzeichen und
// nach 16 Byte lesbaren Text sowie Zeilenumbruch ausgeben
if (i
mod 16) = 15
then
begin
Result := Result + '
: ' + s + sLineBreak;
s := '
';
end
else if (i
mod 8) = 7
then
begin
Result := Result + '
';
s := s + '
';
end;
end;
// Letzte Zeile kann weniger als 16 Byte haben -> mit Leerzeichen auffüllen
if ((size-1)
mod 16) < 15
then
begin
for i := ((size-1)
mod 16)
to 14
do Result := Result + '
';
if ((size-1)
mod 16) < 7
then Result := Result + '
';
Result := Result + '
: ' + s + sLineBreak;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
s1:
string;
s2: shortstring;
a:
array[0..2]
of record x,y: Integer
end;
begin
// Test von HexDump
s1 := '
Hallo, das ist ein Test.';
s2 := '
Hallo, das ist ein Test.';
a[0].x := 0;
a[0].y := 1;
a[1].x := 2;
a[1].y := 3;
a[2].x := 4;
a[2].y := 5;
// Courier sieht beim Dump schöner aus ;-)
Memo1.Font.
Name := '
Courier New';
// Huch, es werden nur 4 Byte ausgegeben -> Ein String ist also ein Pointer
Memo1.Lines.add(HexDump(s1, SizeOf(s1)));
// Hier ist der Text ;-)
// (Length + 1 ist immer 0, da es intern ein nullterminierter String ist.)
Memo1.Lines.add(HexDump(Pointer(s1)^, Length(s1)+1));
// Aha, wie früher in Turbo Pascal -> String ist 256 Byte groß und
// 1. Byte beinhaltet die Größe (Länge) des Strings
Memo1.Lines.add(HexDump(s2, SizeOf(s2)));
// Das Array ist 25 Byte größ 3 x 2 Integer á 4 Byte
Memo1.Lines.add(HexDump(a, SizeOf(a)));
// Ausgabe letzter HexDump(a):
// Größe: 24 Bytes
// 00 00 00 00 01 00 00 00 02 00 00 00 03 00 00 00 : ........ ........
// 04 00 00 00 05 00 00 00 : ........
end;
end.