{ *********************************************************************** }
{                                                                         }
{ Delphi Visual Component Library                                         }
{                                                                         }
{ Copyright (c) 1995-2004 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

unit Borland.Vcl.DdeMan platform;

{$R-,T-,H+,X+}

interface

uses
  Windows, DDEml, Classes, Forms, Controls,
  System.Collections, System.ComponentModel.Design.Serialization;

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

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

  TDdeClientItem = class;

  TFinalizeHConvNotify = procedure(Handle: HConv) of object;
  TFinalizeDDENotify = procedure(InstID: Longint) of object;

{ TDdeClientConv }

  [RootDesignerSerializerAttribute('', '', False)]
  TDdeClientConv = class(TComponent)
  private
    FDdeService: string;
    FDdeTopic: string;
    FConv: TObject;
    FCnvInfo: TConvInfo;
    FItems: TList;
    FHszApp: TObject;
    FHszTopic: TObject;
    FDdeFmt: Integer;
    FOnClose: TNotifyEvent;
    FOnOpen: TNotifyEvent;
    FAppName: string;
    FDataMode: TDataMode;
    FConnectMode: TDataMode;
    FWaitStat: Boolean;
    FFormatChars: Boolean;
    function GetConv: HConv;
    function get_HszApp: Hsz;
    function get_HszTopic: Hsz;
    procedure SetConv(const Value: HConv);
    procedure SetDdeService(const Value: string);
    procedure SetDdeTopic(const Value: string);
    procedure set_HszApp(const Value: Hsz);
    procedure set_HszTopic(const Value: Hsz);
    procedure SetService(const Value: string);
    procedure SetTopic(const Value: string);
    procedure SetConnectMode(NewMode: TDataMode);
    procedure SetFormatChars(NewFmt: Boolean);
    procedure XactComplete;
    procedure SrvrDisconnect;
    procedure DataChange(DdeDat: HDDEData; hszIt: HSZ);
    property HszApp: Hsz read get_HszApp write set_HszApp;
    property HszTopic: Hsz read get_HszTopic write set_HszTopic;
  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, Topic, 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, Topic: string): Boolean;
    procedure CloseLink;
    function StartAdvise: Boolean;
    function PokeDataLines(const Item: string; Data: TStrings): Boolean;
    function PokeData(const Item: string; Data: string): Boolean; overload;
    function PokeData(const Item: string; Data: IntPtr; Len: Integer): Boolean; overload;
    function ExecuteMacroLines(Cmd: TStrings; waitFlg: Boolean): Boolean;
    function ExecuteMacro(Cmd: string; waitFlg: Boolean): Boolean; overload;
    function ExecuteMacro(Cmd: IntPtr; Len: Integer; waitFlg: Boolean): Boolean; overload;
    function RequestData(const Item: string): TBytes;
    property DdeFmt: Integer read FDdeFmt;
    property WaitStat: Boolean read FWaitStat;
    property Conv: HConv read GetConv;
    property DataMode: TDataMode read FDataMode write FDataMode;
  published
    property ServiceApplication: string read FAppName write FAppName;
    property DdeService: string read FDdeService write SetDdeService;
    property DdeTopic: string read FDdeTopic 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 }

  [RootDesignerSerializerAttribute('', '', False)]
  TDdeClientItem = class(TComponent)
  private
    FLines: TStrings;
    FDdeClientConv: TDdeClientConv;
    FDdeClientItem: string;
    FOnChange: TNotifyEvent;
    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 FDdeClientItem write SetDdeClientItem;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

{ TDdeServerConv }

  [RootDesignerSerializerAttribute('', '', False)]
  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 }

  [RootDesignerSerializerAttribute('', '', False)]
  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;

  { TDdeResources }

  TDdeResources = class
  private
    FInstance: Longint; // DDE Instance handle
    FAppName: HSZ; // DDE application name
    FStrings: TList; // string handles for topic names and server items
    FConvHandles: TList; // conversation handles
    FCliItems: TList; // string handles for client items
  strict protected
    procedure Finalize; override;
    procedure FreeResources;
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TDdeMgr }

  [RootDesignerSerializerAttribute('', '', False)]
  TDdeMgr = class(TComponent)
  private
    FResources: TDdeResources;
    FAppName: string;
    FConvs: TList;
    FConvHashTable: System.Collections.HashTable;
    FCliConvs: TList;
    FCliConvHashTable: System.Collections.HashTable;
    FConvCtrls: TList;
    FLinkClipFmt: Word;
    FCallback: DDEml.TFNCallback;
    function DdeMgrCallBack(CallType, Fmt : UINT; Conv: HConv; hsz1, hsz2: HSZ;
      Data: HDDEData; Data1, Data2: DWORD): HDDEData;
    procedure Disconnect(DdeSrvrConv: TComponent);
    function GetDdeInstId: LongInt;
    function get_HszApp: Hsz;
    function GetSrvrConv(const Topic: string ): TComponent;
    function AllowConnect(AhszApp: HSZ; AhszTopic: HSZ): Boolean;
    function AllowWildConnect(AhszApp: HSZ; AhszTopic: HSZ): HDdeData;
    function Connect(Conv: HConv; AhszTopic: HSZ; SameInst: Boolean): Boolean;
    procedure PostDataChange(const Topic: string; Item: string);
    procedure SetDdeInstId(const ID: LongInt);
    procedure SetAppName(const Name: string);
    procedure set_HszApp(const Value: Hsz);
    procedure ResetAppName;
    function  GetServerConv(const Topic: string): TDdeServerConv;
    procedure InsertServerConv(SConv: TDdeServerConv);
    procedure RemoveServerConv(SConv: TDdeServerConv);
//    procedure DoError;
    function  GetForm(const Topic: string): TForm;
    property HszApp: Hsz read get_HszApp write set_HszApp;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetExeName: string; deprecated;
    property DdeInstId: LongInt read GetDdeInstId write SetDdeInstId;
    property AppName: string read FAppName 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,
  System.Runtime.InteropServices, System.Text;

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

{ TDdeSrvrItem }

  TDdeSrvrItem = class(TComponent)
  private
    FConv: TDdeSrvrConv;
    FItem: string;
    FHszItem: TObject;
    FSrvr: TDdeServerItem;
    function GetHszItem: HSZ;
    procedure SetHszItem(const Value: HSZ);
  protected
    procedure SetItem(const Value: 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 FItem write SetItem;
    property Srvr: TDdeServerItem read FSrvr write FSrvr;
    property HszItem: HSZ read GetHszItem;
  end;

{ TDdeSrvrConv }

  TDdeSrvrConv = class(TComponent)
  private
    FTopic: string;
    FHszTopic: TObject;
    FForm: TForm;
    FSConv: TDdeServerConv;
    FConv: TObject;
//    FCnvInfo: TConvInfo;
//    FDdeFmt: Integer;
    FItems: TList;
    function GetConv: HConv;
    procedure SetConv(const Value: HConv);
    function GetHszTopic: HSZ;
    procedure SetHszTopic(const Value: HSZ);
  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; AhszTopic: HSZ; hszItem: HSZ;
      Fmt: Word): HDdeData;
    function AdvStart(Conv: HConv; AhszTopic: HSZ; AhszItem: HSZ;
      Fmt: Word): Boolean;
    procedure AdvStop(Conv: HConv; AhszTopic: HSZ; hszItem: HSZ);
    function PokeData(Conv: HConv; AhszTopic: HSZ; hszItem: HSZ; Data: HDdeData;
      Fmt: Integer): LongInt;
    function ExecuteMacro(Conv: HConv; AhszTopic: HSZ; Data: HDdeData): Integer;
    function GetItem(const ItemName: string): TDdeSrvrItem;
    property Conv: HConv read GetConv;
    property Form: TForm read FForm;
    property SConv: TDdeServerConv read FSConv;
    property Topic: string read FTopic write FTopic;
    property HszTopic: HSZ read GetHszTopic;
  end;

{ TDdeCliItem }

type
  TCliItemInfo = class
    FConv: HConv;
    FFormat: UINT;
    FName: HSZ;
  end;

  TDdeCliItem = class(TPersistent)
  private
    function GetHszItem: Hsz;
    procedure SetHszItem(const Value: Hsz);
  protected
    FItem: string;
    FHszItem: TCliItemInfo;
    FCliConv: TDdeClientConv;
    FCtrl: TDdeClientItem;
    function StartAdvise: Boolean;
    function StopAdvise: Boolean;
    procedure StoreData(DdeDat: HDDEData);
    procedure DataChange;
    function AccessData(DdeDat: HDDEData; var DataLen: DWORD): IntPtr;
    procedure ReleaseData(DdeDat: HDDEData);
  public
    constructor Create(ADS: TDdeClientConv);
    destructor Destroy; override;
    function RefreshData: Boolean;
    function SetItem(const S: string): Boolean;
    procedure SrvrDisconnect;
    property HszItem: HSZ read GetHszItem;
    property Control: TDdeClientItem read FCtrl write FCtrl;
  published
    property Item: string read FItem;
  end;

    { Utility functions }

procedure DDECheck(Success: Boolean);
var
  err: Integer;
  ErrStr: string;
begin
  if Success then Exit;
  err := DdeGetLastError(DDEMgr.DdeInstId);
  case err of
    DMLERR_LOW_MEMORY, DMLERR_MEMORY_ERROR:
      ErrStr := Format(SDdeMemErr, [err]);
    DMLERR_NO_CONV_ESTABLISHED:
      ErrStr := Format(SDdeConvErr, [err]);
  else
    ErrStr := Format(SDdeErr, [err]);
  end;
  raise EDdeError.Create(ErrStr);
end;

{Note, GetPasteLinkInfo assumes that the paste link info uses a narrow (ansi)
 encoding rather than a wide (unicode) encoding }

function GetPasteLinkInfo(var Service, Topic, Item: string): Boolean;
var
  hData: THandle;
  pData: IntPtr;
  B: Byte;
  SB: StringBuilder;
  I: Integer;
begin
  Result := False;
  OpenClipboard(0);
  try
    hData := GetClipboardData(ddeMgr.LinkClipFmt);
    if hData <> 0 then
    begin
      SB := StringBuilder.Create;
      pData := GlobalLock(hData);
      try
        I := 0;
        repeat
          B := Marshal.ReadByte(pData, I);
          if B <> 0 then
            SB.Append(Char(AnsiChar(B)));
          Inc(I);
        until B = 0;
        Service := SB.ToString;
        SB.Remove(0, SB.Length); // clear the stringbuilder
        repeat
          B := Marshal.ReadByte(pData, I);
          if B <> 0 then
            SB.Append(Char(AnsiChar(B)));
          Inc(I);
        until B = 0;
        Topic := SB.ToString;
        SB.Remove(0, SB.Length); // clear the stringbuilder
        repeat
          B := Marshal.ReadByte(pData, I);
          if B <> 0 then
            SB.Append(Char(AnsiChar(B)));
          Inc(I);
        until B = 0;
        Item := SB.ToString;
      finally
        GlobalUnlock(hData);
      end;
      Result := True;
    end;
  finally
    CloseClipboard;
  end;
end;

  { TDdeResources }

procedure TDdeResources.Finalize;
begin
  FreeResources;
end;

{ This frees any remaining Dde resources in the required order }
procedure TDdeResources.FreeResources;
var
  ddeRslt: DWORD;
  I : Integer;
  CII: TCliItemInfo;
begin
  if Assigned(FCliItems) then
  begin
    for I := 0 to FCliItems.Count - 1 do
    begin
      CII := TCliItemInfo(FCliItems[I]);
      if CII.FName <> 0 then
      begin
       if CII.FConv <> 0 then
         DdeClientTransaction(nil, DWORD(-1), CII.FConv, CII.FName, CII.FFormat,
           XTYP_ADVSTOP, 1000, ddeRslt);
       DdeFreeStringHandle(FInstance, CII.FName);
      end;
    end;
    FreeAndNil(FCliItems);
  end;
  if Assigned(FConvHandles) then
  begin
    for I := 0 to FConvHandles.Count - 1 do
      if HConv(FConvHandles[I]) <> 0 then
        DdeDisconnect(HConv(FConvHandles[I]));
    FreeAndNil(FConvHandles);
  end;
  if Assigned(FStrings) then
  begin
    for I := 0 to FStrings.Count - 1 do
      if HSz(FStrings[I]) <> 0 then
        DdeFreeStringHandle(FInstance, HSz(FStrings[I]));
    FreeAndNil(FStrings);
  end;
  if FAppName <> 0 then
  begin
    DdeNameService(FInstance, FAppName, 0, DNS_UNREGISTER);
    DdeFreeStringHandle(FInstance, FAppName);
    FAppName := 0;
  end;
  if FInstance <> 0 then
  begin
    DdeUnInitialize(FInstance);
    FInstance := 0;
  end;
end;

constructor TDdeResources.Create;
begin
  inherited;
  FStrings := TList.Create;
  FConvHandles := TList.Create;
  FCliItems := TList.Create;
end;

destructor TDdeResources.Destroy;
begin
  FreeResources;
  System.GC.SuppressFinalize(self);
end;

  { TDdeMgr }

constructor TDdeMgr.Create(AOwner: TComponent);
var
  DDEInst: Longint;
begin
  inherited Create(AOwner);
  FLinkClipFmt := RegisterClipboardFormat('Link');
  FCallback := @DdeMgrCallback; // save a reference to the delegate
  FResources := TDdeResources.Create;
  DDECheck(DdeInitialize(DDEInst, FCallback, APPCLASS_STANDARD, 0) = 0);
  DdeInstID := DDEInst;
  FConvs := TList.Create;
  FCliConvs := TList.Create;
  FConvCtrls := TList.Create;
  FConvHashTable := System.Collections.HashTable.Create;
  FCliConvHashTable := System.Collections.HashTable.Create;
  AppName := ParamStr(0);
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;
    FreeAndNil(FConvs);
  end;
  if FCliConvs <> nil then
  begin
    for I := 0 to FCliConvs.Count - 1 do
      TDdeSrvrConv(FCliConvs[I]).Free;
    FCliConvs.Free;
    FCliConvs := nil;
  end;
  if FConvCtrls <> nil then
  begin
    FConvCtrls.Free;
    FConvCtrls := nil;
  end;
  FreeAndNil(FResources);
  DdeMgr := nil;
  inherited Destroy;
end;

function TDdeMgr.DdeMgrCallBack(CallType, Fmt : UINT; Conv: HConv; hsz1, hsz2: HSZ;
  Data: HDDEData; Data1, Data2: DWORD): HDDEData;
var
  ddeCli: TComponent;
  ddeSrv: TDdeSrvrConv;
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, Data2 <> 0);
  end;
  if Conv <> 0 then
  begin
    case CallType of
      XTYP_ADVREQ:
        begin
          ddeSrv := TDdeSrvrConv(FConvHashTable[TObject(Conv)]);
          if ddeSrv <> nil then
            Result := ddeSrv.RequestData(Conv, hsz1, hsz2, Fmt);
        end;
      XTYP_REQUEST:
        begin
          ddeSrv := TDdeSrvrConv(FConvHashTable[TObject(Conv)]);
          if ddeSrv <> nil then
            Result := ddeSrv.RequestData(Conv, hsz1, hsz2, Fmt);
        end;
      XTYP_ADVSTOP:
        begin
          ddeSrv := TDdeSrvrConv(FConvHashTable[TObject(Conv)]);
          if ddeSrv <> nil then
            ddeSrv.AdvStop(Conv, hsz1, hsz2);
        end;
      XTYP_ADVSTART:
        begin
          ddeSrv := TDdeSrvrConv(FConvHashTable[TObject(Conv)]);
          if ddeSrv <> nil then
            Result := HDdeData(ddeSrv.AdvStart(Conv, hsz1, hsz2, Fmt));
        end;
      XTYP_POKE:
        begin
          ddeSrv := TDdeSrvrConv(FConvHashTable[TObject(Conv)]);
          if ddeSrv <> nil then
            Result := HDdeData(ddeSrv.PokeData(Conv, hsz1, hsz2, Data, Fmt));
        end;
      XTYP_EXECUTE:
        begin
          ddeSrv := TDdeSrvrConv(FConvHashTable[TObject(Conv)]);
          if ddeSrv <> nil then
            Result := HDdeData(ddeSrv.ExecuteMacro(Conv, hsz1, Data));
        end;
      XTYP_XACT_COMPLETE:
        begin
          ddeCli := TComponent(FCliConvHashTable[TObject(Conv)]);
          if ddeCli <> nil then TDdeClientConv(ddeCli).XactComplete
        end;
      XTYP_ADVDATA:
        begin
          ddeCli := TComponent(FCliConvHashTable[TObject(Conv)]);
          if ddeCli <> nil then
            TDdeClientConv(ddeCli).DataChange(Data, hsz2);
        end;
      XTYP_DISCONNECT:
        begin
          ddeCli := TComponent(FCliConvHashTable[TObject(Conv)]);
          if ddeCli <> nil then
            TDdeClientConv(ddeCli).SrvrDisconnect
          else
          begin
            ddeSrv := TDdeSrvrConv(FConvHashTable[TObject(Conv)]);
            if ddeSrv <> nil then
              ddeMgr.Disconnect(ddeSrv);
          end;
        end;
    end;
  end;
end;

function TDdeMgr.AllowConnect(AhszApp: HSZ; AhszTopic: HSZ): Boolean;
var
  Topic: string;
  SB: StringBuilder;
  Form: TForm;
  SConv: TDdeServerConv;
begin
  Result := False;
  if (AhszApp = 0) or (DdeCmpStringHandles(AhszApp, HszApp) = 0)  then
  begin
    SB := StringBuilder.Create(4096);
    DdeQueryStringA(DdeInstId, AhszTopic, SB, SB.Capacity, CP_WINANSI);
    Topic := SB.ToString;
    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(AhszApp: HSZ; AhszTopic: HSZ): HDdeData;
var
  Mem: IntPtr;
//  conns: packed array[0..1] of THSZPair;
begin
  Result := 0;
  if AhszTopic = 0 then Exit;
  if AllowConnect(AhszApp, AhszTopic) = True then
  begin
    Mem := Marshal.AllocHGlobal(2 * Marshal.SizeOf(TypeOf(THSZPair)));
    try
      Marshal.WriteInt32(Mem, HszApp); // conns[0].hszSvc := FHszApp;
      Marshal.WriteInt32(Mem, SizeOf(Hsz), AhszTopic); // conns[0].hszTopic := hszTopic;
      Marshal.WriteInt32(Mem, 2 * SizeOf(Hsz), 0);  // conns[1].hszSvc := 0;
      Marshal.WriteInt32(Mem, 3 * sizeOf(Hsz), 0); //  conns[1].hszTopic := 0;
      Result := DdeCreateDataHandle(DdeInstId, Mem,
        2 * Marshal.sizeof(TypeOf(THSZPair)), 0, 0, CF_TEXT, 0);
    finally
      Marshal.FreeHGlobal(Mem);
    end;
  end;
end;

function TDdeMgr.Connect(Conv: HConv; AhszTopic: HSZ; SameInst: Boolean): Boolean;
var
  Topic: string;
  Buffer: StringBuilder;
  DdeConv: TDdeSrvrConv;
begin
  DdeConv := TDdeSrvrConv.Create(Self);
  Buffer := StringBuilder.Create(4096);
  DdeQueryStringA(DdeInstId, AhszTopic, Buffer, Buffer.Capacity, CP_WINANSI);
  Topic := Buffer.ToString;
  DdeConv.Topic := Topic;
  DdeConv.FSConv := GetServerConv(Topic);
  if DdeConv.FSConv = nil then
    DdeConv.FForm := GetForm(Topic);
  DdeConv.SetConv(Conv);
  FConvs.Add(DdeConv);
  FConvHashTable.Add(TObject(Conv), 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;
  FConvHashTable.Remove(TObject(DdeConv.Conv));
  DdeConv.SetConv(0);
  if FConvs <> nil then
  begin
    FConvs.Remove(DdeConv);
    DdeConv.Free;
  end;
end;

function TDdeMgr.GetExeName: string;
begin
  Result := ParamStr(0);
end;

procedure TDdeMgr.set_HszApp(const Value: Hsz);
begin
  FResources.FAppName := Value;
end;

function TDdeMgr.get_HszApp: Hsz;
begin
  Result := FResources.FAppName;
end;

procedure TDdeMgr.SetAppName(const Name: string);
var
  Dot: Integer;
begin
  ResetAppName;
  FAppName := ExtractFileName(Name);
  Dot := Pos('.', FAppName);
  if Dot <> 0 then
    Delete(FAppName, Dot, Length(FAppName));
  HszApp := DdeCreateStringHandleA(DdeInstId, FAppName, CP_WINANSI);
  DdeNameService(DdeInstId, HszApp, 0, DNS_REGISTER);
end;

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

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

function TDdeMgr.GetForm(const Topic: string): TForm;
var
  I: Integer;
  Form: TForm;
begin
  Result := nil;
  for I := 0 to Screen.FormCount - 1 do
  begin
    Form := TForm(Screen.Forms[I]);
    if WideSameText(Form.Caption, Topic) 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 := TDdeSrvrConv(FConvs[I]);
    if WideSameText(Conv.Topic, Topic) then
    begin
      Result := Conv;
      Exit;
    end;
  end;
end;

procedure TDdeMgr.PostDataChange(const Topic: string; Item: string);
var
  Conv: TDdeSrvrConv;
  Itm: TDdeSrvrItem;
begin
  Conv := TDdeSrvrConv(GetSrvrConv (Topic));
  If Conv <> nil then
  begin
    Itm := Conv.GetItem(Item);
    if Itm <> nil then Itm.PostDataChange;
  end;
end;

procedure TDdeMgr.InsertServerConv(SConv: TDdeServerConv);
begin
  FConvCtrls.Insert(FConvCtrls.Count, SConv);
end;

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

function TDdeMgr.GetDdeInstId: LongInt;
begin
  Result := FResources.FInstance;
end;

procedure TDdeMgr.SetDdeInstId(const ID: LongInt);
begin
  FResources.FInstance := ID;
end;

{procedure TDdeMgr.DoError;
begin
  DDECheck(False);
end;}

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

destructor TDdeClientConv.Destroy;
begin
  CloseLink;
  inherited Destroy;
  FItems.Free;
  FItems := nil;
end;

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

procedure TDdeClientConv.set_HszApp(const Value: Hsz);
begin
  if FHszApp <> nil then
    DdeMgr.FResources.FStrings.Remove(FHszApp);
  if Value = 0 then
    FHszApp := nil
  else
  begin
    FHszApp := TObject(Value); // box the value
    DdeMgr.FResources.FStrings.Add(FHszApp);
  end;
end;

function TDdeClientConv.get_HszApp: Hsz;
begin
  if Assigned(FHszApp) then
    Result := Hsz(FHszApp)
  else
    Result := 0;
end;

procedure TDdeClientConv.set_HszTopic(const Value: Hsz);
begin
  if FHszTopic <> nil then
    DdeMgr.FResources.FStrings.Remove(FHszTopic);
  if Value = 0 then
    FHszTopic := nil
  else
  begin
    FHszTopic := TObject(Value); // box the value
    DdeMgr.FResources.FStrings.Add(FHszTopic);
  end;
end;

function TDdeClientConv.get_HszTopic: Hsz;
begin
  if Assigned(FHszTopic) then
    Result := Hsz(FHszTopic)
  else
    Result := 0;
end;

procedure TDdeClientConv.SetConv(const Value: HConv);
begin
  if FConv <> nil then
    ddeMgr.FResources.FConvHandles.Remove(FConv);
  if Value = 0 then
    FConv := nil
  else
  begin
    FConv := TObject(Value); // box the value
    ddeMgr.FResources.FConvHandles.Add(FConv);
  end;
end;

function TDdeClientConv.GetConv: HConv;
begin
  if FConv <> nil then
    Result := HConv(FConv)
  else
    Result := 0;
end;

procedure TDdeClientConv.Loaded;
var
  Service, Topic: string;
begin
  inherited Loaded;
  Service := DdeService;
  Topic := DdeTopic;
  if (Length(Service) <> 0) and (ConnectMode <> ddeManual) then
    ChangeLink(Service, Topic, '');
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': SetService(Text);
      'T': SetTopic(Text);
    end;
  end;
  Reader.ReadListEnd;
end;

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

procedure TDdeClientConv.OnAttach(aCtrl: TDdeClientItem);
var
  ItemLnk: TDdeCliItem;
begin
  ItemLnk := TDdeCliItem.Create(Self);
  FItems.Insert(FItems.Count, ItemLnk);
  ItemLnk.Control := aCtrl;
  ItemLnk.SetItem('');
end;

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

function TDdeClientConv.OnSetItem(aCtrl: TDdeClientItem; const S: string): Boolean;
var
  ItemLnk: TDdeCliItem;
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;
  I := 0;
  while I < FItems.Count do
  begin
    ItemLnk := TDdeCliItem(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
  if GetPasteLinkInfo(Service, Topic, Item) = True then
    Result := ChangeLink(Service, Topic, Item) else
    Result := False;
end;

function TDdeClientConv.ChangeLink(const App, Topic, Item: string): Boolean;
begin
  CloseLink;
  SetService(App);
  SetTopic(Topic);
  Result := OpenLink;
  if not Result then
  begin
    SetService('');
    SetTopic('');
  end;
end;

function TDdeClientConv.OpenLink: Boolean;
var
  Res: Boolean;
  Temp: string;
begin
  Result := False;
  if Conv <> 0 then Exit;

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

  if HszApp = 0 then
    HszApp := DdeCreateStringHandleA(ddeMgr.DdeInstId, DdeService, CP_WINANSI);
  if HszTopic = 0 then
    HszTopic := DdeCreateStringHandleA(ddeMgr.DdeInstId, DdeTopic, CP_WINANSI);
  Res := CreateDdeConv(HszApp, HszTopic);
  if not Res then
  begin
    if not((Length(DdeService) = 0) and
      (Length(ServiceApplication) = 0)) then
    begin
      if Length(ServiceApplication) <> 0 then
        Temp := ServiceApplication
      else
        Temp := DdeService + ' ' + DdeTopic;
      if WinExec(Temp, SW_SHOWMINNOACTIVE) >= 32 then
        Res := CreateDdeConv(HszApp, HszTopic);
    end;
  end;
  if not Res then
  begin
    ClearItems;
    Exit;
  end;
  if FCnvInfo.wFmt <> 0 then
    FDdeFmt := FCnvInfo.wFmt
  else
    FDdeFmt := CF_TEXT;
  if StartAdvise = False then Exit;
  Open;
  DataChange(0, 0);
  Result := True;
end;

procedure TDdeClientConv.CloseLink;
var
  OldConv: HConv;
begin
  if Conv <> 0 then
  begin
    OldConv := Conv;
    SrvrDisconnect;
    if Assigned(ddeMgr) then
      ddeMgr.FCliConvHashTable.Remove(TObject(OldConv));
    SetConv(0);
    DdeDisconnect(OldConv);
  end;

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

  if HszTopic <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, HszTopic);
    HszTopic := 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;
begin
  SetConv(DdeConnect(ddeMgr.DdeInstId, FHszApp, FHszTopic, nil));
  Result := Conv <> 0;
  if Result then
  begin
    FCnvInfo.cb := Marshal.SizeOf(TypeOf(TConvInfo));
    DdeQueryConvInfo(Conv, QID_SYNC, FCnvInfo);
    ddeMgr.FCliConvHashTable.Add(TObject(Conv), self);
  end;
end;

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

  i := 0;
  while i < FItems.Count do
  begin
    ItemLnk := TDdeCliItem(FItems [i]);
    if not ItemLnk.StartAdvise then
    begin
      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;
begin
  Result := False;
  if (Conv = 0) or FWaitStat then Exit;
  Result := ExecuteMacro(Cmd.Text, waitFlg);
end;

function TDdeClientConv.ExecuteMacro(Cmd: string; waitFlg: Boolean): Boolean;
var
  Mem: IntPtr;
begin
  Result := False;
  if (Conv = 0) or FWaitStat then Exit;
  Mem := Marshal.StringToHGlobalAnsi(Cmd);
  try
    Result := ExecuteMacro(Mem, Length(Cmd) + 1, waitFlg);
  finally
    Marshal.FreeHGlobal(Mem);
  end;
end;

function TDdeClientConv.ExecuteMacro(Cmd: IntPtr; Len: Integer; waitFlg: Boolean): Boolean;
var
  hszCmd: HDDEData;
  hdata: HDDEData;
  ddeRslt: DWORD;
begin
  Result := False;
  if (Conv = 0) or FWaitStat then Exit;
  hszCmd := DdeCreateDataHandle(ddeMgr.DdeInstId, Cmd, Len, 0, 0, FDdeFmt, 0);
  if hszCmd = 0 then Exit;
  if waitFlg = True then FWaitStat := True;
  hdata := DdeClientTransaction(hszCmd, DWORD(-1), Conv, 0, UINT(FDdeFmt),
     XTYP_EXECUTE, TIMEOUT_ASYNC, ddeRslt);
  if hdata = 0 then FWaitStat := False
  else Result := True;
end;

function TDdeClientConv.PokeDataLines(const Item: string; Data: TStrings): Boolean;
begin
  Result := False;
  if (Conv = 0) or FWaitStat then Exit;
  Result := PokeData(Item, Data.Text);
end;

function TDdeClientConv.PokeData(const Item: string; Data: string): Boolean;
var
  Mem: IntPtr;
begin
  Result := False;
  if (Conv = 0) or FWaitStat then Exit;
  Mem := Marshal.StringToHGlobalAnsi(Data);
  try
    Result := PokeData(Item, Mem, Length(Data) + 1);
  finally
    Marshal.FreeHGlobal(Mem);
  end;
end;

function TDdeClientConv.PokeData(const Item: string; Data: IntPtr; Len: Integer): Boolean;
var
  hszDat: HDDEData;
  hdata: HDDEData;
  hszItem: HSZ;
  ddeResult: DWORD;
begin
  Result := False;
  if (Conv = 0) or FWaitStat then Exit;
  hszItem := DdeCreateStringHandleA(ddeMgr.DdeInstId, Item, CP_WINANSI);
  if hszItem = 0 then Exit;
  hszDat := DdeCreateDataHandle(ddeMgr.DdeInstId, Data, Len, 0, hszItem, FDdeFmt, 0);
  if hszDat <> 0 then
  begin
    hdata := DdeClientTransaction(hszDat, DWORD(-1), Conv, hszItem,
      UINT(FDdeFmt), XTYP_POKE, TIMEOUT_ASYNC, ddeResult);
    Result := hdata <> 0;
  end;
  DdeFreeStringHandle (ddeMgr.DdeInstId, hszItem);
end;

function TDdeClientConv.RequestData(const Item: string): TBytes;
var
  hData: HDDEData;
  ddeRslt: DWORD;
  hItem: HSZ;
  pData: IntPtr;
  Len: DWORD;
begin
  Result := nil;
  if (Conv = 0) or FWaitStat then Exit;
  hItem := DdeCreateStringHandleA(ddeMgr.DdeInstId, Item, CP_WINANSI);
  if hItem <> 0 then
  begin
    hData := DdeClientTransaction(nil, 0, Conv, hItem, UINT(FDdeFmt),
      XTYP_REQUEST, 10000, ddeRslt);
    DdeFreeStringHandle(ddeMgr.DdeInstId, hItem);
    if hData <> 0 then
    try
      pData := DdeAccessData(hData, Len);
      if pData <> nil then
      try
        SetLength(Result, Len + 1);
        Marshal.Copy(pData, Result, 0, Len);  // data is binary, may contain nulls
        Result[len] := 0;
      finally
        DdeUnaccessData(hData);
      end;
    finally
      DdeFreeDataHandle(hData);
    end;
  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 Conv <> 0 then Close;
  SetConv(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, Topic: string): Boolean;
begin
  CloseLink;
  if FConnectMode = ddeAutomatic then
    Result := ChangeLink(Service, Topic, '')
  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(SDdeNoConnect);
    FConnectMode := NewMode;
  end;
end;

procedure TDdeClientConv.SetFormatChars(NewFmt: Boolean);
begin
  if FFormatChars <> NewFmt then
  begin
    FFormatChars := NewFmt;
    if Conv <> 0 then DataChange(0, 0);
  end;
end;

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

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

procedure TDdeClientConv.SetService(const Value: string);
begin
  FDdeService := Value;
end;

procedure TDdeClientConv.SetTopic(const Value: string);
begin
  FDdeTopic := Value;
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);
  FLines := TStringList.Create;
end;

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

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

    FDdeClientConv := Val;
    if FDdeClientConv <> nil then
    begin
      FDdeClientConv.FreeNotification(Self);
      if Length(OldItem) <> 0 then SetDdeClientItem (OldItem);
    end;
  end;
end;

procedure TDdeClientItem.SetDdeClientItem(const Val: string);
begin
  if FDdeClientConv <> nil then
  begin
    FDdeClientItem := Val;
    if Not FDdeClientConv.OnSetItem (Self, Val) then
    begin
      if Not (csLoading in ComponentState) or
        not ((FDdeClientConv.Conv = 0) and
        (FDdeClientConv.ConnectMode = ddeManual)) then
        FDdeClientItem := '';
    end;
  end
  else if (csLoading in ComponentState) then
    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;
    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
  inherited Create;
  FCliConv := ADS;
end;

destructor TDdeCliItem.Destroy;
begin
  StopAdvise;
  if FHszItem <> nil then
  begin
    DdeMgr.FResources.FCliItems.Remove(FHszItem);
    FreeAndNil(FHszItem);
  end;
  inherited Destroy;
end;

procedure TDdeCliItem.SetHszItem(const Value: Hsz);
begin
  if FHszItem = nil then
  begin
    if Value = 0 then Exit;
    FHszItem := TCliItemInfo.Create;
    FHszItem.FConv := HConv(FCliConv.FConv);
    DdeMgr.FResources.FCliItems.Add(FHszItem);
  end;
  FHszItem.FFormat := FCliConv.FDdeFmt;
  FHszItem.FName := Value;
end;

function TDdeCliItem.GetHszItem: Hsz;
begin
  if FHszItem = nil then
    Result := 0
  else
    Result := FHszItem.FName;
end;

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

  FItem := S;
  FCtrl.Lines.Clear;

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

procedure TDdeCliItem.StoreData(DdeDat: HDDEData);
var
  Len: DWORD;
  DataPtr: IntPtr;
  DataBytes: TBytes;
  I: Integer;
begin
  if DdeDat = 0 then
  begin
    RefreshData;
    Exit;
  end;
  DataPtr := AccessData(DdeDat, Len);
  if DataPtr = nil then
    FCtrl.Lines.Text := ''
  else
  begin
    try
      SetLength(DataBytes, Len);
      if Len > 0 then
        Marshal.Copy(DataPtr, DataBytes, 0, Len);
    finally
      ReleaseData(DdeDat);
    end;
    if (Len > 0) and (DataBytes[0] <> 0) then
    begin
      if FCliConv.FormatChars = False then
        for I := 0 to Length(DataBytes) - 1 do
          if (DataBytes[I] > 0) and (DataBytes[I] < Ord(' ')) then
            DataBytes[I] := Ord(' ');
      FCtrl.Lines.Text := StringOf(DataBytes);
    end else
      FCtrl.Lines.Text := '';
  end;
  DataChange;
end;

function TDdeCliItem.RefreshData: Boolean;
var
  ddeRslt: DWORD;
  DdeDat: HDDEData;
begin
  Result := False;
  if (FCliConv.Conv <> 0) and (HszItem <> 0) then
  begin
    if FCliConv.WaitStat = True then Exit;
    DdeDat := DdeClientTransaction(nil, DWORD(-1), FCliConv.Conv, HszItem,
      UINT(FCliConv.DdeFmt), XTYP_REQUEST, 1000, ddeRslt);
    if DdeDat = 0 then Exit
    else begin
      StoreData(DdeDat);
      DdeFreeDataHandle(DdeDat);
      Result := True;
      Exit;
    end;
  end;
  DataChange;
end;

function TDdeCliItem.AccessData(DdeDat: HDDEData; var DataLen: DWORD): IntPtr;
begin
  Result := DdeAccessData(DdeDat, DataLen);
end;

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

function TDdeCliItem.StartAdvise: Boolean;
var
  ddeRslt: DWORD;
  hdata: HDDEData;
begin
  Result := False;
  if FCliConv.Conv = 0 then Exit;
  if Length(Item) = 0 then Exit;
  if HszItem = 0 then
    SetHszItem(DdeCreateStringHandleA(ddeMgr.DdeInstId, Item, CP_WINANSI));
  hdata := DdeClientTransaction(nil, DWORD(-1), FCliConv.Conv, HszItem,
    UINT(FCliConv.DdeFmt), XTYP_ADVSTART or XTYPF_NODATA, 1000, ddeRslt);
  if hdata = 0 then
  begin
    DdeGetLastError(ddeMgr.DdeInstId);
    DdeFreeStringHandle(ddeMgr.DdeInstId, HszItem);
    SetHszItem(0);
    FCtrl.Lines.Clear;
  end else
    Result := True;
end;

function TDdeCliItem.StopAdvise: Boolean;
var
  ddeRslt: DWORD;
begin
  if FCliConv.Conv <> 0 then
    if HszItem <> 0 then
      DdeClientTransaction(nil, DWORD(-1), FCliConv.Conv, HszItem,
        UINT(FCliConv.DdeFmt), XTYP_ADVSTOP, 1000, ddeRslt);
  SrvrDisconnect;
  Result := True;
end;

procedure TDdeCliItem.SrvrDisconnect;
begin
  if HszItem <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, HszItem);
    SetHszItem(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;
  if SConv <> nil then SConv.FreeNotification(Self);
end;

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

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

procedure TDdeServerItem.SetLines(Value: TStrings);
begin
  if WideCompareStr(Value.Text, FLines.Text) <> 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: DWORD;
  pData: IntPtr;
begin
  Result := dde_FNotProcessed;
  pData := DdeAccessData(Data, Len);
  if pData <> nil then
  begin
    Lines.Text := Marshal.PtrToStringAnsi(pData, Len);
    DdeUnaccessData(Data);
    ValueChanged;
    if Assigned(FOnPokeData) then FOnPokeData(Self);
    Result := dde_FAck;
  end;
end;

procedure WriteTextToClipboard(AValue: string; Format: Word; AFlags: UINT);
var
  Data: THandle;
  DataPtr: IntPtr;
  B: TBytes;
begin
  Data := GlobalAlloc(AFlags, Length(AValue) + 1);
  try
    DataPtr := GlobalLock(Data);
    try
      B := BytesOf(AValue);
      SetLength(B, Length(B) + 1); // add null terminator
      Marshal.Copy(B, 0, DataPtr, Length(B));
      SetClipboardData(Format, Data);
    finally
     GlobalUnlock(Data);
    end;
  except
    GlobalFree(Data);
    raise;
  end;
end;

procedure TDdeServerItem.CopyToClipboard;
var
  LinkData: string;
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;
  OpenClipboard(0);
  try
    WriteTextToClipboard(Text, CF_TEXT, GMEM_MOVEABLE+GMEM_DDESHARE);
    WriteTextToClipboard(LinkData, DdeMgr.LinkClipFmt, GMEM_MOVEABLE);
  finally
    CloseClipboard;
  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
  ddeMgr.RemoveServerConv(Self);
  inherited Destroy;
end;

function TDdeServerConv.ExecuteMacro(Data: HDdeData): LongInt;
var
  Len: DWORD;
  pData: IntPtr;
  MacroLines: TStringList;
begin
  Result := dde_FNotProcessed;
  pData := DdeAccessData(Data, Len);
  if pData <> nil then
  try
    if Assigned(FOnExecuteMacro) then
    begin
      MacroLines := TStringList.Create;
      MacroLines.Text := Marshal.PtrToStringAnsi(pData, Len);
      FOnExecuteMacro(Self, MacroLines);
      MacroLines.Free;
    end;
    Result := dde_FAck;
  finally
    DdeUnaccessData(Data);
  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
  inherited Create(AOwner);
  FItems := TList.Create;
end;

destructor TDdeSrvrConv.Destroy;
var
  I: Integer;
begin
  if FItems <> nil then
  begin
    for I := 0 to FItems.Count - 1 do
      TDdeSrvrItem(FItems[I]).Free;
    FItems.Free;
    FItems := nil;
  end;
  if Conv <> 0 then
  begin
    DdeDisconnect(Conv);
    SetConv(0);
  end;
  if HszTopic <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, HszTopic);
    SetHszTopic(0);
  end;
  inherited Destroy;
end;

procedure TDdeSrvrConv.SetConv(const Value: HConv);
begin
  if FConv <> nil then
    ddeMgr.FResources.FConvHandles.Remove(FConv);
  if Value = 0 then
    FConv := nil
  else
  begin
    FConv := TObject(Value); // box the value
    ddeMgr.FResources.FConvHandles.Add(FConv);
  end;
end;

function TDdeSrvrConv.GetConv: HConv;
begin
  if FConv <> nil then
    Result := HConv(FConv)
  else
    Result := 0;
end;

function TDdeSrvrConv.GetHszTopic: HSZ;
begin
  if FHSzTopic <> nil then
    Result := Hsz(FHszTopic)
  else
    Result := 0;
end;

procedure TDdeSrvrConv.SetHszTopic(const Value: HSZ);
begin
  if FHszTopic <> nil then
    DdeMgr.FResources.FStrings.Remove(FHszTopic);
  if Value = 0 then
    FHszTopic := nil
  else
  begin
    FHszTopic := TObject(Value);
    DdeMgr.FResources.FStrings.Add(FHszTopic);
  end;
end;

function TDdeSrvrConv.AdvStart(Conv: HConv; AhszTopic: HSZ; AhszItem: HSZ;
  Fmt: Word): Boolean;
var
  Srvr: TDdeServerItem;
  Buffer: StringBuilder;
  SrvrItem: TDdeSrvrItem;
begin
  Result := False;
  if Fmt <> CF_TEXT then Exit;
  Buffer := StringBuilder.Create(4096);
  DdeQueryStringA(ddeMgr.DdeInstId, AhszItem, Buffer, Buffer.Capacity, CP_WINANSI);
  Srvr := GetControl(FForm, FSConv, Buffer.ToString);
  if Srvr = nil then Exit;
  SrvrItem := TDdeSrvrItem.Create(Self);
  SrvrItem.Srvr := Srvr;
  SrvrItem.Item := Buffer.ToString;
  FItems.Add(SrvrItem);
  SrvrItem.FreeNotification(Self);
  if HszTopic = 0 then
    SetHszTopic(DdeCreateStringHandleA(ddeMgr.DdeInstId, Topic, CP_WINANSI));
  Result := True;
end;

procedure TDdeSrvrConv.AdvStop(Conv: HConv; AhszTopic: HSZ; hszItem :HSZ);
var
  SrvrItem: TDdeSrvrItem;
begin
  SrvrItem := GetSrvrItem(hszItem);
  if SrvrItem <> nil then
  begin
    FItems.Remove(SrvrItem);
    SrvrItem.Free;
  end;
end;

function TDdeSrvrConv.PokeData(Conv: HConv; AhszTopic: HSZ; hszItem: HSZ;
  Data: HDdeData; Fmt: Integer): LongInt;
var
  Srvr: TDdeServerItem;
  Buffer: StringBuilder;
begin
  Result := dde_FNotProcessed;
  if Fmt <> CF_TEXT then Exit;
  Buffer := StringBuilder.Create(4096);
  DdeQueryStringA(ddeMgr.DdeInstId, hszItem, Buffer, Buffer.Capacity, CP_WINANSI);
  Srvr := GetControl(FForm, FSConv, Buffer.ToString);
  if Srvr <> nil then Result := Srvr.PokeData(Data);
end;

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

function TDdeSrvrConv.RequestData(Conv: HConv; AhszTopic: HSZ; hszItem :HSZ;
  Fmt: Word): HDdeData;
var
  Data: IntPtr;
  B: TBytes;
  Buffer: StringBuilder;
  SrvrIt: TDdeSrvrItem;
  Srvr: TDdeServerItem;
begin
  Result := 0;
  SrvrIt := GetSrvrItem(hszItem);
  if SrvrIt <> nil then
    Result := SrvrIt.RequestData(Fmt)
  else
  begin
    Buffer := StringBuilder.Create(4096);
    DdeQueryStringA(ddeMgr.DdeInstId, hszItem, Buffer, Buffer.Capacity, CP_WINANSI);
    Srvr := GetControl(FForm, FSConv, Buffer.ToString);
    if Srvr <> nil then
    begin
      if Fmt = CF_TEXT then
      begin
        B := BytesOf(Srvr.Lines.Text);
        SetLength(B, Length(B) + 1);
        Data := Marshal.AllocHGlobal(Length(B));
        try
          Marshal.Copy(B, 0, Data, Length(B));
          Result := DdeCreateDataHandle(ddeMgr.DdeInstId, Data,
            Length(B), 0, hszItem, Fmt, 0 );
        finally
          Marshal.FreeHGlobal(Data);
        end;
      end;
    end;
  end;
end;

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 := TDdeSrvrItem(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 := TDdeSrvrItem(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);
  inherited Create(AOwner);
end;

destructor TDdeSrvrItem.Destroy;
begin
  if HszItem <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, HszItem);
    SetHszItem(0);
  end;
  inherited Destroy;
end;

function TDdeSrvrItem.GetHszItem: HSZ;
begin
  if Assigned(FHszItem) then
    Result := Hsz(FHszItem)
  else
    Result := 0;
end;

procedure TDdeSrvrItem.SetHszItem(const Value: HSZ);
begin
  if Assigned(FHszItem) then
    ddeMgr.FResources.FStrings.Remove(FHszItem);
  if Value = 0 then
    FHszItem := nil
  else
  begin
    FHszItem := TObject(Value);
    ddeMgr.FResources.FStrings.Add(FHszItem);
  end;
end;

function TDdeSrvrItem.RequestData(Fmt: Word): HDdeData;
var
  Data: IntPtr;
  B: TBytes;
  Buffer: StringBuilder;
begin
  Result := 0;
  Buffer := StringBuilder.Create(4096);
  DdeQueryStringA(ddeMgr.DdeInstId, HszItem, Buffer, Buffer.Capacity, CP_WINANSI);
  FItem := Buffer.ToString;
  if Fmt = CF_TEXT then
  begin
    B := BytesOf(Srvr.Lines.Text);
    SetLength(B, Length(B) + 1);
    Data := Marshal.AllocHGlobal(Length(B));
    try
      Marshal.Copy(B, 0, Data, Length(B));
      Result := DdeCreateDataHandle(ddeMgr.DdeInstId, Data, Length(B), 0,
        HszItem, Fmt, 0 );
    finally
     Marshal.FreeHGlobal(Data);
    end;
  end;
end;

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

procedure TDdeSrvrItem.SetItem(const Value: string);
begin
  FItem := Value;
  if HszItem <> 0 then
  begin
    DdeFreeStringHandle(ddeMgr.DdeInstId, HszItem);
    SetHszItem(0);
  end;
  if Length(FItem) > 0 then
    SetHszItem(DdeCreateStringHandleA(ddeMgr.DdeInstId, FItem, CP_WINANSI));
end;

initialization
  ddeMgr := TDdeMgr.Create(Application);
  GroupDescendentsWith(TDdeClientConv, TControl);
  GroupDescendentsWith(TDdeClientItem, TControl);
  GroupDescendentsWith(TDdeServerConv, TControl);
  GroupDescendentsWith(TDdeServerItem, TControl);
finalization
  FreeAndNil(ddeMgr);
end.

