{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{                                                       }
{       Copyright (c) 1995 Borland International        }
{                                                       }
{*******************************************************}

unit DdeMan;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, DDEML, StdCtrls;

type
  TDataMode = (ddeAutomatic, ddeManual);
  TDdeServerConv = class;

  TMacroEvent = procedure(Sender: TObject; Msg: TStrings) of object;

  TDdeClientItem = class;

  { TDdeClientConv }

  TDdeClientConv = class(TComponent)
  private
    FDdeService: PString;
    FDdeTopic: PString;
    FConv: HConv;
    FCnvInfo: TConvInfo;
    FItems: TList;
    FHszApp: HSZ;
    FHszTopic: HSZ;
    FDdeFmt: Integer;
    FOnClose: TNotifyEvent;
    FOnOpen: TNotifyEvent;
    FAppName: PString;
    FDataMode: TDataMode;
    FConnectMode: TDataMode;
    FWaitStat: Boolean;
    FFormatChars: Boolean;
    function GetServiceApp: string; 
    function GetDdeService: string;
    function GetDdeTopic: string;
    procedure SetDdeService(const Value: string);
    procedure SetDdeTopic(const Value: string);
    procedure SetService(const Value: string);
    procedure SetTopic(const Value: string);
    procedure SetServiceApp(const S: string); 
    procedure SetConnectMode(NewMode: TDataMode);
    procedure SetFormatChars(NewFmt: Boolean);
    procedure XactComplete;          
    procedure SrvrDisconnect;        
    procedure DataChange(DdeDat: HDDEData; hszIt: HSZ); 
  protected
    function CreateDdeConv(FHszApp: HSZ; FHszTopic: HSZ): Boolean;
    function GetCliItemByName(const ItemName: string): TPersistent;
    function GetCliItemByCtrl(ACtrl: TDdeClientItem): TPersistent;
    procedure Loaded; override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadLinkInfo (Reader: TReader);
    procedure WriteLinkInfo (Writer: TWriter);
    function OnSetItem(aCtrl: TDdeClientItem; const S: String): Boolean;  
    procedure OnAttach(aCtrl: TDdeClientItem);  
    procedure OnDetach(aCtrl: TDdeClientItem);
    procedure Close; dynamic;
    procedure Open; dynamic;
    function ChangeLink(const App: string; const Topic: string; 
      const Item: string): Boolean;
    procedure ClearItems;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function PasteLink: Boolean;
    function OpenLink: Boolean;
    function SetLink(const Service: string; const Topic: string): Boolean;
    procedure CloseLink;
    function StartAdvise: Boolean;
    function PokeDataLines(const Item: string; Data: TStrings): Boolean;  
    function PokeData(const Item: string; Data: PChar): Boolean;  
    function ExecuteMacroLines(Cmd: TStrings; waitFlg: Boolean): Boolean;  
    function ExecuteMacro(Cmd: PChar; waitFlg: Boolean): Boolean;
    function RequestData(const Item: string): PChar;
    property DdeFmt: Integer read FDdeFmt;
    property WaitStat: Boolean read FWaitStat;
    property Conv: HConv read FConv;
    property DataMode: TDataMode read FDataMode write FDataMode;
  published
    property ServiceApplication: String read GetServiceApp write SetServiceApp;
    property DdeService: String read GetDdeService write SetDdeService;
    property DdeTopic: String read GetDdeTopic write SetDdeTopic;
    property ConnectMode: TDataMode read FConnectMode write SetConnectMode default ddeAutomatic;
    property FormatChars: Boolean read FFormatChars write SetFormatChars default False;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  end;

  TDdeClientItem = class(TComponent)
  private
    FLines: TStrings;
    FDdeClientConv: TDdeClientConv;
    FDdeClientItem: PString;   
    FOnChange: TNotifyEvent;
    function GetDdeClientItem: String;  
    function GetText: String;
    procedure SetDdeClientItem (const Val: String);  
    procedure SetDdeClientConv(Val: TDdeClientConv);  
    procedure SetText(const S: String);
    procedure SetLines(L: TStrings);
    procedure OnAdvise;
  protected
    procedure Notification(AComponent: TComponent;      
      Operation: TOperation); override;                 
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Text: String read GetText write SetText;
    property Lines: TStrings read FLines write SetLines;
    property DdeConv: TDdeClientConv read FDdeClientConv write SetDdeClientConv;
    property DdeItem: String read GetDdeClientItem write SetDdeClientItem;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;


  { TDdeServerConv }

  TDdeServerConv = class(TComponent)
  private
    FOnOpen: TNotifyEvent;
    FOnClose: TNotifyEvent;
    FOnExecuteMacro: TMacroEvent;
  protected
    procedure Connect; dynamic;
    procedure Disconnect; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteMacro(Data: HDdeData): LongInt;
  published
    property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnExecuteMacro: TMacroEvent read FOnExecuteMacro write FOnExecuteMacro;
  end;

  { TDdeServerItem }

  TDdeServerItem = class(TComponent)
  private
    FLines: TStrings;
    FServerConv: TDdeServerConv;
    FOnChange: TNotifyEvent;
    FOnPokeData: TNotifyEvent;
    FFmt: Integer;
    procedure ValueChanged;
  protected
    function GetText: string;
    procedure SetText(const Item: string);
    procedure SetLines(Value: TStrings);
    procedure SetServerConv(SConv: TDdeServerConv);
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function PokeData(Data: HDdeData): LongInt;
    procedure CopyToClipboard;
    procedure Change; dynamic;
    property Fmt: Integer read FFmt;
  published
    property ServerConv: TDdeServerConv read FServerConv write SetServerConv;
    property Text: string read GetText write SetText;
    property Lines: TStrings read FLines write SetLines;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnPokeData: TNotifyEvent read FOnPokeData write FOnPokeData;
  end;

  { TDdeMgr }

  TDdeMgr = class(TComponent)
  private
    FAppName: PString;
    FHszApp: HSZ;
    FConvs: TList;
    FCliConvs: TList;
    FConvCtrls: TList;
    FDdeInstId: Longint;
    FDdeCallProc: TFarProc;
    FLinkClipFmt: Word;
    procedure Disconnect(DdeSrvrConv: TComponent);
    function GetSrvrConv(const Topic: string ): TComponent;
    function AllowConnect(hszApp: HSZ; hszTopic: HSZ): Boolean;
    function AllowWildConnect(hszApp: HSZ; hszTopic: HSZ): HDdeData;
    function Connect(Conv: HConv; hszTopic: HSZ; SameInst: Boolean): Boolean;
    procedure PostDataChange(const Topic: string; Item: string);
    procedure SetAppName(const Name: string);
    function GetAppName: string;
    procedure ResetAppName;
    function  GetServerConv (const Topic: string): TDdeServerConv;
    procedure InsertServerConv(SConv: TDdeServerConv);
    procedure RemoveServerConv(SConv: TDdeServerConv);
    procedure DoError;
    function  GetForm (const Topic: string): TForm;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetExeName: string;
    property DdeInstId: LongInt read FDdeInstId write FDdeInstId;
    property AppName: string read GetAppName write SetAppName;
    property LinkClipFmt: Word read FLinkClipFmt;
  end;

  function GetPasteLinkInfo(var Service: String; var Topic: String;
                            var Item: String): Boolean;
var
  ddeMgr: TDdeMgr;

implementation

uses SysUtils, Dialogs, Consts, Clipbrd;  

type
  EDdeError = class(Exception);
  TDdeSrvrConv = class;

  { TDdeSrvrItem }

  TDdeSrvrItem = class(TComponent)
  private
    FConv: TDdeSrvrConv;
    FItem: PString;
    FHszItem: HSZ;
    FSrvr: TDdeServerItem;
  protected
    procedure SetItem(const Value: string);
    function GetItem: string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function RequestData(Fmt: Word): HDdeData;
    procedure PostDataChange;
    property Conv: TDdeSrvrConv read FConv write FConv;
    property Item: string read GetItem write SetItem;
    property Srvr: TDdeServerItem read FSrvr write FSrvr;
    property HszItem: HSZ read FHszItem;
  end;

  { TDdeSrvrConv }

  TDdeSrvrConv = class(TComponent)
  private
    FTopic: string;
    FHszTopic: HSZ;
    FForm: TForm;
    FSConv: TDdeServerConv;
    FConv: HConv;
    FCnvInfo: TConvInfo;
    FDdeFmt: Integer;
    FItems: TList;
  protected
    function GetControl(WinCtrl: TWinControl; DdeConv: TDdeServerConv; const ItemName: string): TDdeServerItem;
    function GetSrvrItem(hszItem: HSZ): TDdeSrvrItem;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function RequestData(Conv: HConv;  hszTopic: HSZ; hszItem :HSZ;
      Fmt: Word): HDdeData;
    function AdvStart(Conv: HConv;  hszTopic: HSZ; hszItem :HSZ;
      Fmt: Word): Boolean;
    procedure AdvStop(Conv: HConv;  hszTopic: HSZ; hszItem :HSZ);
    function PokeData(Conv: HConv;  hszTopic: HSZ; hszItem :HSZ; Data: HDdeData;
      Fmt: Integer): LongInt;
    function ExecuteMacro(Conv: HConv;  hszTopic: HSZ; Data: HDdeData): Integer;
    function GetItem(const ItemName: string): TDdeSrvrItem;
    property Conv: HConv read FConv;
    property Form: TForm read FForm;
    property SConv: TDdeServerConv read FSConv;
    property Topic: string read FTopic write FTopic;
    property HszTopic: HSZ read FHszTopic;
  end;

  { TDdeCliItem }

  TDdeCliItem = class(TPersistent)
  protected
    FItem: PString;
    FHszItem: HSZ;
    FCliConv: TDdeClientConv;
    FCtrl: TDdeClientItem;
    function StartAdvise: Boolean;
    function StopAdvise: Boolean;
    function GetItem: string;
    procedure StoreData(DdeDat: HDDEData);
    procedure DataChange;
    function AccessData(DdeDat: HDDEData; pDataLen: PLongint): Pointer;
    procedure ReleaseData(DdeDat: HDDEData);
  public
    constructor Create(ADS: TDdeClientConv);
    destructor Destroy; override;
    function RefreshData: Boolean;
    function SetItem(const S: string): Boolean;
    procedure SrvrDisconnect;           { used by DDE callback proc only }
        {Item is confusing since other DataLink object have other
         inferences for Topic }
    property HszItem: HSZ read FHszItem;
    property Control: TDdeClientItem read FCtrl write FCtrl;
  published
    property Item: string read GetItem;
  end;


function DdeMgrCallBack(CallType, Fmt: Word; Conv: HConv; hsz1, hsz2: HSZ;
  Data: HDDEData; Data1, Data2: Longint): HDDEData; export;
var
  ci: TConvInfo;
  ddeCli: TComponent;
  ddeSrv: TDdeSrvrConv;
  ddeObj: TComponent;
begin
  Result := 0;
  case CallType of
    XTYP_CONNECT: 
      Result := HDdeData(ddeMgr.AllowConnect(hsz2, hsz1));
    XTYP_WILDCONNECT:
      Result := ddeMgr.AllowWildConnect(hsz2, hsz1);
    XTYP_CONNECT_CONFIRM: 
      ddeMgr.Connect(Conv, hsz1, Boolean(Data2));
  end;

  if Conv <> 0 then
  begin
    ci.cb := sizeof(TConvInfo);
    if DdeQueryConvInfo(Conv, QID_SYNC, @ci) = 0 then Exit;
    case CallType of
      { Callbacks to server conversations }
      XTYP_ADVREQ:
        begin
          ddeSrv := TDdeSrvrConv(ci.hUser);
          Result := ddeSrv.RequestData(Conv, hsz1, hsz2, Fmt);
        end;

      XTYP_REQUEST:
        begin
          ddeSrv := TDdeSrvrConv(ci.hUser);
          Result := ddeSrv.RequestData(Conv, hsz1, hsz2, Fmt);
        end;
 
      XTYP_ADVSTOP:
        begin
          ddeSrv := TDdeSrvrConv(ci.hUser);
          ddeSrv.AdvStop(Conv, hsz1, hsz2);
        end;
  
      XTYP_ADVSTART:
        begin
          ddeSrv := TDdeSrvrConv(ci.hUser);
          Result := HDdeData(ddeSrv.AdvStart(Conv, hsz1, hsz2, Fmt));
        end;
  
      XTYP_POKE:
        begin
          ddeSrv := TDdeSrvrConv(ci.hUser);
          Result := HDdeData(ddeSrv.PokeData(Conv, hsz1, hsz2, Data, Fmt));
        end;
  
      XTYP_EXECUTE:
        begin
          ddeSrv := TDdeSrvrConv(ci.hUser);
          Result := HDdeData(ddeSrv.ExecuteMacro(Conv, hsz1, Data));
        end;
  
 
    {----Callbacks to client conversations------------------}

      XTYP_XACT_COMPLETE:
        begin
         { will need to compare transaction identifier,
           indicate transaction complete }
          ddeCli := TComponent(ci.hUser);
          if ddeCli <> nil then TDdeClientConv(ddeCli).XactComplete
        end;
  
      XTYP_ADVDATA:
        begin
          ddeCli := TComponent(ci.hUser);
          TDdeClientConv(ddeCli).DataChange(Data, hsz2);
        end;

    {----Callbacks to client or Srvr conversations------------------}
      XTYP_DISCONNECT:
        begin
          ddeObj := TComponent(ci.hUser);
          if ddeObj <> nil then
          begin
            if ddeObj is TDdeClientConv then
              TDdeClientConv(ddeObj).SrvrDisconnect
            else
              ddeMgr.Disconnect(ddeObj);
          end;
        end;
 
      XTYP_ERROR:
        begin
        end;

    end;
  end;

end;

function GetPasteLinkInfo(var Service: String; var Topic: String;
  var Item: String): Boolean;
var
   hData: THandle;
   pData: Pointer;
   P: PChar;
   Len, Len2: Integer;
begin
  Result := False;
  Clipboard.Open;
  hData := Clipboard.GetAsHandle(ddeMgr.LinkClipFmt);
  if hData <> 0 then
  begin
    pData := GlobalLock(hData);
    try
      P := PChar(pData);
      Service := StrPas(pData);
      P := P + Length(Service) + 1;
      Topic := StrPas(P);
      P := P + Length(Topic) + 1;
      Item := StrPas(P);
    finally
      GlobalUnlock(hData);
    end;
    Result := True;
  end;
  Clipboard.Close;
end;


{ TDdeMgr }

constructor TDdeMgr.Create(AOwner: TComponent);
var
  err: Integer;
begin
  inherited Create(AOwner);
  FAppName := NullStr;
  FLinkClipFmt := RegisterClipboardFormat('Link');
  FDdeInstId := 0;
  FDdeCallProc := MakeProcInstance(@DdeMgrCallBack, HInstance);
  err := DdeInitialize(FDdeInstId,  TCallback(FDdeCallProc),
    APPCLASS_STANDARD, 0);
  if err <> DMLERR_NO_ERROR then
  begin
    DoError;
    Exit;
  end;
  FConvs := TList.Create;
  FCliConvs := TList.Create;
  FConvCtrls := TList.Create;
  AppName := GetExeName;
end;

destructor TDdeMgr.Destroy;
var
  I: Integer;
begin
  if FConvs <> nil then
  begin
    for I := 0 to FConvs.Count - 1 do
      TDdeSrvrConv(FConvs[I]).Free;
    FConvs.Free;
  end;
  if FCliConvs <> nil then
  begin
    for I := 0 to FCliConvs.Count - 1 do
      TDdeSrvrConv(FCliConvs[I]).Free;
    FCliConvs.Free;
  end;
  if FConvCtrls <> nil then
    FConvCtrls.Free;   {members will be freed by Owner} 
  ResetAppName;
  DdeUnInitialize(FDdeInstId);
  FreeProcInstance(FDdeCallProc);
  DisposeStr (FAppName);
  inherited Destroy;
end;

function TDdeMgr.AllowConnect(hszApp: HSZ; hszTopic: HSZ): Boolean;
var
  CharVal: array[0..255] of Char;
  Topic: string;
  Form: TForm;
  SConv: TDdeServerConv;
begin
  Result := False;
  if (hszApp = 0) or (DdeCmpStringHandles(hszApp, FHszApp) = 0)  then
  begin
    DdeQueryString(FDdeInstId, hszTopic, CharVal, 255, CP_WINANSI);
    Topic := StrPas(CharVal);
      { check topic name against available form names }
    SConv := GetServerConv(Topic);
    if SConv <> nil then
      Result := True
    else
    begin
      Form := GetForm(Topic);
      if Form <> nil then
        Result := True;
    end;
  end;
end;

function TDdeMgr.AllowWildConnect(hszApp: HSZ; hszTopic: HSZ): HDdeData;
var
  conns: array[0..1] of THSZPair;
begin
  Result := 0;
  if hszTopic = 0 then
    Exit;
  if AllowConnect(hszApp, hszTopic) = True then
  begin
    conns[0].hszSvc := FHszApp;
    conns[0].hszTopic := hszTopic;
    conns[1].hszSvc := 0;
    conns[1].hszTopic := 0;
    Result := DdeCreateDataHandle(ddeMgr.DdeInstId,
      @conns, 2 * sizeof(THSZPair), 0, 0, CF_TEXT, 0);
  end;
end;

function TDdeMgr.Connect(Conv: HConv; hszTopic: HSZ; SameInst: Boolean): Boolean;
var
  CharVal: array[0..255] of Char;
  Topic: string;
  DdeConv: TDdeSrvrConv;
begin
  DdeConv := TDdeSrvrConv.Create(Self);
  DdeQueryString(FDdeInstId, hszTopic, CharVal, 255, CP_WINANSI);
  Topic := StrPas(CharVal);
  DdeConv.Topic := Topic;
  DdeConv.FSConv := GetServerConv(Topic);
  if DdeConv.FSConv = nil then
    DdeConv.FForm := GetForm(Topic);
  DdeConv.FConv := Conv;   
  DdeSetUserHandle(Conv, QID_SYNC, LongInt(DdeConv));
  FConvs.Add(DdeConv);
  if DdeConv.FSConv <> nil then DdeConv.FSConv.Connect;
  Result := True;  
end;

procedure TDdeMgr.Disconnect(DdeSrvrConv: TComponent);
var
  DdeConv: TDdeSrvrConv;
begin
  DdeConv := TDdeSrvrConv(DdeSrvrConv);
  if DdeConv.FSConv <> nil then DdeConv.FSConv.Disconnect;
  if DdeConv.FConv <> 0 then DdeSetUserHandle(DdeConv.FConv, QID_SYNC, 0);
  DdeConv.FConv := 0;  { client disconnected first }
  FConvs.Remove(DdeConv);
  DdeConv.Free;
end;

function TDdeMgr.GetExeName: string;
var
  ExeName: array[0..255] of Char;
begin
  StrPCopy(ExeName, ParamStr(0));
  Result := StrPas(ExeName);
end;

function TDdeMgr.GetAppName: string;
begin
  Result := FAppName^;
end;

procedure TDdeMgr.SetAppName(const Name: string);
var
  AppNm: array[0..255] of Char;
  P: PChar;
begin
  ResetAppName;
    {remove path info from appname}
  StrPCopy(AppNm, Name);
  P := StrRScan(AppNm, '\');
  if P <> nil then StrCopy(AppNm, P + 1);
  P := StrScan(AppNm, '.');
  if P <> nil then P^ := #0;
  AssignStr (FAppName, StrPas(AppNm));
  StrPCopy(AppNm, AppName);
  FHszApp := DdeCreateStringHandle(FDdeInstId, AppNm, CP_WINANSI );
  DdeNameService(FDdeInstId, FHszApp, 0, DNS_REGISTER );
end;

procedure TDdeMgr.ResetAppName;
begin
  if FHszApp <> 0 then
  begin
    DdeNameService(FDdeInstId, FHszApp, 0, DNS_UNREGISTER );
    if FHszApp <> 0 then
    begin
      DdeFreeStringHandle(FDdeInstId, FHszApp);
      FHszApp := 0;
    end;
  end;
  FHszApp := 0;
end;

function TDdeMgr.GetServerConv(const Topic: string): TDdeServerConv;
var
  I: Integer;
  Temp: string;
  SConv: TDdeServerConv;
begin
  Result := nil;
  for I := 0 to FConvCtrls.Count - 1 do
  begin
    SConv := TDdeServerConv(FConvCtrls[I]);
    if AnsiCompareText(SConv.Name, Topic) = 0 then
    begin
      Result := SConv;
      Exit;
    end;
  end;
end;

function TDdeMgr.GetForm(const Topic: string): TForm;
var
  I: Integer;
  Temp: string;
  Form: TForm;
begin
  Result := nil;
  for I := 0 to Screen.FormCount - 1 do
  begin
    Form := TForm(Screen.Forms[I]);
    Temp := Form.Caption;
    if AnsiCompareText(Form.Caption, Topic) = 0 then
    begin
      Result := Form;
      Exit;
    end;
  end;
end;

function TDdeMgr.GetSrvrConv(const Topic: string ): TComponent;
var
  I: Integer;
  Conv: TDdeSrvrConv;
begin
  Result := nil;
  for I := 0 to FConvs.Count - 1 do
  begin
    Conv := FConvs[I];
    if AnsiCompareText(Conv.Topic, Topic) = 0 then
    begin
      Result := Conv;
      Exit;
    end;
  end;
end;

procedure TDdeMgr.PostDataChange(const Topic: string; Item: string);
var
  I: Integer;
  Conv: TDdeSrvrConv;
  Itm: TDdeSrvrItem;
begin
  Conv := TDdeSrvrConv(GetSrvrConv (Topic));
  If Conv <> nil then
  begin
     { as we support more formats, we may have multiple item objects
       for each conversation and the following only supports one }
    Itm := Conv.GetItem(Item);
    if Itm <> nil then
      Itm.PostDataChange;
  end;
end;

procedure TDdeMgr.InsertServerConv(SConv: TDdeServerConv);
begin
  FConvCtrls.Insert(FConvCtrls.Count, SConv);   {insert at end of list}
end;

procedure TDdeMgr.RemoveServerConv(SConv: TDdeServerConv);
begin
  FConvCtrls.Remove(SConv);
end;

procedure TDdeMgr.DoError;
var
  err: Integer;
  ErrStr: string;
begin
  err := DdeGetLastError(FDdeInstId);
  if (err = DMLERR_LOW_MEMORY)  or (err = DMLERR_MEMORY_ERROR) then
    ErrStr := FmtLoadStr(SDdeMemErr, [err])
  else if (err = DMLERR_NO_CONV_ESTABLISHED) then
    ErrStr := FmtLoadStr(SDdeConvErr, [err])
  else
    ErrStr := FmtLoadStr(SDdeErr, [err]);
  Raise EDdeError.Create(ErrStr);
end;


{ --------------------------------------------- }

constructor TDdeClientConv.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDdeService := NullStr;
  FDdeTopic := NullStr;
  FItems := TList.Create;
  FAppName := NullStr;
end;

destructor TDdeClientConv.Destroy;
begin
  CloseLink;   { if conversation going, we are done... }
  DisposeStr(FDdeService);
  DisposeStr(FDdeTopic);
  FItems.Free;
  DisposeStr (FAppName);
  inherited Destroy;
end;

procedure TDdeClientConv.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('LinkInfo', ReadLinkInfo, WriteLinkInfo,  
    not ((DdeService = '') and (DdeTopic = '')));
end;

procedure TDdeClientConv.Loaded;
begin
  inherited Loaded;
  if (Length (DdeService) <> 0) and (ConnectMode <> ddeManual) then
    ChangeLink(DdeService, DdeTopic, '');
end;

procedure TDdeClientConv.ReadLinkInfo (Reader: TReader);
var
  Value: String;
  Text: String;
  Temp: Integer;
begin
  Reader.ReadListBegin;
  while not Reader.EndOfList do 
  begin
    Value := Reader.ReadString;
    Temp := Pos(' ', Value);
    Text := Copy(Value, Temp + 1, Length (Value) - Temp);
    case Value[1] of
      'S':  {'Service'}
        begin
          SetService(Text); 
        end;
      'T':  {'Topic'}
        begin
          SetTopic(Text);
        end;
    end;
  end;
  Reader.ReadListEnd;
end;

procedure TDdeClientConv.WriteLinkInfo (Writer: TWriter);
var
  Value: String;
begin
  Writer.WriteListBegin;
  Value := DdeService;
  Value := Format ('Service %s', [Value]);
  Writer.WriteString (Value);
  Value := DdeTopic;
  Value := Format ('Topic %s', [Value]);
  Writer.WriteString (Value);   
  Writer.WriteListEnd;
end;

procedure TDdeClientConv.OnAttach(aCtrl: TDdeClientItem);
var
  ItemLnk: TDdeCliItem;
begin
  ItemLnk := TDdeCliItem.Create(Self);
  FItems.Insert(FItems.Count, ItemLnk);   {insert at end of list}
  ItemLnk.Control := aCtrl;
  ItemLnk.SetItem(EmptyStr);
end;

procedure TDdeClientConv.OnDetach(aCtrl: TDdeClientItem);
var
  ItemLnk: TDdeCliItem;
  I: Integer;
begin
  ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));
  if ItemLnk <> nil then
  begin
    ItemLnk.SetItem(EmptyStr);
    FItems.Remove(ItemLnk);
    ItemLnk.Free;
  end;
end;

function TDdeClientConv.OnSetItem(aCtrl: TDdeClientItem; const S: string): Boolean;
var
  ItemLnk: TDdeCliItem;
  I: Integer;
begin
  Result := True;
  ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));

  if (ItemLnk = nil) and (Length(S) > 0) then
  begin
    OnAttach (aCtrl);
    ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));
  end;

  if (ItemLnk <> nil) and (Length(S) = 0) then
  begin
    OnDetach (aCtrl);
  end
  else if ItemLnk <> nil then
  begin
    Result := ItemLnk.SetItem(S);
    if Not (Result) and Not (csLoading in ComponentState) then 
      OnDetach (aCtrl);  {error occurred, do cleanup}
  end;
end;

function TDdeClientConv.GetCliItemByCtrl(ACtrl: TDdeClientItem): TPersistent;
var
  ItemLnk: TDdeCliItem;
  i: word;
begin
  Result := nil;
  ItemLnk := nil;
  I := 0;
  while I < FItems.Count do
  begin
    ItemLnk := FItems[I];
    if ItemLnk.Control = aCtrl then
    begin
      Result := ItemLnk;
      Exit;
    end;
    inc(I);
  end;
end;

function TDdeClientConv.PasteLink: Boolean;
var
  Service, Topic, Item: String;
begin
  Result := False;
  if  GetPasteLinkInfo (Service, Topic, Item) = True  then
  begin
    Result := ChangeLink (Service, Topic, Item);
  end;
end;

function TDdeClientConv.ChangeLink(const App: string; const Topic: string; 
  const Item: string): Boolean;
begin
  Result := False;
  CloseLink;  { make sure to clean out the old first if needed}

  SetService(App);
  SetTopic(Topic);
  Result := OpenLink;
  if Not Result then
  begin
    SetService('');
    SetTopic('');
  end;
end;

function TDdeClientConv.OpenLink: Boolean;
var
  CharVal: array[0..255] of Char;
  ddeItemLnk: TDdeCliItem;
  Res: Boolean;
begin
  Result := False;
  if FConv <> 0 then Exit;

  if (Length(DdeService) = 0) and (Length(DdeTopic) = 0) then
  begin
    ClearItems;
    Exit;
  end;

   { DdeUninitialize bug (win3.1) - make sure ddeMgr is at end of application
     component list and therefore gets deleted (i.e DdeUninitialize) before 
     OleUninitialize }
  ddeMgr.ComponentIndex := Application.ComponentCount -1;    

  if FHszApp = 0 then
  begin
    StrPCopy(CharVal, DdeService);   
    FHszApp := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  end;
  if FHszTopic = 0 then
  begin
    StrPCopy(CharVal, DdeTopic);
    FHszTopic := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  end;
  
  Res := CreateDdeConv(FHszApp, FHszTopic);
  if Not Res then
  begin
    if Not ((Length(DdeService) = 0) and 
            (Length(ServiceApplication) = 0)) then
    begin
      if Length (ServiceApplication) <> 0 then
        StrPCopy(CharVal, ServiceApplication)
      else
        StrPCopy(CharVal, DdeService + ' ' + DdeTopic);  
      if WinExec(CharVal, SW_SHOWMINNOACTIVE) >= 32 then 
        Res := CreateDdeConv(FHszApp, FHszTopic);
    end;
  end;
  if Not Res then
  begin
    ClearItems;
    Exit;
  end;

  FDdeFmt := FCnvInfo.wFmt;
  if StartAdvise = False then Exit;
  Open;
  DataChange(0, 0);
  Result := True;
end;

procedure TDdeClientConv.CloseLink;
var
  OldConv: HConv;
begin
  if FConv <> 0 then  {ensure that handles are freed}
  begin
    OldConv := FConv;
    SrvrDisconnect;  {turn off link objects}
    FConv := 0;
    DdeSetUserHandle(OldConv, QID_SYNC, 0);
    DdeDisconnect(OldConv);
  end;

  if FHszApp <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, FHszApp);
    FHszApp := 0;
  end;
  
  if FHszTopic <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, FHszTopic);
    FHszTopic := 0;
  end;
  SetService('');
  SetTopic('');
end;

procedure TDdeClientConv.ClearItems;
var
  ItemLnk: TDdeCliItem;
  i: word;
begin
  if FItems.Count = 0 then Exit;

  for I := 0 to FItems.Count - 1 do
  begin
    ItemLnk := TDdeCliItem(FItems [0]);
    ItemLnk.Control.DdeItem := EmptyStr;
  end;
end;

function TDdeClientConv.CreateDdeConv(FHszApp: HSZ; FHszTopic: HSZ): Boolean;
var
   cnvContxt: TConvContext;
begin
   Result := False;
   cnvContxt.cb := sizeof(TConvConText);
   cnvContxt.wFlags := 0;
   cnvContxt.wCountryID := 0;
   cnvContxt.iCodePage := 0;
   cnvContxt.dwLangID := 0;
   cnvContxt.dwSecurity := 0;
   
   FConv := DdeConnect(ddeMgr.DdeInstId, FHszApp, FHszTopic, @cnvContxt);
   if FConv = 0 then
     Exit;   { unable to connect, try initializing the app first }

   FCnvInfo.cb := sizeof(TConvInfo);
   DdeQueryConvInfo(FConv, QID_SYNC, @FCnvInfo);
   DdeSetUserHandle(FConv, QID_SYNC, LongInt(Self));
   Result := True;
end;

function TDdeClientConv.StartAdvise: Boolean;
var
  ItemLnk: TDdeCliItem;
  i: word;
begin
  Result := False;
  if FConv = 0 then Exit;

  i := 0;
  while i < FItems.Count do
  begin
    ItemLnk := TDdeCliItem(FItems [i]);
    if Not ItemLnk.StartAdvise then
    begin
       { link has been changed and these items are legacy items 
         from a previous link.  Remove them.  Set Ctrl prop will
         delete the link and storage }
      ItemLnk.Control.DdeItem := EmptyStr;
    end
    else
      Inc(i);

    if i >= FItems.Count then
      break;
  end;
  Result := True;
end;

function TDdeClientConv.ExecuteMacroLines(Cmd: TStrings; waitFlg: Boolean): Boolean;
var
  Ptr: PChar;
begin
  Result := False;
  if (FConv = 0) or FWaitStat then Exit;
  try
    Ptr := Cmd.GetText;
    Result := ExecuteMacro(Ptr, waitFlg);
  finally
    StrDispose (Ptr);
  end;
end;

function TDdeClientConv.ExecuteMacro(Cmd: PChar; waitFlg: Boolean): Boolean;
var
  hszCmd: HDDEData;
  hdata: HDDEData;
  ddeRslt: LongInt;
  Ptr: PChar;
begin
  Result := False;
  if (FConv = 0) or FWaitStat then Exit;
  hszCmd := DdeCreateDataHandle(ddeMgr.DdeInstId, Cmd, StrLen(Cmd) + 1,
    0, 0, FDdeFmt, 0);
  if hszCmd = 0 then Exit;
  if waitFlg = True then FWaitStat := True;
  hdata := DdeClientTransaction(Pointer(hszCmd)  {addr of data},
     -1 {length of data}, FConv, 0 {hszItem}, FDdeFmt,
     XTYP_EXECUTE, TIMEOUT_ASYNC  {DFLT_DDE_TIMEOUT},  @ddeRslt);
  if hdata = 0 then FWaitStat := False
  else Result := True;
end;

function TDdeClientConv.PokeDataLines(const Item: string; Data: TStrings): Boolean;
var
  Ptr: PChar;
begin
  Result := False;
  if (FConv = 0) or FWaitStat then Exit;
  try
    Ptr := Data.GetText;
    Result := PokeData(Item, Ptr);
  finally
    StrDispose (Ptr);
  end;
end;

function TDdeClientConv.PokeData(const Item: string; Data: PChar): Boolean;
var
  hszDat: HDDEData;
  hdata: HDDEData;
  ddeRslt: LongInt;
  hszItem: HSZ;
  CharVal: array[0..255] of Char;
begin
  Result := False;
  if (FConv = 0) or FWaitStat then Exit;
  StrPCopy(CharVal, Item);
  hszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  if hszItem = 0 then Exit;
  hszDat := DdeCreateDataHandle (ddeMgr.DdeInstId, Data, StrLen(Data) + 1,
    0, hszItem, FDdeFmt, 0);
  if hszDat <> 0 then
  begin
    hdata := DdeClientTransaction(Pointer(hszDat)  {addr of data},
      -1 {length of data}, FConv, hszItem, FDdeFmt,
      XTYP_POKE, 1000, @ddeRslt);
    if hdata <> 0 then Result := True;
  end;
  DdeFreeStringHandle (ddeMgr.DdeInstId, hszItem);
end;

function TDdeClientConv.RequestData(const Item: string): PChar;
var
  hdata: HDDEData;
  ddeRslt: LongInt;
  hszItem: HSZ;
  CharVal: array[0..255] of Char;
  pData: Pointer;
  len: Longint;
begin
  Result := nil;
  if (FConv = 0) or FWaitStat then Exit;
  StrPCopy(CharVal, Item);
  hszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);

  hdata := DdeClientTransaction(nil  {addr of data},
      -1  {length of data}, FConv, hszItem, FDdeFmt,
      XTYP_REQUEST, 1000, @ddeRslt);
  DdeFreeStringHandle (ddeMgr.DdeInstId, hszItem);
  if hdata = 0 then Exit;

  try
    pData := DdeAccessData (hdata, @len);
    if pData <> nil then
    begin
      try
        Result := StrAlloc (StrLen (PData) + 1);
        StrCopy (Result, pData);
      finally
        DdeUnaccessData(hdata);
      end;
    end;
  finally
    DdeFreeDataHandle (hdata);
  end;
end;

function TDdeClientConv.GetCliItemByName(const ItemName: string): TPersistent;
var
  ItemLnk: TDdeCliItem;
  i: word;
begin
  Result := nil;
  i := 0;
  while i < FItems.Count do
  begin
    ItemLnk := TDdeCliItem(FItems [i]);
    if ItemLnk.Item = ItemName then
    begin
      Result := ItemLnk;
      Exit;
    end;
    inc(i);
  end;
end;

procedure TDdeClientConv.XactComplete;
begin
   FWaitStat := False;
end;

procedure TDdeClientConv.SrvrDisconnect;
var
  ItemLnk: TDdeCliItem;
  i: word;
begin
  if FConv <> 0 then Close;
  FConv := 0;
  i := 0;
  while i < FItems.Count do
  begin
    ItemLnk := TDdeCliItem(FItems [i]);
    ItemLnk.SrvrDisconnect;
    inc(i);
  end;
end;

procedure TDdeClientConv.DataChange(DdeDat: HDDEData; hszIt: HSZ);
var
  ItemLnk: TDdeCliItem;
  i: word;
begin
  i := 0;
  while i < FItems.Count do
  begin
    ItemLnk := TDdeCliItem(FItems [i]);
    if (hszIt = 0) or (ItemLnk.HszItem = hszIt) then
    begin
        { data has changed and we found a link that might be interested }
      ItemLnk.StoreData(DdeDat);
    end;
    inc(i);
  end;
end;

function TDdeClientConv.SetLink(const Service: string; const Topic: string): Boolean;
begin
  CloseLink;  { make sure to clean out the old first if needed}
  if FConnectMode = ddeAutomatic then
  begin
    Result := ChangeLink(Service, Topic, '');
  end
  else
  begin
    SetService(Service);
    SetTopic(Topic);
    DataChange(0,0);
    Result := True;
  end;
end;

procedure TDdeClientConv.SetConnectMode(NewMode: TDataMode);
begin
  if FConnectMode <> NewMode then
  begin
    if (NewMode = ddeAutomatic) and (Length(DdeService) <> 0) and 
        (Length(DdeTopic) <> 0) and not OpenLink then
      raise Exception.Create(LoadStr(SDdeNoConnect));
    FConnectMode := NewMode;
  end;
end;

procedure TDdeClientConv.SetFormatChars(NewFmt: Boolean);
begin
  if FFormatChars <> NewFmt then
  begin
    FFormatChars := NewFmt;
    if FConv <> 0 then
      DataChange(0, 0);   { update the data }
  end;
end;

function TDdeClientConv.GetDdeService: string;
begin
  Result := FDdeService^;
end;

function TDdeClientConv.GetDdeTopic: string;
begin
  Result := FDdeTopic^;
end;

procedure TDdeClientConv.SetDdeService (const Value: String); 
begin
end;

procedure TDdeClientConv.SetDdeTopic (const Value: String); 
begin
end;

procedure TDdeClientConv.SetService (const Value: String); 
begin
  AssignStr(FDdeService, Value);
end;

procedure TDdeClientConv.SetTopic (const Value: String); 
begin
  AssignStr(FDdeTopic, Value);
end;

function TDdeClientConv.GetServiceApp: string; 
begin
  Result := FAppName^;
end;

procedure TDdeClientConv.SetServiceApp(const S: string); 
begin
  AssignStr(FAppName, S);
end;

procedure TDdeClientConv.Close;
begin
  if Assigned(FOnClose) then FOnClose(Self);
end;

procedure TDdeClientConv.Open;
begin
  if Assigned(FOnOpen) then FOnOpen(Self);
end;

procedure TDdeClientConv.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  ItemLnk: TDdeCliItem;
  i: word;
begin
  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) and (FItems <> nil) then
  begin
    i := 0;
    while i < FItems.Count do
    begin
      ItemLnk := TDdeCliItem(FItems [i]);
      if (AComponent = ItemLnk.Control) then
        ItemLnk.Control.DdeItem := EmptyStr;
      if i >= FItems.Count then
        break;
      Inc (I);
    end;
  end;
end;

{ --------------------------------------------- }

constructor TDdeClientItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDdeClientItem := NullStr;
  FLines := TStringList.Create;
end;

destructor TDdeClientItem.Destroy;
begin
  DisposeStr (FDdeClientItem);
  FLines.Free;
  inherited Destroy;
end;

procedure TDdeClientItem.SetDdeClientConv(Val: TDdeClientConv);
var
  OldItem: string;
begin
  if Val <> FDdeClientConv then
  begin
    OldItem := DdeItem;
    AssignStr (FDdeClientItem, '');
    if FDdeClientConv <> nil then 
      FDdeClientConv.OnDetach (Self);

    FDdeClientConv := Val;
    if (FDdeClientConv <> nil) and (Length(OldItem) <> 0) then 
      SetDdeClientItem (OldItem);
  end;
end;

function TDdeClientItem.GetDdeClientItem: string;
begin
  Result := FDdeClientItem^;
end;

procedure TDdeClientItem.SetDdeClientItem(const Val: string);
begin
  if FDdeClientConv <> nil then
  begin
    AssignStr (FDdeClientItem, Val);
    if Not FDdeClientConv.OnSetItem (Self, Val) then
    begin
      if Not (csLoading in ComponentState) or
          not ((FDdeClientConv.FConv = 0) and
          (FDdeClientConv.ConnectMode = ddeManual)) then
        AssignStr (FDdeClientItem, '');
    end;
  end
  else if (csLoading in ComponentState) then
    AssignStr (FDdeClientItem, Val);
end;

procedure TDdeClientItem.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FDdeClientConv) then
  begin
    FDdeClientConv.OnDetach (Self);
    FDdeClientConv := nil;
    AssignStr (FDdeClientItem, '');
  end;
end;

procedure TDdeClientItem.OnAdvise;
begin
  if csDesigning in ComponentState then
  begin
    if Owner.InheritsFrom (TForm) and (TForm(Owner).Designer <> nil) then
      TForm(Owner).Designer.Modified;
  end;
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TDdeClientItem.GetText: String;
begin
  if FLines.Count > 0 then
    Result := FLines.Strings[0]
  else Result := '';
end;

procedure TDdeClientItem.SetText(const S: String);
begin
end;

procedure TDdeClientItem.SetLines(L: TStrings);
begin
end;

{------------------------------------------}

constructor TDdeCliItem.Create(ADS: TDdeClientConv);
begin
  FItem := NullStr;
  FHszItem := 0;
  FCliConv := ADS;
end;

destructor TDdeCliItem.Destroy;
begin
  StopAdvise;
  DisposeStr (FItem);
  inherited Destroy;
end;

function TDdeCliItem.GetItem: string;
begin
  Result := FItem^;
end;

function TDdeCliItem.SetItem(const S: string): Boolean;
var
  OldItem: String;
begin
  Result := False;
  OldItem := Item;
  if FHszItem <> 0 then StopAdvise;

  AssignStr (FItem, S);
  FCtrl.Lines.Clear;

  if (Length(Item) <> 0) then
  begin
    if (FCliConv.Conv <> 0) then
    begin
      Result := StartAdvise;
      if Not Result then
        AssignStr (FItem, EmptyStr);
    end
    else if FCliConv.ConnectMode = ddeManual then Result := True;
  end;
  RefreshData;
end;

procedure TDdeCliItem.StoreData(DdeDat: HDDEData);
var
  len: Longint;
  pData: Pointer;
  ptr: PChar;
  I: Integer;
begin
  if DdeDat = 0 then
  begin
    RefreshData;
    Exit;
  end;

  pData := AccessData(DdeDat, @len);
  if pData <> nil then
  begin
    FCtrl.Lines.SetText(pData);
    ReleaseData(DdeDat);

     { for now remove tabs and carriage returns, will probably want to deal
       with them better, later..... }
    if FCliConv.FormatChars = False then
    begin
      pData := FCtrl.Lines.GetText;
      ptr := pData;
      for I := 0 to StrLen(pData) do
      begin
        if (ptr^ > #0) and (ptr^ < ' ') then
          ptr^ := ' ';
        Inc (ptr);
      end;
      FCtrl.Lines.SetText(pData);
      StrDispose (pData);
    end;
  end;
  DataChange;
end;

function TDdeCliItem.RefreshData: Boolean;
var
  ddeRslt: LongInt;
  DdeDat: HDDEData;
begin
  Result := False;
  if (FCliConv.Conv <> 0) and (FHszItem <> 0) then
  begin
    if FCliConv.WaitStat = True then
    begin
        {   clever error handling goes here }
      Exit;
    end;

    DdeDat := DdeClientTransaction(nil  {addr of data}, -1  {length of data},
      FCliConv.Conv, FHszItem, FCliConv.DdeFmt, XTYP_REQUEST, 1000, @ddeRslt);
    if DdeDat = 0 then Exit
    else
    begin
      StoreData(DdeDat);
      DdeFreeDataHandle(DdeDat);
      Result := True;
      Exit;   {skip data change, done in StoreData}
    end;
  end;
  DataChange;
end;

function TDdeCliItem.AccessData(DdeDat: HDDEData; pDataLen: PLongint): Pointer;
begin
  Result := DdeAccessData(DdeDat, pDataLen);
end;

procedure TDdeCliItem.ReleaseData(DdeDat: HDDEData);
begin
  DdeUnaccessData(DdeDat);
end;

function TDdeCliItem.StartAdvise: Boolean;
var
  ddeRslt: LongInt;
  hdata: HDDEData;
  err: Integer;
  CharVal: array[0..255] of Char;
begin
  Result := False;
  if FCliConv.Conv = 0 then Exit;
  if Length(Item) = 0  then Exit;
  if FHszItem = 0  then
  begin
    StrPCopy(CharVal, Item);
    FHszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  end;

     { this sets up a "hot" advise loop.  We may also want to allow "warm" }
  hdata := DdeClientTransaction(nil {addr of data}, -1 {length of data},
    FCliConv.Conv, FHszItem, FCliConv.DdeFmt, XTYP_ADVSTART or XTYPF_NODATA,  
    1000, @ddeRslt);
  if hdata = 0 then
  begin
    err := DdeGetLastError(ddeMgr.DdeInstId);
    DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
    FHszItem := 0;
    FCtrl.Lines.Clear;
  end
  else
    Result := True;
end;

function TDdeCliItem.StopAdvise: Boolean;
var
  ddeRslt: LongInt;
  hdata: HDDEData;
begin
  Result := False;
  if FCliConv.Conv <> 0 then
  begin
    if FHszItem <> 0  then
    begin
      hdata := DdeClientTransaction(nil {addr of data}, -1 {length of data},
        FCliConv.Conv, FHszItem, FCliConv.DdeFmt, XTYP_ADVSTOP,
        1000, @ddeRslt);
    end;
  end;

  SrvrDisconnect;
  Result := True;
end;

procedure TDdeCliItem.SrvrDisconnect;
begin
  if FHszItem <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
    FHszItem := 0;
  end;
end;

procedure TDdeCliItem.DataChange;
begin
  FCtrl.OnAdvise;
end;

{ --------------------------------------------- }

constructor TDdeServerItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFmt := CF_TEXT;
  FLines := TStringList.Create;
end;

destructor TDdeServerItem.Destroy;
begin
  FLines.Free;
  inherited Destroy;
end;

procedure TDdeServerItem.SetServerConv(SConv: TDdeServerConv);
begin
  FServerConv := SConv;
   { will want to check if existing conv going and terminate it}
end;

function TDdeServerItem.GetText: string; 
begin
  Result := '';
  if FLines.Count > 0 then
    Result := FLines.Strings[0];
end;

procedure TDdeServerItem.SetText(const Item: string);
begin
  FFmt := CF_TEXT;
  FLines.Clear;
  FLines.Add(Item);
  ValueChanged;
end;

procedure TDdeServerItem.SetLines(Value: TStrings);
var
  Ptr1, Ptr2: pChar;
  Changed: Integer;
begin
  try
    Ptr1 := Value.GetText;
    Ptr2 := FLines.GetText;
    Changed := StrComp (Ptr1, Ptr2);
  finally
    StrDispose (Ptr1);
    StrDispose (Ptr2);
  end;
  if Changed <> 0 then
  begin
    FFmt := CF_TEXT;
    FLines.Assign(Value);
    ValueChanged;
  end;
end;

procedure TDdeServerItem.ValueChanged;
begin
  if Assigned(FOnChange) then FOnChange(Self);
  if FServerConv <> nil then
    ddeMgr.PostDataChange(FServerConv.Name, Name)
  else if (Owner <> nil) and (Owner is TForm) then
    ddeMgr.PostDataChange(TForm(Owner).Caption, Name);
end;

function TDdeServerItem.PokeData(Data: HDdeData): LongInt;
var
  len: Longint;
  pData: Pointer;
begin
  Result := dde_FNotProcessed;
  pData := DdeAccessData(Data, @len);
  if pData <> nil then
  begin
    Lines.SetText(pData);
    DdeUnaccessData(Data);
    ValueChanged;
    if Assigned(FOnPokeData) then FOnPokeData(Self);
    Result := dde_FAck;
  end;
end;

procedure TDdeServerItem.CopyToClipboard;
var
  Data: THandle;
  LinkData: string;
  DataPtr: Pointer;
begin
  if FServerConv <> nil then
    LinkData := ddeMgr.AppName + #0 + FServerConv.Name + #0 + Name
  else if (Owner =nil) then
    Exit
  else if Owner is TForm then
    LinkData := ddeMgr.AppName + #0 + TForm(Owner).Caption + #0 + Name;

  try
    Clipboard.AsText := Text;
    Data := GlobalAlloc(GMEM_MOVEABLE, Length(LinkData) + 1);
    try
      DataPtr := GlobalLock(Data);
      try
        StrPCopy(DataPtr, LinkData);
        Clipboard.SetAsHandle(DdeMgr.LinkClipFmt, Data);
      finally
        GlobalUnlock(Data);
      end;
    except
      GlobalFree(Data);
      raise;
    end;
  finally
    Clipboard.Close;
  end;
end;

procedure TDdeServerItem.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TDdeServerItem.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FServerConv) and (Operation = opRemove) then
    FServerConv := nil;
end;

{ --------------------------------------------- }

constructor TDdeServerConv.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ddeMgr.InsertServerConv (Self);
end;

destructor TDdeServerConv.Destroy;
begin
  inherited Destroy;
  ddeMgr.RemoveServerConv (Self);
end;

function TDdeServerConv.ExecuteMacro(Data: HDdeData): LongInt;
var
  len: Longint;
  pData: Pointer;
  MacroLines: TStringList;
begin
  Result := dde_FNotProcessed;
  pData := DdeAccessData(Data, @len);
  if pData <> nil then
  begin
    if Assigned(FOnExecuteMacro) then
    begin
      MacroLines := TStringList.Create;
      MacroLines.SetText(pData);
      FOnExecuteMacro(Self, MacroLines);   { probably want to pass error code }
      MacroLines.Destroy;
    end;
    Result := dde_FAck;
  end;
end;

procedure TDdeServerConv.Connect;
begin
  if Assigned(FOnOpen) then FOnOpen(Self);
end;

procedure TDdeServerConv.Disconnect;
begin
  if Assigned(FOnClose) then FOnClose(Self);
end;

{------------------------------------------}

constructor TDdeSrvrConv.Create(AOwner: TComponent);
begin
  FItems := TList.Create;
  inherited Create(AOwner);
end;

destructor TDdeSrvrConv.Destroy;
var
  I: Integer;
begin
    {if client did not already disconnect, this will tell him}
  if FItems <> nil then
  begin
    for I := 0 to FItems.Count - 1 do
    begin
      TDdeSrvrItem(FItems[I]).Free;
    end;
    FItems.Free;
  end;

  if FConv <> 0 then
    DdeDisconnect(FConv);

  if FHszTopic <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, FHszTopic);
    FHszTopic := 0;
  end;
  inherited Destroy;
end;

function TDdeSrvrConv.AdvStart(Conv: HConv; hszTopic: HSZ; hszItem :HSZ; Fmt: Word): Boolean;
var
  dat: string;
  CharVal: array[0..255] of Char;
  Srvr: TDdeServerItem;
  Item: string;
  SrvrItem: TDdeSrvrItem;
begin
  Result := False;
  if Fmt <> CF_TEXT then
    Exit;

  DdeQueryString(ddeMgr.DdeInstId, hszItem, CharVal, 255, CP_WINANSI);
  Item := StrPas(CharVal);

  Srvr := GetControl(FForm, FSConv, Item);
  if Srvr = nil then Exit;

  SrvrItem := TDdeSrvrItem.Create(Self);
  SrvrItem.Srvr := Srvr;
  SrvrItem.Item := Item;
  FItems.Add(SrvrItem);

  if FHszTopic = 0 then
  begin
    StrPCopy(CharVal, Topic);
    FHszTopic := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  end;

  Result := True;

end;

procedure TDdeSrvrConv.AdvStop(Conv: HConv; hszTopic: HSZ; hszItem :HSZ);
var
  dat: string;
  CharVal: array[0..255] of Char;
  SrvrItem: TDdeSrvrItem;
begin
  SrvrItem := GetSrvrItem(hszItem);
  if SrvrItem <> nil then
  begin
    FItems.Remove(SrvrItem);
    SrvrItem.Free;
  end;
end;

function TDdeSrvrConv.PokeData(Conv: HConv; hszTopic: HSZ; hszItem :HSZ;
  Data: HDdeData; Fmt: Integer): LongInt;
var
  Srvr: TDdeServerItem;
  CharVal: array[0..255] of Char;
begin
  Result := dde_FNotProcessed;
  if Fmt <> CF_TEXT then
    Exit;

  DdeQueryString(ddeMgr.DdeInstId, hszItem, CharVal, 255, CP_WINANSI);
  Srvr := GetControl(FForm, FSConv, StrPas(CharVal) );
  if Srvr <> nil then
  begin
    Result := Srvr.PokeData(Data);
  end;
end;

function TDdeSrvrConv.ExecuteMacro(Conv: HConv;  hszTopic: HSZ;
  Data: HDdeData): Integer;
begin
  Result := dde_FNotProcessed;
  if (FSConv <> nil)  then
    Result := FSConv.ExecuteMacro (Data);
end;

function TDdeSrvrConv.RequestData(Conv: HConv;
  hszTopic: HSZ; hszItem :HSZ; Fmt: Word): HDdeData;
var
  dat: string;
  CharVal: array[0..255] of Char;
  SrvrIt: TDdeSrvrItem;
  Srvr: TDdeServerItem;
  Ptr: PChar;
begin
  Result := 0;

    { if part of an advise loop, let the advise loop handle, else
      attempt to send the appropriate data  }
  SrvrIt := GetSrvrItem(hszItem);
  if SrvrIt <> nil then
  begin
    Result := SrvrIt.RequestData(Fmt);
  end
  else
  begin
    dat := '';
    DdeQueryString(ddeMgr.DdeInstId, hszItem, CharVal, 255, CP_WINANSI);
    Srvr := GetControl(FForm, FSConv, StrPas(CharVal) );
    if Srvr <> nil then
    begin
      if Fmt = CF_TEXT then
      begin
        Ptr := Srvr.Lines.GetText;
        Result := DdeCreateDataHandle(ddeMgr.DdeInstId, Ptr, StrLen(Ptr) + 1,
          0, hszItem, Fmt, 0 );
        StrDispose (Ptr);
      end;
    end;
  end;
end;


    {remove from object to enable AllowConnect to only connect to forms
     that have dde server object inside}
function TDdeSrvrConv.GetControl(WinCtrl: TWinControl; DdeConv: TDdeServerConv; const ItemName: string): TDdeServerItem;
var
  I: Integer;
  Ctrl: TComponent;
  MainCtrl: TWinControl;
  Srvr: TDdeServerItem;
begin
  Result := nil;
  MainCtrl := WinCtrl;
  if MainCtrl = nil then
  begin
    if (DdeConv <> nil) and (DdeConv.Owner <> nil) and 
        (DdeConv.Owner is TForm) then
      MainCtrl := TWinControl (DdeConv.Owner);
  end;
  if MainCtrl = nil then
    Exit;

  for I := 0 to MainCtrl.ComponentCount - 1 do
  begin
    Ctrl := MainCtrl.Components[I];
    if Ctrl is TDdeServerItem then
    begin
      if (Ctrl.Name = ItemName) and 
         (TDdeServerItem(Ctrl).ServerConv = DdeConv) then
      begin
        Result := TDdeServerItem(Ctrl);
        Exit;
      end;
    end;
    if Ctrl is TWinControl then
    begin
      Srvr := GetControl(TWinControl(Ctrl), DdeConv, ItemName);
      if Srvr <> nil then
      begin
        Result := Srvr;
        Exit;
      end;
    end;
  end;
end;

function TDdeSrvrConv.GetItem(const ItemName: string): TDdeSrvrItem;
var
  I: Integer;
  Item: TDdeSrvrItem;
begin
  Result := nil;
  for I := 0 to FItems.Count - 1 do
  begin
    Item := FItems[I];
    If Item.Item = ItemName then
    begin
      Result := Item;
      Exit;
    end;
  end;
end;

function TDdeSrvrConv.GetSrvrItem(hszItem: HSZ): TDdeSrvrItem;
var
  I: Integer;
  Item: TDdeSrvrItem;
begin
  Result := nil;
  for I := 0 to FItems.Count - 1 do
  begin
    Item := FItems[I];
    If DdeCmpStringHandles(Item.HszItem, hszItem) = 0 then
    begin
      Result := Item;
      Exit;
    end;
  end;
end;

{ --------------------------------------------- }

constructor TDdeSrvrItem.Create(AOwner: TComponent);
begin
  FConv := TDdeSrvrConv(AOwner);
  FItem := NullStr;
  inherited Create(AOwner);
end;

destructor TDdeSrvrItem.Destroy;
begin
  if FHszItem <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
    FHszItem := 0;
  end;
  DisposeStr (FItem);
  inherited Destroy;
end;

function TDdeSrvrItem.RequestData(Fmt: Word): HDdeData;
var
  dat: string;
  CharVal: array[0..255] of Char;
  Ptr: PChar;
begin
  Result := 0;
  dat := '';
  DdeQueryString(ddeMgr.DdeInstId, FHszItem, CharVal, 255, CP_WINANSI);
  Item := StrPas(CharVal);
  if Fmt = CF_TEXT then
  begin
    Ptr := FSrvr.Lines.GetText;
    Result := DdeCreateDataHandle(ddeMgr.DdeInstId, Ptr, StrLen(Ptr) + 1, 
      0, FHszItem, Fmt, 0 );
    StrDispose (Ptr);
  end;
end;

procedure TDdeSrvrItem.PostDataChange;
begin
  DdePostAdvise(ddeMgr.DdeInstId, FConv.HszTopic, FHszItem);
end;

procedure TDdeSrvrItem.SetItem(const Value: string);
var
  CharVal: array[0..255] of Char;
begin
  AssignStr (FItem, Value);
  if FHszItem <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
    FHszItem := 0;
  end;
  if Length(Item) > 0 then
  begin
    StrPCopy(CharVal, Item);
    FHszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  end;
end;

function TDdeSrvrItem.GetItem: string;
begin
  Result := FItem^;
end;

begin
  ddeMgr := TDdeMgr.Create(Application);
end.
