【列表6.13】程序shmTalk的主框架。
unit frmTalk;
interface
uses
    SysUtils, Libc, Types, Classes, Variants, QGraphics, QControl~
    QForms, QDialogs,  QStdCtrls, QTypes, QExtCtrls;
 const
    AccessMode = S_IREAD or S_IWRITE or S_IRGRP or S_IWGRP;
    BufSize = 508;
 type
     PComBuffer = ^TComBuffer;
     TComSuffer = record
        bMsg : boolean;  // set when a message is available
        aMsg : Array[0..BufSize] of char:
     end;
  const
     SegmentSize = 2*sizeof (TComBuffer);
  type
     TForml = class(TForm)
        Button1: TButton;
        Memo1: TMemo;
        Edit1: TEdit;
        Timer1: TTimer;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure Button1Click(Sender: TObject);
        procedure Timer1Timer(Sender: TObject);
    private
       FShmId : Integer;
       FOwnShm : boolean;
       FSharePtr : Pointer;
       FSendBuf : PComBuffer;
       FRecvBuf : PComBuffer;
    public
       { Public declarations }
   end;
var
   Form1: TForm1;
implementation
{SR *.xfm}
procedure TForm1. FormCreate(Sender: TObject);
var
   Key : Integer;
begin
   // create key
  Key := ftok (PChar(GetModuleName(0)), 1);
  // try to open existing shared memory
  FShmId := shmget (Key, 0, 0);
  if FShmId = -1 then
  begin
     // doesn't exist, create it
     FShmId := shmget (Key, SegmentSize,
        IPC_CREAT or IPC_EXCL or AccessMode);
     if FShmId = -1 then
        raise Exception.Create (strerror (errno));
     FOwnShm := true;
  end
  else
     FOwnShm := false;
  // attach to shared memory
  FSharePtr := shmat (FShmId, nil, 0);
  if Integer(FSharePtr) = -1 then
  begin
     FSharePtr :=nil;
     raise Exception.Create (strerror (errno));
  end;
  // set up buffers
  if FOwnShm then
  begin
     FSendBuf := FSharePtr;
     FRecvBuf := PComBuffer(PChar(FSharePtr) + sizeof (TComBuffer));
     FRecvBuf^.bMsg := false;
  end
  else
  begin
      FRecvBuf := FSharePtr;
      FSendBuf := PComBuffer(PChar(FSharePtr) + sizeof (TComBuffer));
  end;  
   FSendBuf^.bMsg := false;
  Timer1.Enabled := true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
   Timer1.Enabled := false;
   if Assigned (FSharePtr) then
      shmdt (FSharePtr);
   if FOwnShm  then
      if shmctl (FShmId, IPC_RMID, nil) = -1 then
         raise Exception.Create (strerror (errno));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
   s : String;
begin
   // copy the text from the edit box to the shared memory
   s := Edit1.Text;
   StrCopy (@FSendBuf^.aMsg, PChar(s));
   // set flag to indicate that a message is there
   FSendBuf^.bMsg := true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if FRecvBuf^.bMsg then
   begin
      // read the message
      Memol.Lines.Add (FRecvBuf^.aMsg);
      // and clear the flag
      FRecvBuf^.bMsg := false;
   end;
end;
end.