const
  S: string = 'ABC';
var
  P: PChar;
begin
  P := PChar(S);
  WriteLn(P);
end.

const
  S = 'ABC';
// ... далее, как раньше

const
  S = 'A';
// ... далее, как раньше

function DoSomething(const A: WideString): WideString; stdcall;
begin
  Result := A + 'sdf' + A;
end;

function DoSomething(const A: WideString): WideString; stdcall; external 'Project2.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := DoSomething(IntToStr(5));
end;

 Александр Алексеев

//Код dll
...

procedure DllProc(str1: pointer); stdcall;
begin
  StrPCopy(PChar(str1^),'Текст из dll');
end;

...

//Код программы
...

procedure TForm1.Button1Click(Sender: TObject);
var Lib: Cardinal;
    DllProc: procedure(str1: pointer); stdcall;
    str:PChar;
begin
  Lib := LoadLibrary('MyDll.dll');
  if Lib <> 0 then
  try
    DllProc := GetProcAddress(Lib, 'DllProc');
    GetMem(str,25);
    DllProc(@str);
    Label1.Caption:=str;
    FreeMem(str);
  finally
    FreeLibrary(Lib);
  end;
end;

...

//код приложения
procedure TForm1.Button1Click(Sender: TObject);
var Lib: Cardinal;
    DllProc: procedure(str: PPChar); stdcall;
    str:PChar;
begin
  Lib := LoadLibrary('MyDll.dll');
  if Lib <> 0 then
  try
    DllProc := GetProcAddress(Lib, 'DllProc');
    DllProc(@str);
    Label1.Caption:=str;
  finally
    FreeLibrary(Lib);
  end;
end;

var s:PChar;

begin
  s^:='лалала';
end;

//код dll

...
type
  PPChar = ^PChar;

procedure DllProc(str: PPChar); stdcall;
begin
  str^:='Текст из dll!';
end;

exports
  DllProc;
begin
end.

//Код программы
type
  PPChar = ^PChar;

procedure TForm1.Button1Click(Sender: TObject);
var Lib: Cardinal;
    DllProc: procedure(str: PPChar); stdcall;
    str:PPChar;
    t:string;
begin
  str := @t;
  Lib := LoadLibrary('MyDll.dll');
  if Lib <> 0 then
  try
    DllProc := GetProcAddress(Lib, 'DllProc');
    DllProc(str);
    Label1.Caption:=str^;
  finally
    FreeLibrary(Lib);
  end;
end;

function StrLCopy(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
var
  Len: Cardinal;
begin
  Result := Dest;
  Len := StrLen(Source);
  if Len > MaxLen then
    Len := MaxLen;
  Move(Source^, Dest^, Len * SizeOf(WideChar)); // AV here!
  Dest[Len] := #0;
end;

//в Pr1
procedure TForm1.Button1Click(Sender: TObject);
var
  fn: PChar;
begin
  fn := StrAlloc(MAX_PATH);
  GetFileName(fn);
  MessageBox(0, fn, PChar(Caption), 0);
  StrDispose(fn);
end;

// в dll
function GetFileName(var FileName: PChar): Integer; stdcall;
begin
  Result := SendMessage(HWND, WM_SM_GETFILENAME, integer(FileName), 0);
end;

//в обработчике сообщений Pr2
  case Msg.Msg of
    WM_SM_GETFILENAME:
      begin
        StrPCopy(PChar(Msg.WParam), 'test');
        Handled := True;
      end;
  end;

//программа
type
  PMyRec = ^TMyRec;
  TMyRec = record
    I: integer;
    S: string;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  r: TMyRec;
  Lib: Cardinal;
  AddRec: procedure(MyRec: PMyRec); stdcall;
begin
  r.i := 100;
  r.s := 'Long String';
  Lib := LoadLibrary('mylib.dll');
  if Lib <> 0 then
  try
    AddRec := GetProcAddress(Lib, 'AddRec');
    AddRec(@r);
  finally
    FreeLibrary(Lib);
  end;
end;

//dll
type
  PMyRec = ^TMyRec;
  TMyRec = record
    I: integer;
    S: string;
  end;

procedure AddRec(MyRec: PMyRec); stdcall;
var
  r: TMyRec;
begin
  r.i := MyRec.i;
  SetString(r.s, PChar(MyRec.s), Length(MyRec.s));
  //r.s := MyRec.s; //ни в коем случае
  //а с r.s делай уже что хочешь
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
type
  PtrChar = ^Char;  // "Чистый" указатель на Char

procedure ShowStringInfo(const S: String; Comment: String);
var
  ptr: Pointer;  // Нетипизированный указатель
  pCh: PChar;    // Указатель на Char, предназначенный для работы с нуль-терминированными строками
  ptrCh: PtrChar; // Обычный указатель на Char без дополнительных особенностей
  QRef, QElem: Integer;
begin
  ptr := Pointer(S);
  pCh := PChar(S);
  ptrCh := PtrChar(S);
  if ptr = nil then
  begin
    ShowMessage( Format(
      '%S'#13#10 +
      '------------------------------'#13#10 +
      'S = %s <интерпретируется как пустая>'#13#10#13#10 +
      'Pointer(S) =  %p'#13#10 +
      'PtrChar(S) = %p'#13#10 +
      'PChar(S) =    %p'#13#10#13#10 +
      'Ссылок:    <данные отсутствуют>'#13#10 +
      'Символов: <данные отсутствуют>'#13#10,
      [ Comment, QuotedStr(S), ptr, ptrCh, Pointer(pCh)] ));
    Exit;
  end;

  QRef := PInteger(pCh - SizeOf(Integer) * 2 )^;
  QElem := PInteger(pCh - SizeOf(Integer))^;
  ShowMessage( Format(
    '%S'#13#10 +
    '------------------------------'#13#10 +
    'S = %s'#13#10#13#10 +
    'Pointer(S) =  %p'#13#10 +
    'PtrChar(S) = %p'#13#10 +
    'PChar(S) =    %p'#13#10#13#10 +
    'Ссылок:    %d'#13#10 +
    'Символов: %d'#13#10,
    [ Comment, QuotedStr(S), ptr, ptrCh, Pointer(pCh), QRef, QElem] ));
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  cnst = 'Named constant';
var
  a, b: String;
begin
  ShowStringInfo('Text constant', 'Неименованная константа');

  ShowStringInfo(cnst, 'Именованная константа');

  ShowStringInfo(a, 'a - хотя и локальная, но при объявлении инициализирована nil');

  a := 'Test';
  ShowStringInfo(a, 'a - присвоена константа');

  b := a;
  ShowStringInfo(a, 'a - после присвоения b := a (a и b ссылаются на одну константу)');
  ShowStringInfo(b, 'b - ссылается на ту-же константу');

  a := a + 'New';
  ShowStringInfo(a, 'a - присвоена не константа');

  b := a;
  ShowStringInfo(a, 'a - после присвоения b := a (a и b ссылаются на одни данные)');
  ShowStringInfo(b, 'b - ссылается на те-же данные');

  a := a + 'Other';
  ShowStringInfo(a, 'a - присвоено новое значение, ссылается на новые данные');
  ShowStringInfo(b, 'b - ссылается на прежние данные, количество ссылок уменьшилось');

  ShowMessage('А теперь - внимание!'#13#10'Строке присваиваем значение, возвращаемое функцией');

  a := DateTimeToStr(Now);
  ShowStringInfo(a, 'a - присвоено значение, возвращённое функцией (количество ссылок - 2, а не 1)');

  a := '';
  ShowStringInfo(a, 'a - присвоена пустая строка');
end;

end.

  asm
    mov eax, Str
    mov eax, [eax-8]
    mov RefCount, eax
  end;

type
  PInteger = ^Integer;
  PChr = ^Char;

procedure TestI(H: PInteger);
begin

end;

procedure TestC(H: PChar);
begin

end;

procedure TestChr(CH: PChr);
begin

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  M: array[0..10]of Integer;
  C: array[0..10]of Char;
begin
//  TestI(M); - ошибка компиляции
  TestC(C); // всё прекрасно компилируется
//  TestChr(C); - ошибка компиляции
end;

unit FastShareMem;

interface

var
  GetAllocMemCount: function: integer;
  GetAllocMemSize : function: integer;

implementation

uses Windows;

const ClassName  = '_com.codexterity.fastsharemem.dataclass';

type
  TFastSharememPack = record
    MemMgr: TMemoryManager;
    _GetAllocMemSize  :function :integer;
    _GetAllocMemCount :function :integer;
  end;

  function _GetAllocMemCount: Integer;
  begin
    Result := System.AllocMemCount;
  end;

  function _GetAllocMemSize: Integer;
  begin
    Result := System.AllocMemSize;
  end;

var
  MemPack: TFastSharememPack;
  OldMemMgr: TMemoryManager;
  wc: TWndClass;
  isHost: boolean;

initialization

  if (not GetClassInfo(HInstance, ClassName, wc)) then
  begin
    GetMemoryManager(MemPack.MemMgr);
    MemPack._GetAllocMemCount := @_GetAllocMemCount;
    MemPack._GetAllocMemSize  := @_GetAllocMemSize;
    GetAllocMemCount := @_GetAllocMemCount;
    GetAllocMemSize  := @_GetAllocMemSize;
    FillChar(wc, sizeof(wc), 0);
    wc.lpszClassName := ClassName;
    wc.style := CS_GLOBALCLASS;
    wc.hInstance := hInstance;
    wc.lpfnWndProc := @MemPack;
    if RegisterClass(wc)=0 then
    begin
      MessageBox( 0, 'Shared Memory Allocator setup failed: Cannot register class.', 'FastShareMem', 0 );
      Halt;
    end;
    isHost := true;
  end else
  begin
    GetMemoryManager(OldMemMgr); // optional
    SetMemoryManager(TFastSharememPack(wc.lpfnWndProc^).MemMgr);
    GetAllocMemCount := TFastSharememPack(wc.lpfnWndProc^)._GetAllocMemCount;
    GetAllocMemSize  := TFastSharememPack(wc.lpfnWndProc^)._GetAllocMemSize;
    isHost := false;
  end;

finalization
  if isHost then UnregisterClass(ClassName, HInstance)
  else SetMemoryManager(OldMemMgr); // optional

end.

 Ins

  S := 'Good bye';
  UniqueString(S);

someproc(s1, s2: string); overload;
someproc(s1, s2: WideString); overload;
someproc(s1, s2: PChar); overload;
someproc(s1, s2: PWideChar); overload;
someproc(s1: string; s2: PChar); overload;
someproc(s1: string; s2: WideString); overload;

var
  S : ShortStringl;
  P : PChar;
begin
  S:='This is a string' + #0; // добавляем в конец строки #0
  P:=@S[1];  // присваиваем ссылку на первый символ строки
end;

 Geo

str = str + "fdgsdfg";

S := S1 + S2;

 panda