Log in

View Full Version : "Pack" function for delphi 7?


Sirber
27th March 2006, 15:17
I'm looking for a function similar to this one:

http://ca.php.net/manual/en/function.pack.php

Thanks!

unmei
30th March 2006, 14:09
there are no "mixed args" in delphi, so you might have to write an "append" function for each type you want and feed in the target (and offset if you work on a array, not a stream)

for a TStream it might look like this:

procedure s_put_B(s: TStream; const b: Byte);
begin
s.write(b,1);
end;

//big endian writing
procedure s_put_W(s: TStream; const w: Word);
var beW: Word;
begin
beW := (w shl 8) or (w shr 8);
s.write(w,2);
end;

procedure s_put_byteArray(s: TStream; const pba: PDynamicByteArray);
begin
s.write(pba^[0],length(pba^));
end;

procedure s_put_string(s: TStream; const s: string);
begin
s.write(s[1],length(s));
end;

[and so on..]

to just write some preknown stuff you then just call those one after another.

If you wanted to write some dynamic thing you might have to create class that represents a bag of values of arbitrary types and call those elementary writers depending on what you find in the bag:

TvalType = (vtBad,vtByte,vtShortInt,vtWord,vtInteger,vtCardinal,vtInt64,vtSingle,vtDouble,vtString);

TanyType = class(TObject)
public
constructor CreateFromStream(s: TStream); virtual; abstract;
function valType: TvalType; virtual; abstract;
procedure writeToStream(s: TStream); virtual; abstract;
private
end;

TanyTypeByte = class(TanyType)
public
constructor CreateFromStream(s: TStream); override;
function valType: TvalType; override;
procedure writeToStream(s: TStream); override;
function value: Byte;
constructor CreateFromValue(b: Byte);
private
fv: Byte;
end;



constructor TanyTypeByte.CreateFromStream(s: TStream); override;
begin
inherited Create;
fv := a_get_B(s); //aka s.read(fv,1);
end;

function TanyTypeByte.valType: TvalType;
begin return vtByte; end;

procedure TanyTypeByte.writeToStream(s: TStream); override;
begin
s_put_B(s,fv);
end;

[etc]

and the container

TanyTypeList = class(TObject)
public
function insert(index: integer; anyval: TanyType): integer;
procedure writeToStream(s: TStream);
private
fanyval: array of TanyType;
fsize,fcap: integer;
end;

procedure TanyTypeList.writeToSream(s);
var i: integer;
begin
for i := 0 to fsize-1 do fanyval[i].writeToStream(s);
end;

[...]

However, the problem with this one is, to *read* the members back from the stream you would have to know what types to expect. If you need that and do not know the types to expect, you will probably have to write the valtype before each value.
Then you could read back in an admittedly ugly createFromStream(s)

while s.Position < s.Size {or some other stop criteria} do begin
nextType = TanyVal(s_get_B(s)); //assuming you forced the type write as a byte
//self.add would take a TanyType and append it to the internal array
case nextType of
vtBad: raise hell
vtByte: self.add(TanyTypeByte.CreateFromStream(s));
vtIntegerByte: self.add(TanyTypeInteger.CreateFromStream(s));
vtString: self.add(TanyTypeString.CreateFromStream(s));
end;
end;

--
wow i think i'm crazy writing all this in the "quick reply" box

alfixdvd
30th March 2006, 16:21
I think there are "mixed args" in delphi, the example is the Format function.

Format("The number are %d %d",[i,j ])

Best regards.

Myrsloik
30th March 2006, 16:34
Whatever you're trying to do there's probably a better way than copying the behavior of that php pack thing. But if you still want to do it that way here's my suggestion:

type
TDynByteArray = array of Byte;

function Pack(Args: array of const): TDynByteArray;
var
Counter: Integer;
APos: Integer;
begin
APos := 0;
SetLength(Result, 0);

for Counter := 0 to High(Args) do
with Args[Counter] do
case VType of
vtInteger:
begin
SetLength(Result, Length(Result) + SizeOf(Integer));
PInteger(@Result[APos])^ := vInteger;
Inc(APos, SizeOf(Integer));
end;
vtBoolean:
begin
SetLength(Result, Length(Result) + SizeOf(Boolean));
PBoolean(@Result[APos])^ := vBoolean;
Inc(APos, SizeOf(Boolean));
end;
vtChar:
begin
SetLength(Result, Length(Result) + SizeOf(Char));
PChar(@Result[APos])^ := vChar;
Inc(APos, SizeOf(Char));
end;
vtPChar:
begin
SetLength(Result, Length(Result) + Length(vPChar) + 1);
CopyMemory(PChar(@Result[APos]), vPChar, Length(vPChar) + 1);
Inc(APos, Length(vPChar) + 1);
end;
else
Assert(False);
end;
end;

unmei
31st March 2006, 22:59
hmm indeed, never seen an array of const before :)

Sirber
31st March 2006, 23:42
Thanks for the help!

unfortunatly I don't think I can succeed in my task :(