Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

RTD Server

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    RTD Server

    Code:
    '**********************************************************************
'* Building a Real-Time Data Server in PowerBasic for Windows
'* Use:
'* After compilation registration in the command line
'* regsvr32 apb.dll is necessary.
'* Start Excel and enter into a cell a line =RTD ("capb";; "AAA")
'* value in a cell should increase each three seconds.
'*
'**********************************************************************
#COMPILE DLL
#DIM ALL
#COM NAME "APB", 1
#COM DOC "RTD server for APB module"
#COM TLIB ON
#INCLUDE "Win32API.inc"
 
' We should create the GUID (identifier) of a class
$CLSID_APB_RTDServer = GUID$("{C42F3EBF-BA7E-4623-BABC-AF3CFBF9DF8B}")
' Identifiers of interfaces are already set by developers of these interfaces
$IID_APB_IRTDServer = GUID$("{EC0E6191-DB51-11D3-8F3E-00C04F3651B8}")
$IID_APB_IRTDUpdateEvent = GUID$("{A43788C1-D91B-11D3-8F39-00C04F3651B8}")
 
' Further we shall declare interface IRTDUpdateEvent
' to get access to method UpdateNotify ().
INTERFACE IRTDUpdateEvent $IID_APB_IRTDUpdateEvent
INHERIT IDISPATCH
METHOD UpdateNotify()
METHOD Disconnect()
PROPERTY GET HeartbeatInterval() AS LONG
END INTERFACE
GLOBAL m_callback AS IRTDUpdateEvent
 
' Structure Ttag is necessary for imitation of data of real time
[FONT=Courier New]TYPE Ttag[/FONT]
[FONT=Courier New] idx AS INTEGER ' The identifier[/FONT]
[FONT=Courier New] nam AS ASCIIZ*32 ' name of tag[/FONT]
[FONT=Courier New] enb AS INTEGER ' Flag of connection tag to Excel[/FONT]
[FONT=Courier New]END TYPE[/FONT]
 
' In this example will be three tags,
' their values will be stored in variables va, vb and vc.
GLOBAL atag() AS Ttag
GLOBAL va, vb, vc AS INTEGER
 
'**************************************************
'* Further the code of class an RTD server begins *
'**************************************************
CLASS CAPB $CLSID_APB_RTDServer AS COM
INSTANCE hTimer AS LONG
 
' In method CREATE it is initialized variables
[FONT=Courier New]CLASS METHOD CREATE[/FONT]
[FONT=Courier New] LOCAL i AS INTEGER[/FONT]
[FONT=Courier New] REDIM atag (2) AS Ttag[/FONT]
[FONT=Courier New] FOR i=0 TO 2[/FONT]
[FONT=Courier New]   atag(i).enb = 0[/FONT]
[FONT=Courier New] NEXT i[/FONT]
[FONT=Courier New] va=0: vb=0: vc=0[/FONT]
[FONT=Courier New]END METHOD[/FONT]
 
' Here begins realizations of interface IRTDServer
INTERFACE IRTDServer $IID_APB_IRTDServer
INHERIT IDISPATCH
 
METHOD ServerStart (BYVAL CallbackObject AS IRTDUpdateEvent) AS LONG
[FONT=Courier New] m_callback = CallbackObject[/FONT]
[FONT=Courier New] ' We create the timer[/FONT]
[FONT=Courier New] ' which each three seconds will change values of variables   va, vb and vc,[/FONT]
[FONT=Courier New] ' and then to notify Excel on this change.[/FONT]
[FONT=Courier New] hTimer = SetTimer( 0, 101, 3000, CODEPTR(TimerProc))[/FONT]
[FONT=Courier New] METHOD = 1[/FONT]
[FONT=Courier New] METHOD OBJRESULT = 0[/FONT]
[FONT=Courier New]END METHOD[/FONT]
 
[FONT=Courier New]METHOD ServerTerminate ()[/FONT]
[FONT=Courier New] KillTimer(0,101)[/FONT]
[FONT=Courier New] CloseHandle(hTimer)[/FONT]
[FONT=Courier New] METHOD OBJRESULT = 0[/FONT]
[FONT=Courier New]END METHOD[/FONT]
 
METHOD ConnectData (BYVAL TopicID AS LONG, _
[FONT=Courier New] BYVAL nam AS VARIANT, _[/FONT]
[FONT=Courier New] BYREF INOUT GetNewValues AS INTEGER) AS VARIANT[/FONT]
[FONT=Courier New] LOCAL V AS VARIANT[/FONT]
[FONT=Courier New] LOCAL ss AS STRING[/FONT]
[FONT=Courier New] LOCAL i AS INTEGER[/FONT]
[FONT=Courier New] LOCAL x() AS VARIANT[/FONT]
[FONT=Courier New] REDIM x(0 TO 27) AS VARIANT ' The name of tag can consist of 28 words[/FONT]
[FONT=Courier New] LET x() = nam[/FONT]
[FONT=Courier New] ' We use for a name of tag only the first word[/FONT]
[FONT=Courier New] ss = VARIANT$(x(0))[/FONT]
[FONT=Courier New] ' Let's serve only tags with names AAA, BBB, CCC.[/FONT]
[FONT=Courier New] IF (ss = "AAA") OR (ss = "BBB") OR (ss = "CCC") THEN[/FONT]
[FONT=Courier New]   GetNewValues = 1[/FONT]
[FONT=Courier New]   FOR i=0 TO 2[/FONT]
[FONT=Courier New]     IF atag(i).enb = 0 THEN[/FONT]
[FONT=Courier New]       atag(i).enb = 1[/FONT]
[FONT=Courier New]       atag(i).idx = TopicID[/FONT]
[FONT=Courier New]       atag(i).nam = ss[/FONT]
[FONT=Courier New]       V = getTagValue(ss)[/FONT]
[FONT=Courier New]       METHOD = V[/FONT]
[FONT=Courier New]       EXIT FOR[/FONT]
[FONT=Courier New]     END IF[/FONT]
[FONT=Courier New]   NEXT i[/FONT]
[FONT=Courier New]   METHOD OBJRESULT = 0[/FONT]
[FONT=Courier New] ELSE[/FONT]
[FONT=Courier New]   METHOD OBJRESULT = -1[/FONT]
[FONT=Courier New] END IF[/FONT]
[FONT=Courier New]END METHOD[/FONT]
 
[FONT=Courier New]METHOD DisconnectData (BYVAL TopicID AS LONG)[/FONT]
[FONT=Courier New] LOCAL i AS INTEGER[/FONT]
[FONT=Courier New] FOR i=0 TO 2[/FONT]
[FONT=Courier New]   IF atag(i).enb = 0 THEN ITERATE FOR[/FONT]
[FONT=Courier New]   IF atag(i).enb = TopicID THEN[/FONT]
[FONT=Courier New]     atag(i).enb = 0[/FONT]
[FONT=Courier New]     EXIT FOR[/FONT]
[FONT=Courier New]   END IF[/FONT]
[FONT=Courier New] NEXT i[/FONT]
[FONT=Courier New] METHOD OBJRESULT = 0[/FONT]
[FONT=Courier New]END METHOD[/FONT]
 
[FONT=Courier New]METHOD Heartbeat (BYREF pfRes AS LONG)[/FONT]
[FONT=Courier New] pfRes = 1[/FONT]
[FONT=Courier New] METHOD OBJRESULT = 0[/FONT]
[FONT=Courier New]END METHOD[/FONT]
 
[FONT=Courier New]METHOD RefreshData (BYREF INOUT TopicCount AS LONG) AS VARIANT[/FONT]
[FONT=Courier New] LOCAL V AS VARIANT[/FONT]
[FONT=Courier New] LOCAL i,n AS INTEGER[/FONT]
[FONT=Courier New] LOCAL ss AS STRING[/FONT]
[FONT=Courier New] REDIM dat(0 TO 1, 0 TO 2) AS VARIANT[/FONT]
[FONT=Courier New] n=0[/FONT]
[FONT=Courier New] FOR i=0 TO 2[/FONT]
[FONT=Courier New]   IF atag(i).enb = 0 THEN ITERATE FOR[/FONT]
[FONT=Courier New]   ' We transfer values only for connected tag[/FONT]
[FONT=Courier New]   dat(0, n) = atag(i).idx[/FONT]
[FONT=Courier New]   ss = atag(i).nam[/FONT]
[FONT=Courier New]   V = getTagValue(ss)[/FONT]
[FONT=Courier New]   dat(1, n) = V[/FONT]
[FONT=Courier New]   INCR n[/FONT]
[FONT=Courier New] NEXT i[/FONT]
[FONT=Courier New] TopicCount = n[/FONT]
[FONT=Courier New] METHOD = dat()[/FONT]
[FONT=Courier New] METHOD OBJRESULT = 0[/FONT]
[FONT=Courier New]END METHOD[/FONT]
 
[FONT=Courier New]END INTERFACE[/FONT]
[FONT=Courier New]END CLASS[/FONT]
 
'***********************************************
'* The timer updates tag values
'* and gives out in Excel the notice on it
'***********************************************
[FONT=Courier New]FUNCTION TimerProc() AS LONG[/FONT]
[FONT=Courier New] CALL UpdateTags()[/FONT]
[FONT=Courier New] m_callback.UpdateNotify()[/FONT]
[FONT=Courier New] TimerProc = 1[/FONT]
[FONT=Courier New]END FUNCTION[/FONT]
 
'***********************************************
'* Returns value of tag on its name *
'***********************************************
[FONT=Courier New]FUNCTION getTagValue(ss AS STRING) AS INTEGER[/FONT]
[FONT=Courier New]SELECT CASE ss[/FONT]
[FONT=Courier New]  CASE "AAA"[/FONT]
[FONT=Courier New]    getTagValue = va[/FONT]
[FONT=Courier New]  CASE "BBB"[/FONT]
[FONT=Courier New]    getTagValue = vb[/FONT]
[FONT=Courier New]  CASE "CCC"[/FONT]
[FONT=Courier New]    getTagValue = vc[/FONT]
[FONT=Courier New] END SELECT[/FONT]
[FONT=Courier New]END FUNCTION[/FONT]
 
SUB UpdateTags()
  va += 1: vb += 10: vc += 100
END SUB
    Last edited by Viktor Zabolotskiy; 9 Nov 2009, 10:36 AM. Reason: Formatting
    Tags: rtd com
  • #2
    There is an error in this code concerning the Heartbeat method, it should be:

    Code:
    METHOD Heartbeat() AS LONG
    METHOD = 1
    METHOD OBJRESULT = 0
END METHOD
    also, the interface irtdupdateevent only requires the METHOD UpdateNotify()
    Last edited by Philip Wittamore; 13 May 2013, 03:32 PM.

    Comment

    Previous template Next
    Working...
    X

    We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

    By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

    I Agree