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.
Vorgefundene Kodierung: OEM (CP437) | 1
|
|