home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / VCL / DDEMAN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-03  |  45.1 KB  |  1,794 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DdeMan;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses
  17.   Windows, Classes, Graphics, Forms, Controls, DDEML, StdCtrls;
  18.  
  19. type
  20.   TDataMode = (ddeAutomatic, ddeManual);
  21.   TDdeServerConv = class;
  22.  
  23.   TMacroEvent = procedure(Sender: TObject; Msg: TStrings) of object;
  24.  
  25.   TDdeClientItem = class;
  26.  
  27. { TDdeClientConv }
  28.  
  29.   TDdeClientConv = class(TComponent)
  30.   private
  31.     FDdeService: string;
  32.     FDdeTopic: string;
  33.     FConv: HConv;
  34.     FCnvInfo: TConvInfo;
  35.     FItems: TList;
  36.     FHszApp: HSZ;
  37.     FHszTopic: HSZ;
  38.     FDdeFmt: Integer;
  39.     FOnClose: TNotifyEvent;
  40.     FOnOpen: TNotifyEvent;
  41.     FAppName: string;
  42.     FDataMode: TDataMode;
  43.     FConnectMode: TDataMode;
  44.     FWaitStat: Boolean;
  45.     FFormatChars: Boolean;
  46.     procedure SetDdeService(const Value: string);
  47.     procedure SetDdeTopic(const Value: string);
  48.     procedure SetService(const Value: string);
  49.     procedure SetTopic(const Value: string);
  50.     procedure SetConnectMode(NewMode: TDataMode);
  51.     procedure SetFormatChars(NewFmt: Boolean);
  52.     procedure XactComplete;
  53.     procedure SrvrDisconnect;
  54.     procedure DataChange(DdeDat: HDDEData; hszIt: HSZ);
  55.   protected
  56.     function CreateDdeConv(FHszApp: HSZ; FHszTopic: HSZ): Boolean;
  57.     function GetCliItemByName(const ItemName: string): TPersistent;
  58.     function GetCliItemByCtrl(ACtrl: TDdeClientItem): TPersistent;
  59.     procedure Loaded; override;
  60.     procedure DefineProperties(Filer: TFiler); override;
  61.     procedure ReadLinkInfo(Reader: TReader);
  62.     procedure WriteLinkInfo(Writer: TWriter);
  63.     function OnSetItem(aCtrl: TDdeClientItem; const S: string): Boolean;
  64.     procedure OnAttach(aCtrl: TDdeClientItem);
  65.     procedure OnDetach(aCtrl: TDdeClientItem);
  66.     procedure Close; dynamic;
  67.     procedure Open; dynamic;
  68.     function ChangeLink(const App, Topic, Item: string): Boolean;
  69.     procedure ClearItems;
  70.     procedure Notification(AComponent: TComponent;
  71.       Operation: TOperation); override;
  72.   public
  73.     constructor Create(AOwner: TComponent); override;
  74.     destructor Destroy; override;
  75.     function PasteLink: Boolean;
  76.     function OpenLink: Boolean;
  77.     function SetLink(const Service, Topic: string): Boolean;
  78.     procedure CloseLink;
  79.     function StartAdvise: Boolean;
  80.     function PokeDataLines(const Item: string; Data: TStrings): Boolean;
  81.     function PokeData(const Item: string; Data: PChar): Boolean;
  82.     function ExecuteMacroLines(Cmd: TStrings; waitFlg: Boolean): Boolean;
  83.     function ExecuteMacro(Cmd: PChar; waitFlg: Boolean): Boolean;
  84.     function RequestData(const Item: string): PChar;
  85.     property DdeFmt: Integer read FDdeFmt;
  86.     property WaitStat: Boolean read FWaitStat;
  87.     property Conv: HConv read FConv;
  88.     property DataMode: TDataMode read FDataMode write FDataMode;
  89.   published
  90.     property ServiceApplication: string read FAppName write FAppName;
  91.     property DdeService: string read FDdeService write SetDdeService;
  92.     property DdeTopic: string read FDdeTopic write SetDdeTopic;
  93.     property ConnectMode: TDataMode read FConnectMode write SetConnectMode default ddeAutomatic;
  94.     property FormatChars: Boolean read FFormatChars write SetFormatChars default False;
  95.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  96.     property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  97.   end;
  98.  
  99. { TDdeClientItem }
  100.  
  101.   TDdeClientItem = class(TComponent)
  102.   private
  103.     FLines: TStrings;
  104.     FDdeClientConv: TDdeClientConv;
  105.     FDdeClientItem: string;
  106.     FOnChange: TNotifyEvent;
  107.     function GetText: string;
  108.     procedure SetDdeClientItem(const Val: string);
  109.     procedure SetDdeClientConv(Val: TDdeClientConv);
  110.     procedure SetText(const S: string);
  111.     procedure SetLines(L: TStrings);
  112.     procedure OnAdvise;
  113.   protected
  114.     procedure Notification(AComponent: TComponent;
  115.       Operation: TOperation); override;
  116.   public
  117.     constructor Create(AOwner: TComponent); override;
  118.     destructor Destroy; override;
  119.   published
  120.     property Text: string read GetText write SetText;
  121.     property Lines: TStrings read FLines write SetLines;
  122.     property DdeConv: TDdeClientConv read FDdeClientConv write SetDdeClientConv;
  123.     property DdeItem: string read FDdeClientItem write SetDdeClientItem;
  124.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  125.   end;
  126.  
  127. { TDdeServerConv }
  128.  
  129.   TDdeServerConv = class(TComponent)
  130.   private
  131.     FOnOpen: TNotifyEvent;
  132.     FOnClose: TNotifyEvent;
  133.     FOnExecuteMacro: TMacroEvent;
  134.   protected
  135.     procedure Connect; dynamic;
  136.     procedure Disconnect; dynamic;
  137.   public
  138.     constructor Create(AOwner: TComponent); override;
  139.     destructor Destroy; override;
  140.     function ExecuteMacro(Data: HDdeData): LongInt;
  141.   published
  142.     property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  143.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  144.     property OnExecuteMacro: TMacroEvent read FOnExecuteMacro write FOnExecuteMacro;
  145.   end;
  146.  
  147. { TDdeServerItem }
  148.  
  149.   TDdeServerItem = class(TComponent)
  150.   private
  151.     FLines: TStrings;
  152.     FServerConv: TDdeServerConv;
  153.     FOnChange: TNotifyEvent;
  154.     FOnPokeData: TNotifyEvent;
  155.     FFmt: Integer;
  156.     procedure ValueChanged;
  157.   protected
  158.     function GetText: string;
  159.     procedure SetText(const Item: string);
  160.     procedure SetLines(Value: TStrings);
  161.     procedure SetServerConv(SConv: TDdeServerConv);
  162.     procedure Notification(AComponent: TComponent;
  163.       Operation: TOperation); override;
  164.   public
  165.     constructor Create(AOwner: TComponent); override;
  166.     destructor Destroy; override;
  167.     function PokeData(Data: HDdeData): LongInt;
  168.     procedure CopyToClipboard;
  169.     procedure Change; dynamic;
  170.     property Fmt: Integer read FFmt;
  171.   published
  172.     property ServerConv: TDdeServerConv read FServerConv write SetServerConv;
  173.     property Text: string read GetText write SetText;
  174.     property Lines: TStrings read FLines write SetLines;
  175.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  176.     property OnPokeData: TNotifyEvent read FOnPokeData write FOnPokeData;
  177.   end;
  178.  
  179. { TDdeMgr }
  180.  
  181.   TDdeMgr = class(TComponent)
  182.   private
  183.     FAppName: string;
  184.     FHszApp: HSZ;
  185.     FConvs: TList;
  186.     FCliConvs: TList;
  187.     FConvCtrls: TList;
  188.     FDdeInstId: Longint;
  189.     FLinkClipFmt: Word;
  190.     procedure Disconnect(DdeSrvrConv: TComponent);
  191.     function GetSrvrConv(const Topic: string ): TComponent;
  192.     function AllowConnect(hszApp: HSZ; hszTopic: HSZ): Boolean;
  193.     function AllowWildConnect(hszApp: HSZ; hszTopic: HSZ): HDdeData;
  194.     function Connect(Conv: HConv; hszTopic: HSZ; SameInst: Boolean): Boolean;
  195.     procedure PostDataChange(const Topic: string; Item: string);
  196.     procedure SetAppName(const Name: string);
  197.     procedure ResetAppName;
  198.     function  GetServerConv(const Topic: string): TDdeServerConv;
  199.     procedure InsertServerConv(SConv: TDdeServerConv);
  200.     procedure RemoveServerConv(SConv: TDdeServerConv);
  201. //    procedure DoError;
  202.     function  GetForm(const Topic: string): TForm;
  203.   public
  204.     constructor Create(AOwner: TComponent); override;
  205.     destructor Destroy; override;
  206.     function GetExeName: string;     // obsolete
  207.     property DdeInstId: LongInt read FDdeInstId write FDdeInstId;
  208.     property AppName: string read FAppName write SetAppName;
  209.     property LinkClipFmt: Word read FLinkClipFmt;
  210.   end;
  211.  
  212.   function GetPasteLinkInfo(var Service: string; var Topic: string;
  213.     var Item: string): Boolean;
  214. var
  215.   ddeMgr: TDdeMgr;
  216.  
  217. implementation
  218.  
  219. uses SysUtils, Dialogs, Consts, Clipbrd;
  220.  
  221. type
  222.   EDdeError = class(Exception);
  223.   TDdeSrvrConv = class;
  224.  
  225. { TDdeSrvrItem }
  226.  
  227.   TDdeSrvrItem = class(TComponent)
  228.   private
  229.     FConv: TDdeSrvrConv;
  230.     FItem: string;
  231.     FHszItem: HSZ;
  232.     FSrvr: TDdeServerItem;
  233.   protected
  234.     procedure SetItem(const Value: string);
  235.   public
  236.     constructor Create(AOwner: TComponent); override;
  237.     destructor Destroy; override;
  238.     function RequestData(Fmt: Word): HDdeData;
  239.     procedure PostDataChange;
  240.     property Conv: TDdeSrvrConv read FConv write FConv;
  241.     property Item: string read FItem write SetItem;
  242.     property Srvr: TDdeServerItem read FSrvr write FSrvr;
  243.     property HszItem: HSZ read FHszItem;
  244.   end;
  245.  
  246. { TDdeSrvrConv }
  247.  
  248.   TDdeSrvrConv = class(TComponent)
  249.   private
  250.     FTopic: string;
  251.     FHszTopic: HSZ;
  252.     FForm: TForm;
  253.     FSConv: TDdeServerConv;
  254.     FConv: HConv;
  255. //    FCnvInfo: TConvInfo;
  256. //    FDdeFmt: Integer;
  257.     FItems: TList;
  258.   protected
  259.     function GetControl(WinCtrl: TWinControl; DdeConv: TDdeServerConv; const ItemName: string): TDdeServerItem;
  260.     function GetSrvrItem(hszItem: HSZ): TDdeSrvrItem;
  261.   public
  262.     constructor Create(AOwner: TComponent); override;
  263.     destructor Destroy; override;
  264.     function RequestData(Conv: HConv; hszTopic: HSZ; hszItem: HSZ;
  265.       Fmt: Word): HDdeData;
  266.     function AdvStart(Conv: HConv; hszTopic: HSZ; hszItem: HSZ;
  267.       Fmt: Word): Boolean;
  268.     procedure AdvStop(Conv: HConv; hszTopic: HSZ; hszItem: HSZ);
  269.     function PokeData(Conv: HConv; hszTopic: HSZ; hszItem: HSZ; Data: HDdeData;
  270.       Fmt: Integer): LongInt;
  271.     function ExecuteMacro(Conv: HConv; hszTopic: HSZ; Data: HDdeData): Integer;
  272.     function GetItem(const ItemName: string): TDdeSrvrItem;
  273.     property Conv: HConv read FConv;
  274.     property Form: TForm read FForm;
  275.     property SConv: TDdeServerConv read FSConv;
  276.     property Topic: string read FTopic write FTopic;
  277.     property HszTopic: HSZ read FHszTopic;
  278.   end;
  279.  
  280. { TDdeCliItem }
  281.  
  282.   TDdeCliItem = class(TPersistent)
  283.   protected
  284.     FItem: string;
  285.     FHszItem: HSZ;
  286.     FCliConv: TDdeClientConv;
  287.     FCtrl: TDdeClientItem;
  288.     function StartAdvise: Boolean;
  289.     function StopAdvise: Boolean;
  290.     procedure StoreData(DdeDat: HDDEData);
  291.     procedure DataChange;
  292.     function AccessData(DdeDat: HDDEData; pDataLen: PDWORD): Pointer;
  293.     procedure ReleaseData(DdeDat: HDDEData);
  294.   public
  295.     constructor Create(ADS: TDdeClientConv);
  296.     destructor Destroy; override;
  297.     function RefreshData: Boolean;
  298.     function SetItem(const S: string): Boolean;
  299.     procedure SrvrDisconnect;
  300.     property HszItem: HSZ read FHszItem;
  301.     property Control: TDdeClientItem read FCtrl write FCtrl;
  302.   published
  303.     property Item: string read FItem;
  304.   end;
  305.  
  306. procedure DDECheck(Success: Boolean);
  307. var
  308.   err: Integer;
  309.   ErrStr: string;
  310. begin
  311.   if Success then Exit;
  312.   err := DdeGetLastError(DDEMgr.DdeInstId);
  313.   case err of
  314.     DMLERR_LOW_MEMORY, DMLERR_MEMORY_ERROR:
  315.       ErrStr := Format(SDdeMemErr, [err]);
  316.     DMLERR_NO_CONV_ESTABLISHED:
  317.       ErrStr := Format(SDdeConvErr, [err]);
  318.   else
  319.     ErrStr := Format(SDdeErr, [err]);
  320.   end;
  321.   raise EDdeError.Create(ErrStr);
  322. end;
  323.  
  324. function DdeMgrCallBack(CallType, Fmt : UINT; Conv: HConv; hsz1, hsz2: HSZ;
  325.   Data: HDDEData; Data1, Data2: DWORD): HDDEData; stdcall;
  326. var
  327.   ci: TConvInfo;
  328.   ddeCli: TComponent;
  329.   ddeSrv: TDdeSrvrConv;
  330.   ddeObj: TComponent;
  331.   xID: Integer;
  332. begin
  333.   Result := 0;
  334.   case CallType of
  335.     XTYP_CONNECT:
  336.       Result := HDdeData(ddeMgr.AllowConnect(hsz2, hsz1));
  337.     XTYP_WILDCONNECT:
  338.       Result := ddeMgr.AllowWildConnect(hsz2, hsz1);
  339.     XTYP_CONNECT_CONFIRM:
  340.       ddeMgr.Connect(Conv, hsz1, Boolean(Data2));
  341.   end;
  342.   if Conv <> 0 then
  343.   begin
  344.     ci.cb := sizeof(TConvInfo);
  345.     if CallType = XTYP_XACT_COMPLETE then
  346.       xID := Data1
  347.     else
  348.       xID := QID_SYNC;
  349.     if DdeQueryConvInfo(Conv, xID, @ci) = 0 then Exit;
  350.     case CallType of
  351.       XTYP_ADVREQ:
  352.         begin
  353.           ddeSrv := TDdeSrvrConv(ci.hUser);
  354.           Result := ddeSrv.RequestData(Conv, hsz1, hsz2, Fmt);
  355.         end;
  356.       XTYP_REQUEST:
  357.         begin
  358.           ddeSrv := TDdeSrvrConv(ci.hUser);
  359.           Result := ddeSrv.RequestData(Conv, hsz1, hsz2, Fmt);
  360.         end;
  361.       XTYP_ADVSTOP:
  362.         begin
  363.           ddeSrv := TDdeSrvrConv(ci.hUser);
  364.           ddeSrv.AdvStop(Conv, hsz1, hsz2);
  365.         end;
  366.       XTYP_ADVSTART:
  367.         begin
  368.           ddeSrv := TDdeSrvrConv(ci.hUser);
  369.           Result := HDdeData(ddeSrv.AdvStart(Conv, hsz1, hsz2, Fmt));
  370.         end;
  371.       XTYP_POKE:
  372.         begin
  373.           ddeSrv := TDdeSrvrConv(ci.hUser);
  374.           Result := HDdeData(ddeSrv.PokeData(Conv, hsz1, hsz2, Data, Fmt));
  375.         end;
  376.       XTYP_EXECUTE:
  377.         begin
  378.           ddeSrv := TDdeSrvrConv(ci.hUser);
  379.           Result := HDdeData(ddeSrv.ExecuteMacro(Conv, hsz1, Data));
  380.         end;
  381.       XTYP_XACT_COMPLETE:
  382.         begin
  383.           ddeCli := TComponent(ci.hUser);
  384.           if ddeCli <> nil then TDdeClientConv(ddeCli).XactComplete
  385.         end;
  386.       XTYP_ADVDATA:
  387.         begin
  388.           ddeCli := TComponent(ci.hUser);
  389.           TDdeClientConv(ddeCli).DataChange(Data, hsz2);
  390.         end;
  391.       XTYP_DISCONNECT:
  392.         begin
  393.           ddeObj := TComponent(ci.hUser);
  394.           if ddeObj <> nil then
  395.           begin
  396.             if ddeObj is TDdeClientConv then
  397.               TDdeClientConv(ddeObj).SrvrDisconnect
  398.             else
  399.               ddeMgr.Disconnect(ddeObj);
  400.           end;
  401.         end;
  402.     end;
  403.   end;
  404. end;
  405.  
  406. function GetPasteLinkInfo(var Service, Topic, Item: string): Boolean;
  407. var
  408.   hData: THandle;
  409.   pData: Pointer;
  410.   P: PChar;
  411. begin
  412.   Result := False;
  413.   Clipboard.Open;
  414.   hData := Clipboard.GetAsHandle(ddeMgr.LinkClipFmt);
  415.   if hData <> 0 then
  416.   begin
  417.     pData := GlobalLock(hData);
  418.     try
  419.       P := PChar(pData);
  420.       Service := PChar(pData);
  421.       P := P + Length(Service) + 1;
  422.       Topic := P;
  423.       P := P + Length(Topic) + 1;
  424.       Item := P;
  425.     finally
  426.       GlobalUnlock(hData);
  427.     end;
  428.     Result := True;
  429.   end;
  430.   Clipboard.Close;
  431. end;
  432.  
  433.  
  434. { TDdeMgr }
  435.  
  436. constructor TDdeMgr.Create(AOwner: TComponent);
  437. begin
  438.   inherited Create(AOwner);
  439.   FLinkClipFmt := RegisterClipboardFormat('Link');
  440.   FDdeInstId := 0;
  441.   DDECheck(DdeInitialize(FDdeInstId, DdeMgrCallBack, APPCLASS_STANDARD, 0) = 0);
  442.   FConvs := TList.Create;
  443.   FCliConvs := TList.Create;
  444.   FConvCtrls := TList.Create;
  445.   AppName := ParamStr(0);
  446. end;
  447.  
  448. destructor TDdeMgr.Destroy;
  449. var
  450.   I: Integer;
  451. begin
  452.   if FConvs <> nil then
  453.   begin
  454.     for I := 0 to FConvs.Count - 1 do
  455.       TDdeSrvrConv(FConvs[I]).Free;
  456.     FConvs.Free;
  457.     FConvs := nil;
  458.   end;
  459.   if FCliConvs <> nil then
  460.   begin
  461.     for I := 0 to FCliConvs.Count - 1 do
  462.       TDdeSrvrConv(FCliConvs[I]).Free;
  463.     FCliConvs.Free;
  464.     FCliConvs := nil;
  465.   end;
  466.   if FConvCtrls <> nil then
  467.   begin
  468.     FConvCtrls.Free;
  469.     FConvCtrls := nil;
  470.   end;
  471.   ResetAppName;
  472.   DdeUnInitialize(FDdeInstId);
  473.   inherited Destroy;
  474. end;
  475.  
  476. function TDdeMgr.AllowConnect(hszApp: HSZ; hszTopic: HSZ): Boolean;
  477. var
  478.   Topic: string;
  479.   Buffer: array[0..4095] of Char;
  480.   Form: TForm;
  481.   SConv: TDdeServerConv;
  482. begin
  483.   Result := False;
  484.   if (hszApp = 0) or (DdeCmpStringHandles(hszApp, FHszApp) = 0)  then
  485.   begin
  486.     SetString(Topic, Buffer, DdeQueryString(FDdeInstId, hszTopic, Buffer,
  487.       SizeOf(Buffer), CP_WINANSI));
  488.     SConv := GetServerConv(Topic);
  489.     if SConv <> nil then
  490.       Result := True
  491.     else begin
  492.       Form := GetForm(Topic);
  493.       if Form <> nil then Result := True;
  494.     end;
  495.   end;
  496. end;
  497.  
  498. function TDdeMgr.AllowWildConnect(hszApp: HSZ; hszTopic: HSZ): HDdeData;
  499. var
  500.   conns: packed array[0..1] of THSZPair;
  501. begin
  502.   Result := 0;
  503.   if hszTopic = 0 then Exit;
  504.   if AllowConnect(hszApp, hszTopic) = True then
  505.   begin
  506.     conns[0].hszSvc := FHszApp;
  507.     conns[0].hszTopic := hszTopic;
  508.     conns[1].hszSvc := 0;
  509.     conns[1].hszTopic := 0;
  510.     Result := DdeCreateDataHandle(ddeMgr.DdeInstId, @conns,
  511.       2 * sizeof(THSZPair), 0, 0, CF_TEXT, 0);
  512.   end;
  513. end;
  514.  
  515. function TDdeMgr.Connect(Conv: HConv; hszTopic: HSZ; SameInst: Boolean): Boolean;
  516. var
  517.   Topic: string;
  518.   Buffer: array[0..4095] of Char;
  519.   DdeConv: TDdeSrvrConv;
  520. begin
  521.   DdeConv := TDdeSrvrConv.Create(Self);
  522.   SetString(Topic, Buffer, DdeQueryString(FDdeInstId, hszTopic, Buffer,
  523.     SizeOf(Buffer), CP_WINANSI));
  524.   DdeConv.Topic := Topic;
  525.   DdeConv.FSConv := GetServerConv(Topic);
  526.   if DdeConv.FSConv = nil then
  527.     DdeConv.FForm := GetForm(Topic);
  528.   DdeConv.FConv := Conv;
  529.   DdeSetUserHandle(Conv, QID_SYNC, LongInt(DdeConv));
  530.   FConvs.Add(DdeConv);
  531.   if DdeConv.FSConv <> nil then DdeConv.FSConv.Connect;
  532.   Result := True;
  533. end;
  534.  
  535. procedure TDdeMgr.Disconnect(DdeSrvrConv: TComponent);
  536. var
  537.   DdeConv: TDdeSrvrConv;
  538. begin
  539.   DdeConv := TDdeSrvrConv(DdeSrvrConv);
  540.   if DdeConv.FSConv <> nil then DdeConv.FSConv.Disconnect;
  541.   if DdeConv.FConv <> 0 then DdeSetUserHandle(DdeConv.FConv, QID_SYNC, 0);
  542.   DdeConv.FConv := 0;
  543.   if FConvs <> nil then
  544.   begin
  545.     FConvs.Remove(DdeConv);
  546.     DdeConv.Free;
  547.   end;
  548. end;
  549.  
  550. function TDdeMgr.GetExeName: string;
  551. begin
  552.   Result := ParamStr(0);
  553. end;
  554.  
  555. procedure TDdeMgr.SetAppName(const Name: string);
  556. var
  557.   Dot: Integer;
  558. begin
  559.   ResetAppName;
  560.   FAppName := ExtractFileName(Name);
  561.   Dot := Pos('.', FAppName);
  562.   if Dot <> 0 then
  563.     Delete(FAppName, Dot, Length(FAppName));
  564.   FHszApp := DdeCreateStringHandle(FDdeInstId, PChar(FAppName), CP_WINANSI);
  565.   DdeNameService(FDdeInstId, FHszApp, 0, DNS_REGISTER);
  566. end;
  567.  
  568. procedure TDdeMgr.ResetAppName;
  569. begin
  570.   if FHszApp <> 0 then
  571.   begin
  572.     DdeNameService(FDdeInstId, FHszApp, 0, DNS_UNREGISTER);
  573.     DdeFreeStringHandle(FDdeInstId, FHszApp);
  574.   end;
  575.   FHszApp := 0;
  576. end;
  577.  
  578. function TDdeMgr.GetServerConv(const Topic: string): TDdeServerConv;
  579. var
  580.   I: Integer;
  581.   SConv: TDdeServerConv;
  582. begin
  583.   Result := nil;
  584.   for I := 0 to FConvCtrls.Count - 1 do
  585.   begin
  586.     SConv := TDdeServerConv(FConvCtrls[I]);
  587.     if AnsiCompareText(SConv.Name, Topic) = 0 then
  588.     begin
  589.       Result := SConv;
  590.       Exit;
  591.     end;
  592.   end;
  593. end;
  594.  
  595. function TDdeMgr.GetForm(const Topic: string): TForm;
  596. var
  597.   I: Integer;
  598.   Form: TForm;
  599. begin
  600.   Result := nil;
  601.   for I := 0 to Screen.FormCount - 1 do
  602.   begin
  603.     Form := TForm(Screen.Forms[I]);
  604.     if AnsiCompareText(Form.Caption, Topic) = 0 then
  605.     begin
  606.       Result := Form;
  607.       Exit;
  608.     end;
  609.   end;
  610. end;
  611.  
  612. function TDdeMgr.GetSrvrConv(const Topic: string ): TComponent;
  613. var
  614.   I: Integer;
  615.   Conv: TDdeSrvrConv;
  616. begin
  617.   Result := nil;
  618.   for I := 0 to FConvs.Count - 1 do
  619.   begin
  620.     Conv := FConvs[I];
  621.     if AnsiCompareText(Conv.Topic, Topic) = 0 then
  622.     begin
  623.       Result := Conv;
  624.       Exit;
  625.     end;
  626.   end;
  627. end;
  628.  
  629. procedure TDdeMgr.PostDataChange(const Topic: string; Item: string);
  630. var
  631.   Conv: TDdeSrvrConv;
  632.   Itm: TDdeSrvrItem;
  633. begin
  634.   Conv := TDdeSrvrConv(GetSrvrConv (Topic));
  635.   If Conv <> nil then
  636.   begin
  637.     Itm := Conv.GetItem(Item);
  638.     if Itm <> nil then Itm.PostDataChange;
  639.   end;
  640. end;
  641.  
  642. procedure TDdeMgr.InsertServerConv(SConv: TDdeServerConv);
  643. begin
  644.   FConvCtrls.Insert(FConvCtrls.Count, SConv);
  645. end;
  646.  
  647. procedure TDdeMgr.RemoveServerConv(SConv: TDdeServerConv);
  648. begin
  649.   FConvCtrls.Remove(SConv);
  650. end;
  651.  
  652. {procedure TDdeMgr.DoError;
  653. begin
  654.   DDECheck(False);
  655. end;}
  656.  
  657. constructor TDdeClientConv.Create(AOwner: TComponent);
  658. begin
  659.   inherited Create(AOwner);
  660.   FItems := TList.Create;
  661. end;
  662.  
  663. destructor TDdeClientConv.Destroy;
  664. begin
  665.   CloseLink;
  666.   inherited Destroy;
  667.   FItems.Free;
  668.   FItems := nil;
  669. end;
  670.  
  671. procedure TDdeClientConv.DefineProperties(Filer: TFiler);
  672. begin
  673.   inherited DefineProperties(Filer);
  674.   Filer.DefineProperty('LinkInfo', ReadLinkInfo, WriteLinkInfo,
  675.     not ((DdeService = '') and (DdeTopic = '')));
  676. end;
  677.  
  678. procedure TDdeClientConv.Loaded;
  679. var
  680.   Service, Topic: string;
  681. begin
  682.   inherited Loaded;
  683.   Service := DdeService;
  684.   Topic := DdeTopic;
  685.   if (Length(Service) <> 0) and (ConnectMode <> ddeManual) then
  686.     ChangeLink(Service, Topic, '');
  687. end;
  688.  
  689. procedure TDdeClientConv.ReadLinkInfo (Reader: TReader);
  690. var
  691.   Value: string;
  692.   Text: string;
  693.   Temp: Integer;
  694. begin
  695.   Reader.ReadListBegin;
  696.   while not Reader.EndOfList do
  697.   begin
  698.     Value := Reader.ReadString;
  699.     Temp := Pos(' ', Value);
  700.     Text := Copy(Value, Temp + 1, Length (Value) - Temp);
  701.     case Value[1] of
  702.       'S': SetService(Text);
  703.       'T': SetTopic(Text);
  704.     end;
  705.   end;
  706.   Reader.ReadListEnd;
  707. end;
  708.  
  709. procedure TDdeClientConv.WriteLinkInfo (Writer: TWriter);
  710. var
  711.   Value: string;
  712. begin
  713.   Writer.WriteListBegin;
  714.   Value := DdeService;
  715.   Writer.WriteString(Format('Service %s', [Value]));
  716.   Value := DdeTopic;
  717.   Writer.WriteString(Format('Topic %s', [Value]));
  718.   Writer.WriteListEnd;
  719. end;
  720.  
  721. procedure TDdeClientConv.OnAttach(aCtrl: TDdeClientItem);
  722. var
  723.   ItemLnk: TDdeCliItem;
  724. begin
  725.   ItemLnk := TDdeCliItem.Create(Self);
  726.   FItems.Insert(FItems.Count, ItemLnk);
  727.   ItemLnk.Control := aCtrl;
  728.   ItemLnk.SetItem('');
  729. end;
  730.  
  731. procedure TDdeClientConv.OnDetach(aCtrl: TDdeClientItem);
  732. var
  733.   ItemLnk: TDdeCliItem;
  734. begin
  735.   ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));
  736.   if ItemLnk <> nil then
  737.   begin
  738.     ItemLnk.SetItem('');
  739.     FItems.Remove(ItemLnk);
  740.     ItemLnk.Free;
  741.   end;
  742. end;
  743.  
  744. function TDdeClientConv.OnSetItem(aCtrl: TDdeClientItem; const S: string): Boolean;
  745. var
  746.   ItemLnk: TDdeCliItem;
  747. begin
  748.   Result := True;
  749.   ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));
  750.  
  751.   if (ItemLnk = nil) and (Length(S) > 0) then
  752.   begin
  753.     OnAttach (aCtrl);
  754.     ItemLnk := TDdeCliItem(GetCliItemByCtrl(aCtrl));
  755.   end;
  756.  
  757.   if (ItemLnk <> nil) and (Length(S) = 0) then
  758.   begin
  759.     OnDetach (aCtrl);
  760.   end
  761.   else if ItemLnk <> nil then
  762.   begin
  763.     Result := ItemLnk.SetItem(S);
  764.     if Not (Result) and Not (csLoading in ComponentState) then
  765.       OnDetach (aCtrl);  {error occurred, do cleanup}
  766.   end;
  767. end;
  768.  
  769. function TDdeClientConv.GetCliItemByCtrl(ACtrl: TDdeClientItem): TPersistent;
  770. var
  771.   ItemLnk: TDdeCliItem;
  772.   I: word;
  773. begin
  774.   Result := nil;
  775.   I := 0;
  776.   while I < FItems.Count do
  777.   begin
  778.     ItemLnk := FItems[I];
  779.     if ItemLnk.Control = aCtrl then
  780.     begin
  781.       Result := ItemLnk;
  782.       Exit;
  783.     end;
  784.     Inc(I);
  785.   end;
  786. end;
  787.  
  788. function TDdeClientConv.PasteLink: Boolean;
  789. var
  790.   Service, Topic, Item: string;
  791. begin
  792.   if GetPasteLinkInfo(Service, Topic, Item) = True then
  793.     Result := ChangeLink(Service, Topic, Item) else
  794.     Result := False;
  795. end;
  796.  
  797. function TDdeClientConv.ChangeLink(const App, Topic, Item: string): Boolean;
  798. begin
  799.   CloseLink;
  800.   SetService(App);
  801.   SetTopic(Topic);
  802.   Result := OpenLink;
  803.   if Not Result then
  804.   begin
  805.     SetService('');
  806.     SetTopic('');
  807.   end;
  808. end;
  809.  
  810. function TDdeClientConv.OpenLink: Boolean;
  811. var
  812.   CharVal: array[0..255] of Char;
  813.   Res: Boolean;
  814. begin
  815.   Result := False;
  816.   if FConv <> 0 then Exit;
  817.  
  818.   if (Length(DdeService) = 0) and (Length(DdeTopic) = 0) then
  819.   begin
  820.     ClearItems;
  821.     Exit;
  822.   end;
  823.  
  824.   if FHszApp = 0 then
  825.   begin
  826.     StrPCopy(CharVal, DdeService);
  827.     FHszApp := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  828.   end;
  829.   if FHszTopic = 0 then
  830.   begin
  831.     StrPCopy(CharVal, DdeTopic);
  832.     FHszTopic := DdeCreateStringHandle(ddeMgr.DdeInstId, CharVal, CP_WINANSI);
  833.   end;
  834.   Res := CreateDdeConv(FHszApp, FHszTopic);
  835.   if Not Res then
  836.   begin
  837.     if Not((Length(DdeService) = 0) and
  838.       (Length(ServiceApplication) = 0)) then
  839.     begin
  840.       if Length(ServiceApplication) <> 0 then
  841.         StrPCopy(CharVal, ServiceApplication)
  842.       else
  843.         StrPCopy(CharVal, DdeService + ' ' + DdeTopic);
  844.       if WinExec(CharVal, SW_SHOWMINNOACTIVE) >= 32 then
  845.         Res := CreateDdeConv(FHszApp, FHszTopic);
  846.     end;
  847.   end;
  848.   if Not Res then
  849.   begin
  850.     ClearItems;
  851.     Exit;
  852.   end;
  853.   if FCnvInfo.wFmt <> 0 then FDdeFmt := FCnvInfo.wFmt
  854.   else FDdeFmt := CF_TEXT;
  855.   if StartAdvise = False then Exit;
  856.   Open;
  857.   DataChange(0, 0);
  858.   Result := True;
  859. end;
  860.  
  861. procedure TDdeClientConv.CloseLink;
  862. var
  863.   OldConv: HConv;
  864. begin
  865.   if FConv <> 0 then
  866.   begin
  867.     OldConv := FConv;
  868.     SrvrDisconnect;
  869.     FConv := 0;
  870.     DdeSetUserHandle(OldConv, QID_SYNC, 0);
  871.     DdeDisconnect(OldConv);
  872.   end;
  873.  
  874.   if FHszApp <> 0 then
  875.   begin
  876.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszApp);
  877.     FHszApp := 0;
  878.   end;
  879.  
  880.   if FHszTopic <> 0 then
  881.   begin
  882.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszTopic);
  883.     FHszTopic := 0;
  884.   end;
  885.   SetService('');
  886.   SetTopic('');
  887. end;
  888.  
  889. procedure TDdeClientConv.ClearItems;
  890. var
  891.   ItemLnk: TDdeCliItem;
  892.   i: word;
  893. begin
  894.   if FItems.Count = 0 then Exit;
  895.  
  896.   for I := 0 to FItems.Count - 1 do
  897.   begin
  898.     ItemLnk := TDdeCliItem(FItems [0]);
  899.     ItemLnk.Control.DdeItem := EmptyStr;
  900.   end;
  901. end;
  902.  
  903. function TDdeClientConv.CreateDdeConv(FHszApp: HSZ; FHszTopic: HSZ): Boolean;
  904. var
  905.   Context: TConvContext;
  906. begin
  907.   FillChar(Context, SizeOf(Context), 0);
  908.   with Context do
  909.   begin
  910.     cb := SizeOf(TConvConText);
  911.     iCodePage := CP_WINANSI;
  912.   end;
  913.   FConv := DdeConnect(ddeMgr.DdeInstId, FHszApp, FHszTopic, @Context);
  914.   Result := FConv <> 0;
  915.   if Result then
  916.   begin
  917.     FCnvInfo.cb := sizeof(TConvInfo);
  918.     DdeQueryConvInfo(FConv, QID_SYNC, @FCnvInfo);
  919.     DdeSetUserHandle(FConv, QID_SYNC, LongInt(Self));
  920.   end;
  921. end;
  922.  
  923. function TDdeClientConv.StartAdvise: Boolean;
  924. var
  925.   ItemLnk: TDdeCliItem;
  926.   i: word;
  927. begin
  928.   Result := False;
  929.   if FConv = 0 then Exit;
  930.  
  931.   i := 0;
  932.   while i < FItems.Count do
  933.   begin
  934.     ItemLnk := TDdeCliItem(FItems [i]);
  935.     if Not ItemLnk.StartAdvise then
  936.     begin
  937.       ItemLnk.Control.DdeItem := EmptyStr;
  938.     end else
  939.       Inc(i);
  940.     if i >= FItems.Count then
  941.       break;
  942.   end;
  943.   Result := True;
  944. end;
  945.  
  946. function TDdeClientConv.ExecuteMacroLines(Cmd: TStrings; waitFlg: Boolean): Boolean;
  947. begin
  948.   Result := False;
  949.   if (FConv = 0) or FWaitStat then Exit;
  950.   Result := ExecuteMacro(PChar(Cmd.Text), waitFlg);
  951. end;
  952.  
  953. function TDdeClientConv.ExecuteMacro(Cmd: PChar; waitFlg: Boolean): Boolean;
  954. var
  955.   hszCmd: HDDEData;
  956.   hdata: HDDEData;
  957.   ddeRslt: LongInt;
  958. begin
  959.   Result := False;
  960.   if (FConv = 0) or FWaitStat then Exit;
  961.   hszCmd := DdeCreateDataHandle(ddeMgr.DdeInstId, Cmd, StrLen(Cmd) + 1,
  962.     0, 0, FDdeFmt, 0);
  963.   if hszCmd = 0 then Exit;
  964.   if waitFlg = True then FWaitStat := True;
  965.   hdata := DdeClientTransaction(Pointer(hszCmd), -1, FConv, 0, FDdeFmt,
  966.      XTYP_EXECUTE, TIMEOUT_ASYNC, @ddeRslt);
  967.   if hdata = 0 then FWaitStat := False
  968.   else Result := True;
  969. end;
  970.  
  971. function TDdeClientConv.PokeDataLines(const Item: string; Data: TStrings): Boolean;
  972. begin
  973.   Result := False;
  974.   if (FConv = 0) or FWaitStat then Exit;
  975.   Result := PokeData(Item, PChar(Data.Text));
  976. end;
  977.  
  978. function TDdeClientConv.PokeData(const Item: string; Data: PChar): Boolean;
  979. var
  980.   hszDat: HDDEData;
  981.   hdata: HDDEData;
  982.   hszItem: HSZ;
  983. begin
  984.   Result := False;
  985.   if (FConv = 0) or FWaitStat then Exit;
  986.   hszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(Item), CP_WINANSI);
  987.   if hszItem = 0 then Exit;
  988.   hszDat := DdeCreateDataHandle (ddeMgr.DdeInstId, Data, StrLen(Data) + 1,
  989.     0, hszItem, FDdeFmt, 0);
  990.   if hszDat <> 0 then
  991.   begin
  992.     hdata := DdeClientTransaction(Pointer(hszDat), -1, FConv, hszItem,
  993.       FDdeFmt, XTYP_POKE, TIMEOUT_ASYNC, nil);
  994.     Result := hdata <> 0;
  995.   end;
  996.   DdeFreeStringHandle (ddeMgr.DdeInstId, hszItem);
  997. end;
  998.  
  999. function TDdeClientConv.RequestData(const Item: string): PChar;
  1000. var
  1001.   hData: HDDEData;
  1002.   ddeRslt: LongInt;
  1003.   hItem: HSZ;
  1004.   pData: Pointer;
  1005.   Len: Integer;
  1006. begin
  1007.   Result := nil;
  1008.   if (FConv = 0) or FWaitStat then Exit;
  1009.   hItem := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(Item), CP_WINANSI);
  1010.   if hItem <> 0 then
  1011.   begin
  1012.     hData := DdeClientTransaction(nil, 0, FConv, hItem, FDdeFmt,
  1013.       XTYP_REQUEST, 10000, @ddeRslt);
  1014.     DdeFreeStringHandle(ddeMgr.DdeInstId, hItem);
  1015.     if hData <> 0 then
  1016.     try
  1017.       pData := DdeAccessData(hData, @Len);
  1018.       if pData <> nil then
  1019.       try
  1020.         Result := StrAlloc(Len + 1);
  1021.         StrCopy(Result, pData);
  1022.       finally
  1023.         DdeUnaccessData(hData);
  1024.       end;
  1025.     finally
  1026.       DdeFreeDataHandle(hData);
  1027.     end;
  1028.   end;
  1029. end;
  1030.  
  1031. function TDdeClientConv.GetCliItemByName(const ItemName: string): TPersistent;
  1032. var
  1033.   ItemLnk: TDdeCliItem;
  1034.   i: word;
  1035. begin
  1036.   Result := nil;
  1037.   i := 0;
  1038.   while i < FItems.Count do
  1039.   begin
  1040.     ItemLnk := TDdeCliItem(FItems[i]);
  1041.     if ItemLnk.Item = ItemName then
  1042.     begin
  1043.       Result := ItemLnk;
  1044.       Exit;
  1045.     end;
  1046.     Inc(i);
  1047.   end;
  1048. end;
  1049.  
  1050. procedure TDdeClientConv.XactComplete;
  1051. begin
  1052.    FWaitStat := False;
  1053. end;
  1054.  
  1055. procedure TDdeClientConv.SrvrDisconnect;
  1056. var
  1057.   ItemLnk: TDdeCliItem;
  1058.   i: word;
  1059. begin
  1060.   if FConv <> 0 then Close;
  1061.   FConv := 0;
  1062.   i := 0;
  1063.   while i < FItems.Count do
  1064.   begin
  1065.     ItemLnk := TDdeCliItem(FItems [i]);
  1066.     ItemLnk.SrvrDisconnect;
  1067.     inc(i);
  1068.   end;
  1069. end;
  1070.  
  1071. procedure TDdeClientConv.DataChange(DdeDat: HDDEData; hszIt: HSZ);
  1072. var
  1073.   ItemLnk: TDdeCliItem;
  1074.   i: word;
  1075. begin
  1076.   i := 0;
  1077.   while i < FItems.Count do
  1078.   begin
  1079.     ItemLnk := TDdeCliItem(FItems [i]);
  1080.     if (hszIt = 0) or (ItemLnk.HszItem = hszIt) then
  1081.     begin
  1082.         { data has changed and we found a link that might be interested }
  1083.       ItemLnk.StoreData(DdeDat);
  1084.     end;
  1085.     Inc(i);
  1086.   end;
  1087. end;
  1088.  
  1089. function TDdeClientConv.SetLink(const Service, Topic: string): Boolean;
  1090. begin
  1091.   CloseLink;
  1092.   if FConnectMode = ddeAutomatic then
  1093.     Result := ChangeLink(Service, Topic, '')
  1094.   else begin
  1095.     SetService(Service);
  1096.     SetTopic(Topic);
  1097.     DataChange(0,0);
  1098.     Result := True;
  1099.   end;
  1100. end;
  1101.  
  1102. procedure TDdeClientConv.SetConnectMode(NewMode: TDataMode);
  1103. begin
  1104.   if FConnectMode <> NewMode then
  1105.   begin
  1106.     if (NewMode = ddeAutomatic) and (Length(DdeService) <> 0) and
  1107.       (Length(DdeTopic) <> 0) and not OpenLink then
  1108.       raise Exception.Create(SDdeNoConnect);
  1109.     FConnectMode := NewMode;
  1110.   end;
  1111. end;
  1112.  
  1113. procedure TDdeClientConv.SetFormatChars(NewFmt: Boolean);
  1114. begin
  1115.   if FFormatChars <> NewFmt then
  1116.   begin
  1117.     FFormatChars := NewFmt;
  1118.     if FConv <> 0 then DataChange(0, 0);
  1119.   end;
  1120. end;
  1121.  
  1122. procedure TDdeClientConv.SetDdeService(const Value: string);
  1123. begin
  1124. end;
  1125.  
  1126. procedure TDdeClientConv.SetDdeTopic(const Value: string);
  1127. begin
  1128. end;
  1129.  
  1130. procedure TDdeClientConv.SetService(const Value: string);
  1131. begin
  1132.   FDdeService := Value;
  1133. end;
  1134.  
  1135. procedure TDdeClientConv.SetTopic(const Value: string);
  1136. begin
  1137.   FDdeTopic := Value;
  1138. end;
  1139.  
  1140. procedure TDdeClientConv.Close;
  1141. begin
  1142.   if Assigned(FOnClose) then FOnClose(Self);
  1143. end;
  1144.  
  1145. procedure TDdeClientConv.Open;
  1146. begin
  1147.   if Assigned(FOnOpen) then FOnOpen(Self);
  1148. end;
  1149.  
  1150. procedure TDdeClientConv.Notification(AComponent: TComponent;
  1151.   Operation: TOperation);
  1152. var
  1153.   ItemLnk: TDdeCliItem;
  1154.   i: word;
  1155. begin
  1156.   inherited Notification(AComponent, Operation);
  1157.   if (Operation = opRemove) and (FItems <> nil) then
  1158.   begin
  1159.     i := 0;
  1160.     while i < FItems.Count do
  1161.     begin
  1162.       ItemLnk := TDdeCliItem(FItems [i]);
  1163.       if (AComponent = ItemLnk.Control) then
  1164.         ItemLnk.Control.DdeItem := EmptyStr;
  1165.       if i >= FItems.Count then break;
  1166.       Inc(I);
  1167.     end;
  1168.   end;
  1169. end;
  1170.  
  1171. constructor TDdeClientItem.Create(AOwner: TComponent);
  1172. begin
  1173.   inherited Create(AOwner);
  1174.   FLines := TStringList.Create;
  1175. end;
  1176.  
  1177. destructor TDdeClientItem.Destroy;
  1178. begin
  1179.   FLines.Free;
  1180.   inherited Destroy;
  1181. end;
  1182.  
  1183. procedure TDdeClientItem.SetDdeClientConv(Val: TDdeClientConv);
  1184. var
  1185.   OldItem: string;
  1186. begin
  1187.   if Val <> FDdeClientConv then
  1188.   begin
  1189.     OldItem := DdeItem;
  1190.     FDdeClientItem := '';
  1191.     if FDdeClientConv <> nil then
  1192.       FDdeClientConv.OnDetach (Self);
  1193.  
  1194.     FDdeClientConv := Val;
  1195.     if FDdeClientConv <> nil then
  1196.     begin
  1197.       FDdeClientConv.FreeNotification(Self);
  1198.       if Length(OldItem) <> 0 then SetDdeClientItem (OldItem);
  1199.     end;
  1200.   end;
  1201. end;
  1202.  
  1203. procedure TDdeClientItem.SetDdeClientItem(const Val: string);
  1204. begin
  1205.   if FDdeClientConv <> nil then
  1206.   begin
  1207.     FDdeClientItem := Val;
  1208.     if Not FDdeClientConv.OnSetItem (Self, Val) then
  1209.     begin
  1210.       if Not (csLoading in ComponentState) or
  1211.         not ((FDdeClientConv.FConv = 0) and
  1212.         (FDdeClientConv.ConnectMode = ddeManual)) then
  1213.         FDdeClientItem := '';
  1214.     end;
  1215.   end
  1216.   else if (csLoading in ComponentState) then
  1217.     FDdeClientItem := Val;
  1218. end;
  1219.  
  1220. procedure TDdeClientItem.Notification(AComponent: TComponent;
  1221.   Operation: TOperation);
  1222. begin
  1223.   inherited Notification(AComponent, Operation);
  1224.   if (Operation = opRemove) and (AComponent = FDdeClientConv) then
  1225.   begin
  1226.     FDdeClientConv.OnDetach (Self);
  1227.     FDdeClientConv := nil;
  1228.     FDdeClientItem := '';
  1229.   end;
  1230. end;
  1231.  
  1232. procedure TDdeClientItem.OnAdvise;
  1233. begin
  1234.   if csDesigning in ComponentState then
  1235.   begin
  1236.     if Owner.InheritsFrom (TForm) and (TForm(Owner).Designer <> nil) then
  1237.       TForm(Owner).Designer.Modified;
  1238.   end;
  1239.   if Assigned(FOnChange) then FOnChange(Self);
  1240. end;
  1241.  
  1242. function TDdeClientItem.GetText: string;
  1243. begin
  1244.   if FLines.Count > 0 then
  1245.     Result := FLines.Strings[0]
  1246.   else Result := '';
  1247. end;
  1248.  
  1249. procedure TDdeClientItem.SetText(const S: string);
  1250. begin
  1251. end;
  1252.  
  1253. procedure TDdeClientItem.SetLines(L: TStrings);
  1254. begin
  1255. end;
  1256.  
  1257. constructor TDdeCliItem.Create(ADS: TDdeClientConv);
  1258. begin
  1259.   inherited Create;
  1260.   FHszItem := 0;
  1261.   FCliConv := ADS;
  1262. end;
  1263.  
  1264. destructor TDdeCliItem.Destroy;
  1265. begin
  1266.   StopAdvise;
  1267.   inherited Destroy;
  1268. end;
  1269.  
  1270. function TDdeCliItem.SetItem(const S: string): Boolean;
  1271. var
  1272.   OldItem: string;
  1273. begin
  1274.   Result := False;
  1275.   OldItem := Item;
  1276.   if FHszItem <> 0 then StopAdvise;
  1277.  
  1278.   FItem := S;
  1279.   FCtrl.Lines.Clear;
  1280.  
  1281.   if (Length(Item) <> 0) then
  1282.   begin
  1283.     if (FCliConv.Conv <> 0) then
  1284.     begin
  1285.       Result := StartAdvise;
  1286.       if Not Result then
  1287.         FItem := '';
  1288.     end
  1289.     else if FCliConv.ConnectMode = ddeManual then Result := True;
  1290.   end;
  1291.   RefreshData;
  1292. end;
  1293.  
  1294. procedure TDdeCliItem.StoreData(DdeDat: HDDEData);
  1295. var
  1296.   Len: Longint;
  1297.   Data: string;
  1298.   I: Integer;
  1299. begin
  1300.   if DdeDat = 0 then
  1301.   begin
  1302.     RefreshData;
  1303.     Exit;
  1304.   end;
  1305.  
  1306.   Data := PChar(AccessData(DdeDat, @Len));
  1307.   if Data <> '' then
  1308.   begin
  1309.     FCtrl.Lines.Text := Data;
  1310.     ReleaseData(DdeDat);
  1311.     if FCliConv.FormatChars = False then
  1312.     begin
  1313.       for I := 1 to Length(Data) do
  1314.         if (Data[I] > #0) and (Data[I] < ' ') then Data[I] := ' ';
  1315.       FCtrl.Lines.Text := Data;
  1316.     end;
  1317.   end;
  1318.   DataChange;
  1319. end;
  1320.  
  1321. function TDdeCliItem.RefreshData: Boolean;
  1322. var
  1323.   ddeRslt: LongInt;
  1324.   DdeDat: HDDEData;
  1325. begin
  1326.   Result := False;
  1327.   if (FCliConv.Conv <> 0) and (FHszItem <> 0) then
  1328.   begin
  1329.     if FCliConv.WaitStat = True then Exit;
  1330.     DdeDat := DdeClientTransaction(nil, -1, FCliConv.Conv, FHszItem,
  1331.       FCliConv.DdeFmt, XTYP_REQUEST, 1000, @ddeRslt);
  1332.     if DdeDat = 0 then Exit
  1333.     else begin
  1334.       StoreData(DdeDat);
  1335.       DdeFreeDataHandle(DdeDat);
  1336.       Result := True;
  1337.       Exit;
  1338.     end;
  1339.   end;
  1340.   DataChange;
  1341. end;
  1342.  
  1343. function TDdeCliItem.AccessData(DdeDat: HDDEData; pDataLen: PDWORD): Pointer;
  1344. begin
  1345.   Result := DdeAccessData(DdeDat, pDataLen);
  1346. end;
  1347.  
  1348. procedure TDdeCliItem.ReleaseData(DdeDat: HDDEData);
  1349. begin
  1350.   DdeUnaccessData(DdeDat);
  1351. end;
  1352.  
  1353. function TDdeCliItem.StartAdvise: Boolean;
  1354. var
  1355.   ddeRslt: LongInt;
  1356.   hdata: HDDEData;
  1357. begin
  1358.   Result := False;
  1359.   if FCliConv.Conv = 0 then Exit;
  1360.   if Length(Item) = 0 then Exit;
  1361.   if FHszItem = 0 then
  1362.     FHszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(Item), CP_WINANSI);
  1363.   hdata := DdeClientTransaction(nil, -1, FCliConv.Conv, FHszItem,
  1364.     FCliConv.DdeFmt, XTYP_ADVSTART or XTYPF_NODATA, 1000, @ddeRslt);
  1365.   if hdata = 0 then
  1366.   begin
  1367.     DdeGetLastError(ddeMgr.DdeInstId);
  1368.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
  1369.     FHszItem := 0;
  1370.     FCtrl.Lines.Clear;
  1371.   end else
  1372.     Result := True;
  1373. end;
  1374.  
  1375. function TDdeCliItem.StopAdvise: Boolean;
  1376. var
  1377.   ddeRslt: LongInt;
  1378. begin
  1379.   if FCliConv.Conv <> 0 then
  1380.     if FHszItem <> 0 then
  1381.       DdeClientTransaction(nil, -1, FCliConv.Conv, FHszItem,
  1382.         FCliConv.DdeFmt, XTYP_ADVSTOP, 1000, @ddeRslt);
  1383.   SrvrDisconnect;
  1384.   Result := True;
  1385. end;
  1386.  
  1387. procedure TDdeCliItem.SrvrDisconnect;
  1388. begin
  1389.   if FHszItem <> 0 then
  1390.   begin
  1391.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
  1392.     FHszItem := 0;
  1393.   end;
  1394. end;
  1395.  
  1396. procedure TDdeCliItem.DataChange;
  1397. begin
  1398.   FCtrl.OnAdvise;
  1399. end;
  1400.  
  1401. constructor TDdeServerItem.Create(AOwner: TComponent);
  1402. begin
  1403.   inherited Create(AOwner);
  1404.   FFmt := CF_TEXT;
  1405.   FLines := TStringList.Create;
  1406. end;
  1407.  
  1408. destructor TDdeServerItem.Destroy;
  1409. begin
  1410.   FLines.Free;
  1411.   inherited Destroy;
  1412. end;
  1413.  
  1414. procedure TDdeServerItem.SetServerConv(SConv: TDdeServerConv);
  1415. begin
  1416.   FServerConv := SConv;
  1417.   if SConv <> nil then SConv.FreeNotification(Self);
  1418. end;
  1419.  
  1420. function TDdeServerItem.GetText: string;
  1421. begin
  1422.   if FLines.Count > 0 then
  1423.     Result := FLines.Strings[0]
  1424.   else Result := '';
  1425. end;
  1426.  
  1427. procedure TDdeServerItem.SetText(const Item: string);
  1428. begin
  1429.   FFmt := CF_TEXT;
  1430.   FLines.Clear;
  1431.   FLines.Add(Item);
  1432.   ValueChanged;
  1433. end;
  1434.  
  1435. procedure TDdeServerItem.SetLines(Value: TStrings);
  1436. begin
  1437.   if CompareStr(Value.Text, FLines.Text) <> 0 then
  1438.   begin
  1439.     FFmt := CF_TEXT;
  1440.     FLines.Assign(Value);
  1441.     ValueChanged;
  1442.   end;
  1443. end;
  1444.  
  1445. procedure TDdeServerItem.ValueChanged;
  1446. begin
  1447.   if Assigned(FOnChange) then FOnChange(Self);
  1448.   if FServerConv <> nil then
  1449.     ddeMgr.PostDataChange(FServerConv.Name, Name)
  1450.   else if (Owner <> nil) and (Owner is TForm) then
  1451.     ddeMgr.PostDataChange(TForm(Owner).Caption, Name);
  1452. end;
  1453.  
  1454. function TDdeServerItem.PokeData(Data: HDdeData): LongInt;
  1455. var
  1456.   Len: Integer;
  1457.   pData: Pointer;
  1458. begin
  1459.   Result := dde_FNotProcessed;
  1460.   pData := DdeAccessData(Data, @Len);
  1461.   if pData <> nil then
  1462.   begin
  1463.     Lines.Text := PChar(pData);
  1464.     DdeUnaccessData(Data);
  1465.     ValueChanged;
  1466.     if Assigned(FOnPokeData) then FOnPokeData(Self);
  1467.     Result := dde_FAck;
  1468.   end;
  1469. end;
  1470.  
  1471. procedure TDdeServerItem.CopyToClipboard;
  1472. var
  1473.   Data: THandle;
  1474.   LinkData: string;
  1475.   DataPtr: Pointer;
  1476. begin
  1477.   if FServerConv <> nil then
  1478.     LinkData := ddeMgr.AppName + #0 + FServerConv.Name + #0 + Name
  1479.   else if (Owner =nil) then Exit
  1480.   else if Owner is TForm then
  1481.     LinkData := ddeMgr.AppName + #0 + TForm(Owner).Caption + #0 + Name;
  1482.   try
  1483.     Clipboard.AsText := Text;
  1484.     Data := GlobalAlloc(GMEM_MOVEABLE, Length(LinkData) + 1);
  1485.     try
  1486.       DataPtr := GlobalLock(Data);
  1487.       try
  1488.         Move(PChar(LinkData)^, DataPtr^, Length(LinkData) + 1);
  1489.         Clipboard.SetAsHandle(DdeMgr.LinkClipFmt, Data);
  1490.       finally
  1491.         GlobalUnlock(Data);
  1492.       end;
  1493.     except
  1494.       GlobalFree(Data);
  1495.       raise;
  1496.     end;
  1497.   finally
  1498.     Clipboard.Close;
  1499.   end;
  1500. end;
  1501.  
  1502. procedure TDdeServerItem.Change;
  1503. begin
  1504.   if Assigned(FOnChange) then FOnChange(Self);
  1505. end;
  1506.  
  1507. procedure TDdeServerItem.Notification(AComponent: TComponent;
  1508.   Operation: TOperation);
  1509. begin
  1510.   inherited Notification(AComponent, Operation);
  1511.   if (AComponent = FServerConv) and (Operation = opRemove) then
  1512.     FServerConv := nil;
  1513. end;
  1514.  
  1515. constructor TDdeServerConv.Create(AOwner: TComponent);
  1516. begin
  1517.   inherited Create(AOwner);
  1518.   ddeMgr.InsertServerConv (Self);
  1519. end;
  1520.  
  1521. destructor TDdeServerConv.Destroy;
  1522. begin
  1523.   ddeMgr.RemoveServerConv(Self);
  1524.   inherited Destroy;
  1525. end;
  1526.  
  1527. function TDdeServerConv.ExecuteMacro(Data: HDdeData): LongInt;
  1528. var
  1529.   Len: Integer;
  1530.   pData: Pointer;
  1531.   MacroLines: TStringList;
  1532. begin
  1533.   Result := dde_FNotProcessed;
  1534.   pData := DdeAccessData(Data, @Len);
  1535.   if pData <> nil then
  1536.   begin
  1537.     if Assigned(FOnExecuteMacro) then
  1538.     begin
  1539.       MacroLines := TStringList.Create;
  1540.       MacroLines.Text := PChar(pData);
  1541.       FOnExecuteMacro(Self, MacroLines);
  1542.       MacroLines.Destroy;
  1543.     end;
  1544.     Result := dde_FAck;
  1545.   end;
  1546. end;
  1547.  
  1548. procedure TDdeServerConv.Connect;
  1549. begin
  1550.   if Assigned(FOnOpen) then FOnOpen(Self);
  1551. end;
  1552.  
  1553. procedure TDdeServerConv.Disconnect;
  1554. begin
  1555.   if Assigned(FOnClose) then FOnClose(Self);
  1556. end;
  1557.  
  1558. constructor TDdeSrvrConv.Create(AOwner: TComponent);
  1559. begin
  1560.   inherited Create(AOwner);
  1561.   FItems := TList.Create;
  1562. end;
  1563.  
  1564. destructor TDdeSrvrConv.Destroy;
  1565. var
  1566.   I: Integer;
  1567. begin
  1568.   if FItems <> nil then
  1569.   begin
  1570.     for I := 0 to FItems.Count - 1 do
  1571.       TDdeSrvrItem(FItems[I]).Free;
  1572.     FItems.Free;
  1573.     FItems := nil;
  1574.   end;
  1575.   if FConv <> 0 then DdeDisconnect(FConv);
  1576.   if FHszTopic <> 0 then
  1577.   begin
  1578.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszTopic);
  1579.     FHszTopic := 0;
  1580.   end;
  1581.   inherited Destroy;
  1582. end;
  1583.  
  1584. function TDdeSrvrConv.AdvStart(Conv: HConv; hszTopic: HSZ; hszItem: HSZ;
  1585.   Fmt: Word): Boolean;
  1586. var
  1587.   Srvr: TDdeServerItem;
  1588.   Buffer: array[0..4095] of Char;
  1589.   SrvrItem: TDdeSrvrItem;
  1590. begin
  1591.   Result := False;
  1592.   if Fmt <> CF_TEXT then Exit;
  1593.   DdeQueryString(ddeMgr.DdeInstId, hszItem, Buffer, SizeOf(Buffer), CP_WINANSI);
  1594.   Srvr := GetControl(FForm, FSConv, Buffer);
  1595.   if Srvr = nil then Exit;
  1596.   SrvrItem := TDdeSrvrItem.Create(Self);
  1597.   SrvrItem.Srvr := Srvr;
  1598.   SrvrItem.Item := Buffer;
  1599.   FItems.Add(SrvrItem);
  1600.   SrvrItem.FreeNotification(Self);
  1601.   if FHszTopic = 0 then
  1602.     FHszTopic := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(Topic), CP_WINANSI);
  1603.   Result := True;
  1604. end;
  1605.  
  1606. procedure TDdeSrvrConv.AdvStop(Conv: HConv; hszTopic: HSZ; hszItem :HSZ);
  1607. var
  1608.   SrvrItem: TDdeSrvrItem;
  1609. begin
  1610.   SrvrItem := GetSrvrItem(hszItem);
  1611.   if SrvrItem <> nil then
  1612.   begin
  1613.     FItems.Remove(SrvrItem);
  1614.     SrvrItem.Free;
  1615.   end;
  1616. end;
  1617.  
  1618. function TDdeSrvrConv.PokeData(Conv: HConv; hszTopic: HSZ; hszItem: HSZ;
  1619.   Data: HDdeData; Fmt: Integer): LongInt;
  1620. var
  1621.   Srvr: TDdeServerItem;
  1622.   Buffer: array[0..4095] of Char;
  1623. begin
  1624.   Result := dde_FNotProcessed;
  1625.   if Fmt <> CF_TEXT then Exit;
  1626.   DdeQueryString(ddeMgr.DdeInstId, hszItem, Buffer, SizeOf(Buffer), CP_WINANSI);
  1627.   Srvr := GetControl(FForm, FSConv, Buffer);
  1628.   if Srvr <> nil then Result := Srvr.PokeData(Data);
  1629. end;
  1630.  
  1631. function TDdeSrvrConv.ExecuteMacro(Conv: HConv; hszTopic: HSZ;
  1632.   Data: HDdeData): Integer;
  1633. begin
  1634.   Result := dde_FNotProcessed;
  1635.   if (FSConv <> nil)  then
  1636.     Result := FSConv.ExecuteMacro(Data);
  1637. end;
  1638.  
  1639. function TDdeSrvrConv.RequestData(Conv: HConv; hszTopic: HSZ; hszItem :HSZ;
  1640.   Fmt: Word): HDdeData;
  1641. var
  1642.   Data: string;
  1643.   Buffer: array[0..4095] of Char;
  1644.   SrvrIt: TDdeSrvrItem;
  1645.   Srvr: TDdeServerItem;
  1646. begin
  1647.   Result := 0;
  1648.   SrvrIt := GetSrvrItem(hszItem);
  1649.   if SrvrIt <> nil then
  1650.     Result := SrvrIt.RequestData(Fmt)
  1651.   else
  1652.   begin
  1653.     DdeQueryString(ddeMgr.DdeInstId, hszItem, Buffer, SizeOf(Buffer), CP_WINANSI);
  1654.     Srvr := GetControl(FForm, FSConv, Buffer);
  1655.     if Srvr <> nil then
  1656.     begin
  1657.       if Fmt = CF_TEXT then
  1658.       begin
  1659.         Data := Srvr.Lines.Text;
  1660.         Result := DdeCreateDataHandle(ddeMgr.DdeInstId, PChar(Data),
  1661.           Length(Data) + 1, 0, hszItem, Fmt, 0 );
  1662.       end;
  1663.     end;
  1664.   end;
  1665. end;
  1666.  
  1667. function TDdeSrvrConv.GetControl(WinCtrl: TWinControl; DdeConv: TDdeServerConv; const ItemName: string): TDdeServerItem;
  1668. var
  1669.   I: Integer;
  1670.   Ctrl: TComponent;
  1671.   MainCtrl: TWinControl;
  1672.   Srvr: TDdeServerItem;
  1673. begin
  1674.   Result := nil;
  1675.   MainCtrl := WinCtrl;
  1676.   if MainCtrl = nil then
  1677.   begin
  1678.     if (DdeConv <> nil) and (DdeConv.Owner <> nil) and
  1679.       (DdeConv.Owner is TForm) then
  1680.       MainCtrl := TWinControl(DdeConv.Owner);
  1681.   end;
  1682.   if MainCtrl = nil then Exit;
  1683.   for I := 0 to MainCtrl.ComponentCount - 1 do
  1684.   begin
  1685.     Ctrl := MainCtrl.Components[I];
  1686.     if Ctrl is TDdeServerItem then
  1687.     begin
  1688.       if (Ctrl.Name = ItemName) and
  1689.         (TDdeServerItem(Ctrl).ServerConv = DdeConv) then
  1690.       begin
  1691.         Result := TDdeServerItem(Ctrl);
  1692.         Exit;
  1693.       end;
  1694.     end;
  1695.     if Ctrl is TWinControl then
  1696.     begin
  1697.       Srvr := GetControl(TWinControl(Ctrl), DdeConv, ItemName);
  1698.       if Srvr <> nil then
  1699.       begin
  1700.         Result := Srvr;
  1701.         Exit;
  1702.       end;
  1703.     end;
  1704.   end;
  1705. end;
  1706.  
  1707. function TDdeSrvrConv.GetItem(const ItemName: string): TDdeSrvrItem;
  1708. var
  1709.   I: Integer;
  1710.   Item: TDdeSrvrItem;
  1711. begin
  1712.   Result := nil;
  1713.   for I := 0 to FItems.Count - 1 do
  1714.   begin
  1715.     Item := FItems[I];
  1716.     If Item.Item = ItemName then
  1717.     begin
  1718.       Result := Item;
  1719.       Exit;
  1720.     end;
  1721.   end;
  1722. end;
  1723.  
  1724. function TDdeSrvrConv.GetSrvrItem(hszItem: HSZ): TDdeSrvrItem;
  1725. var
  1726.   I: Integer;
  1727.   Item: TDdeSrvrItem;
  1728. begin
  1729.   Result := nil;
  1730.   for I := 0 to FItems.Count - 1 do
  1731.   begin
  1732.     Item := FItems[I];
  1733.     If DdeCmpStringHandles(Item.HszItem, hszItem) = 0 then
  1734.     begin
  1735.       Result := Item;
  1736.       Exit;
  1737.     end;
  1738.   end;
  1739. end;
  1740.  
  1741. constructor TDdeSrvrItem.Create(AOwner: TComponent);
  1742. begin
  1743.   FConv := TDdeSrvrConv(AOwner);
  1744.   inherited Create(AOwner);
  1745. end;
  1746.  
  1747. destructor TDdeSrvrItem.Destroy;
  1748. begin
  1749.   if FHszItem <> 0 then
  1750.   begin
  1751.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
  1752.     FHszItem := 0;
  1753.   end;
  1754.   inherited Destroy;
  1755. end;
  1756.  
  1757. function TDdeSrvrItem.RequestData(Fmt: Word): HDdeData;
  1758. var
  1759.   Data: string;
  1760.   Buffer: array[0..4095] of Char;
  1761. begin
  1762.   Result := 0;
  1763.   SetString(FItem, Buffer, DdeQueryString(ddeMgr.DdeInstId, FHszItem, Buffer,
  1764.     SizeOf(Buffer), CP_WINANSI));
  1765.   if Fmt = CF_TEXT then
  1766.   begin
  1767.     Data := FSrvr.Lines.Text;
  1768.     Result := DdeCreateDataHandle(ddeMgr.DdeInstId, PChar(Data), Length(Data) + 1,
  1769.       0, FHszItem, Fmt, 0 );
  1770.   end;
  1771. end;
  1772.  
  1773. procedure TDdeSrvrItem.PostDataChange;
  1774. begin
  1775.   DdePostAdvise(ddeMgr.DdeInstId, FConv.HszTopic, FHszItem);
  1776. end;
  1777.  
  1778. procedure TDdeSrvrItem.SetItem(const Value: string);
  1779. begin
  1780.   FItem := Value;
  1781.   if FHszItem <> 0 then
  1782.   begin
  1783.     DdeFreeStringHandle(ddeMgr.DdeInstId, FHszItem);
  1784.     FHszItem := 0;
  1785.   end;
  1786.   if Length(FItem) > 0 then
  1787.     FHszItem := DdeCreateStringHandle(ddeMgr.DdeInstId, PChar(FItem), CP_WINANSI);
  1788. end;
  1789.  
  1790. begin
  1791.   ddeMgr := TDdeMgr.Create(Application);
  1792. end.
  1793.  
  1794.