GCW Games & More & Wacky Windows Companion/gcw.iso/win/util/mygroups/dde.pas

Pascal/Delphi Source File | 1994-06-03 | 5.3 KB | 200 lines

Unit DDE;
{Implements an object wrapper around some common DDE functions}

Interface

Uses WinTypes, DDEML,
   {$IFDEF VER70} Objects; {$ELSE} WObjects; {$ENDIF}

Type PDDE = ^TDDE;
     TDDE = Object(TObject)
            Inst:LongInt;         {Instance ID returned by DDML lib}
            Conv:hConv;           {Handle to current conversation}
            CBF:TFarProc;         {Procedure instance to callback function}
            Initialized:Boolean;  {True if object is initialized successfully}
            Timeout:LongInt;      {Timeout value for a DDE command}
            PResponse:Pointer;    {Pointer to data returned from a DDE request}
            ResponseLen:LongInt;  {Length of data pointed to by PResponse}

            Constructor Init(CallBack:Pointer; Mask:LongInt);
            Destructor Done; Virtual;
            Function Connect(Service,Topic:PChar):Boolean;
            Procedure Disconnect;
            Procedure SetTimeout(TOut:LongInt);
            Function Request(Item:PChar; Format:Word; Var Len:LongInt):Pointer;
            Function Execute(Com:PChar; Format:Word):LongInt;
            Procedure FreeRequest;
            Function LastError:Word;
            End;

Implementation

Uses WinProcs;

Function DDE_CB(CallType, Fmt: Word; Conv: HConv; hsz1, hsz2: HSZ;
          Data: HDDEData; Data1, Data2: Longint): HDDEData; Export;
{The DDE callback function. This function just returns zero for all
 callbacks. It can be overridden if another response is needed}

   Begin
   DDE_CB:=HDDEData(0);
   End;

Constructor TDDE.Init(CallBack:Pointer; Mask:LongInt);
{Initialize the DDE object.

 Input:  CallBack: Pointer to a callback procedure. If Nil, default is used.
         Mask: Flags passed to DDEInitialize. See SDK manual}

   Begin
   TObject.Init;
   Initialized:=False;
   Inst:=0;
   Conv:=0;
   Timeout:=1000;
   PResponse:=Nil;
   ResponseLen:=0;
   If CallBack = Nil then
      CBF:=MakeProcInstance(@DDE_CB,hInstance)
   else
      CBF:=MakeProcInstance(CallBack,hInstance);
   If DdeInitialize(Inst,TCallBack(CBF),Mask,0) <> 0 then
      Begin
      Done;
      Fail;
      End;
   Initialized:=True;
   End;

Destructor TDDE.Done;
{Disconnect is necessary. Free any memory and wrap up the object}

   Begin
   If Initialized then
      Begin
      If Conv <> 0 then
         Disconnect;
      If PResponse <> Nil then
         FreeMem(PResponse,ResponseLen);
      DdeUninitialize(Inst);
      Initialized:=False;
      End;
   FreeProcInstance(CBF);
   TObject.Done;
   End;

Function TDDE.Connect(Service,Topic:PChar):Boolean;
{Connect to a DDE server.
 Returns true if successful.

 Input: Service - Name of DDE service (i.e. PROGMAN)
        Topic - Name of DDE topic (i.e. PROGMAN)}

Var hszService,hszTopic:HSZ;

   Begin
   Connect:=False;
   If Conv <> 0 then Exit;
   hszService:=DdeCreateStringHandle(Inst,Service,cp_WinAnsi);
   hszTopic:=DdeCreateStringHandle(Inst,Topic,cp_WinAnsi);
   Conv:=DdeConnect(Inst,hszService,hszTopic,Nil);
   DdeFreeStringHandle(Inst,hszService);
   DdeFreeStringHandle(Inst,hszTopic);
   Connect:=Conv <> 0;
   End;

Procedure TDDE.Disconnect;
{Disconnect any current DDE conversation}

   Begin
   If Conv <> 0 then
      DdeDisconnect(Conv);
   Conv:=0;
   End;

Procedure TDDE.SetTimeout(TOut:LongInt);
{Set the timeout for any DDE command

 Input: TOut - Timeout}

   Begin
   Timeout:=TOut;
   End;

Function TDDE.Request(Item:PChar; Format:Word; Var Len:LongInt):Pointer;
{Send a DDE request to the current server.
 Returns a pointer to the result.

 Input:  Item - Pointer to the DDE request string
         Format - One of the cf_XXXX IDs describing the format of the
                  input string (i.e. cf_Text)
 Output: Len - Length of result}

Var P1:Pointer;
    hszItem:HSZ;
    hData:HDDEData;
    Result:LongInt;

   Begin
   Request:=Nil;
   If Conv = 0 then Exit;
   hszItem:=DdeCreateStringHandle(Inst,Item,cp_WinAnsi);
   hData:=DdeClientTransaction(Nil,0,Conv,hszItem,Format,xtyp_Request,
      Timeout,@Result);
   DdeFreeStringHandle(Inst,hszItem);
   If hData = 0 then Exit;
   If PResponse <> Nil then
      Begin
      FreeMem(PResponse,ResponseLen);
      PResponse:=Nil;
      End;
   P1:=DdeAccessData(hData,@Len);
   GetMem(PResponse,Len);
   If PResponse <> Nil then
      Move(P1^,PResponse^,Len);
   ResponseLen:=Len;
   DdeUnaccessData(hData);
   DdeFreeDataHandle(hData);
   Request:=PResponse;
   End;

Function TDDE.Execute(Com:PChar; Format:Word):LongInt;
{Send a DDE command to a server.
 Returns the error code, if any.

 Input:  Com - Command string
         Format - Format of command string (i.e. cf_Text)}

Var Result:LongInt;

   Begin
   Execute:=0;
   If Conv = 0 then Exit;
   DdeClientTransaction(Com,lstrlen(Com)+1,Conv,0,Format,xtyp_Execute,
      Timeout,@Result);
   Execute:=Result;
   End;

Procedure TDDE.FreeRequest;
{Frees the memory occupied by the response to the latest DDE request}

   Begin
   If PResponse <> Nil then
      Begin
      FreeMem(PResponse,ResponseLen);
      PResponse:=Nil;
      ResponseLen:=0;
      End;
   End;

Function TDDE.LastError:Word;
{Returns the most recent DDE error}

   Begin
   If Inst <> 0 then
      LastError:=DdeGetLastError(Inst)
   else
      LastError:=0;
   End;

End.