Source file: /~heha/messtech/kreuzt.zip/GRILL/ODDE.PAS

unit odde;
{Allgemeiner DDE-Server als Objekt}

interface

uses WinProcs,WinTypes,Win31,Ddeml,Objects;

type
 TDdeMsg=record
  Data2,Data1: LongInt;
  Data: hDdeData;
  Hsz2,Hsz1: hSz;
  Conv: hConv;
  Fmt: Word;
 end;

var
 Inst: LongInt;		{Instanz-Variable ("Handle"), GLOBAL}

type
 PDDE=^TDDE;
 TDDE=object(TObject)
  constructor Init(hInstance:THandle; Cmd:LongInt);
  destructor Done; virtual;
  function _Connect	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _WildConnect	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _ConnectConfirm(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _Disconnect	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _AdvReq	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _AdvData	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _AdvStart	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _AdvStop	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _XActComplete(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _Request	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _Execute	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _Poke	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _Error	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _Monitor	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _Register	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  function _Unregister	(var DdeMsg:TDdeMsg):hDdeData; virtual;
  procedure Error(code:LongInt); virtual; {allgemeiner Ausstieg}
 end;


implementation

var
 Callback: TCallback;	{Zeiger für MakeProcInstance}
 DdeInst: PDDE;		{Zeiger zum Aufruf der Methoden}

{dieses Callback tut nichts anderes, als das im Fensterobjekt
 enthaltene DdeCallback() aufzurufen, um Zugriff auf Objekt-Variablen
 ("Felder") zu haben}
function CallbackProc(CallType,Fmt:Word; Conv:hConv; HSz1,HSz2:HSz;
 Data:hDdeData; Data1,Data2: LongInt): hDdeData; export;
 var
  DdeMsg: TDdeMsg absolute Data2;
	{zeigt kurzerhand auf den Stack, das erspart das Kopieren}
 begin
  case CallType of
   XTYP_Connect:	CallbackProc:=DdeInst^._Connect(DdeMsg);
   XTYP_WildConnect:	CallbackProc:=DdeInst^._WildConnect(DdeMsg);
   XTYP_Connect_Confirm:CallbackProc:=DdeInst^._ConnectConfirm(DdeMsg);
   XTYP_Disconnect:	CallbackProc:=DdeInst^._Disconnect(DdeMsg);
   XTYP_AdvReq:		CallbackProc:=DdeInst^._AdvReq(DdeMsg);
   XTYP_AdvData:	CallbackProc:=DdeInst^._AdvData(DdeMsg);
   XTYP_AdvStart:	CallbackProc:=DdeInst^._AdvStart(DdeMsg);
   XTYP_AdvStop:	CallbackProc:=DdeInst^._AdvStop(DdeMsg);
   XTYP_XAct_Complete:	CallbackProc:=DdeInst^._XActComplete(DdeMsg);
   XTYP_Request:	CallbackProc:=DdeInst^._Request(DdeMsg);
   XTYP_Execute:	CallbackProc:=DdeInst^._Execute(DdeMsg);
   XTYP_Poke:		CallbackProc:=DdeInst^._Poke(DdeMsg);
   XTYP_Error:		CallbackProc:=DdeInst^._Error(DdeMsg);
   XTYP_Monitor:	CallbackProc:=DdeInst^._Monitor(DdeMsg);
   XTYP_Register:	CallbackProc:=DdeInst^._Register(DdeMsg);
   XTYP_Unregister:	CallbackProc:=DdeInst^._Unregister(DdeMsg);
   else			CallbackProc:=0;
  end;
 end;

constructor TDDE.Init;
 begin
  inherited Init;
  if @Callback=nil then
   @Callback:=MakeProcInstance(@CallbackProc,hInstance);
  DdeInst:=@self;		{globale Variable für Callback setzen}
  if DdeInitialize(Inst,CallBack,Cmd,0)<>DMLErr_No_Error then
   Error(DMLErr_Sys_Error);
 end;

destructor TDDE.Done;
 begin
  if Inst<>0 then DdeUninitialize(Inst);
  if @Callback<>nil then FreeProcInstance(@Callback);
  inherited Done;
 end;

function TDDE._Connect;
 begin
  _Connect:=0;
 end;

function TDDE._WildConnect;
 begin
  _WildConnect:=0;
 end;

function TDDE._ConnectConfirm;
 begin
  _ConnectConfirm:=0;
 end;

function TDDE._Disconnect;
 begin
  _Disconnect:=0;
 end;

function TDDE._AdvReq;
 begin
  _AdvReq:=_Request(DdeMsg);	{tut wohl immer dasselbe}
 end;

function TDDE._AdvData;
 begin
  _AdvData:=0;
 end;

function TDDE._AdvStart;
 begin
  _AdvStart:=0;
 end;

function TDDE._AdvStop;
 begin
  _AdvStop:=0;
 end;

function TDDE._XactComplete;
 begin
  _XactComplete:=0;
 end;

function TDDE._Request;
 begin
  _Request:=0;
 end;

function TDDE._Execute;
 begin
  _Execute:=0;
 end;

function TDDE._Poke;
 begin
  _Poke:=0;
 end;

function TDDE._Error;
 begin
  _Error:=0;
 end;

function TDDE._Monitor;
 begin
  _Monitor:=0;
 end;

function TDDE._Register;
 begin
  _Register:=0;
 end;

function TDDE._Unregister;
 begin
  _Unregister:=0;
 end;

procedure TDDE.Error;
 var
  Line: array[byte]of Char;
 begin
  wvsprintf(Line,'Error %ld initializing or using DDE!',Code);
  MessageBox(0,Line,nil,MB_OK or MB_IconExclamation);
 end;

begin
 @Callback:=nil;
 Inst:=0;
end.