DLL mit Strings von D10 nach Delphi 6

[Kas Ob.]

@kmma ,

Have you tested the proposed constant hack ?

Please try this

Code:

// these for single thread
function BuiltOldAnsiString(const aString: AnsiString): Pointer; overload;
function BuiltOldAnsiString(const aString: string): Pointer; overload;

// these for multi thread application
// these might leave one memory leak per thread as worse case, just one leak that can be registered
function BuiltOldAnsiStringMt(const aString: AnsiString): Pointer; overload;
function BuiltOldAnsiStringMt(const aString: string): Pointer; overload;

implementation
var
  gTempBufferForEmulatedOldAnsi: array of byte;

threadvar
  gTempBufferForEmulatedOldAnsiThreadSafe: array of byte;

function BuiltOldAnsiString(const aString: AnsiString): Pointer; overload;
var
  Len: Integer;
  Mem: PCardinal;
begin
  Len := Length(aString);
  if Len = 0 then
  begin
    Result := nil;
    Exit;
  end;

  SetLength(gTempBufferForEmulatedOldAnsi, Len + 8 + 1);  // header + 1 null ansi char
  Mem := @gTempBufferForEmulatedOldAnsi[0];
  Mem^ := $FFFFFFFF;            // refcount =(-1) emulating constant string
  Inc(Mem, 1);
  Mem^ := Len;
  Inc(Mem, 1);

  Move(aString[1], Mem^, Len);
  PByte(Mem)[Len + 1] := 0;     // make sure it is null terminated

  Result := Mem;
end;

function BuiltOldAnsiString(const aString: string): Pointer; overload;
begin
  Result := BuiltOldAnsiString(AnsiString(aString));
end;

function BuiltOldAnsiStringMt(const aString: AnsiString): Pointer; overload;
var
  Len: Integer;
  Mem: PCardinal;
begin
  Len := Length(aString);
  if Len = 0 then
  begin
    Result := nil;
    Exit;
  end;

  SetLength(gTempBufferForEmulatedOldAnsiThreadSafe, Len + 8 + 1);  // header + 1 null ansi char
  Mem := @gTempBufferForEmulatedOldAnsiThreadSafe[0];
  Mem^ := $FFFFFFFF;            // refcount =(-1) emulating constant string
  Inc(Mem, 1);
  Mem^ := Len;
  Inc(Mem, 1);

  Move(aString[1], Mem^, Len);
  PByte(Mem)[Len + 1] := 0;     // make sure it is null terminated

  Result := Mem;
end;

function BuiltOldAnsiStringMt(const aString: string): Pointer; overload;
begin
  Result := BuiltOldAnsiString(AnsiString(aString));
end;

Would love to know if this works ?