PowerBasic to FreeBasic Conversion

New to FreeBASIC? Post your questions here.
ZoSo
Posts: 2
Joined: Jul 19, 2008 17:20

PowerBasic to FreeBasic Conversion

Postby ZoSo » Aug 12, 2008 21:18

I'd like to say from the beginning that I am not a programmer by trade. I'm a systems puke (AIX) that programs (scripts) as one of my functions in life. I'm used to using KSH, Python and Perl. With each of these, I learned them by having to tackle a particular problem(s) vs taking classes or just reading books. With that in mind...

I've chosen stock trading as a nice way to pass the time and my current platform allows external DLLs to be linked into it. There is a working example of a DLL written in PowerBasic that I'd like to be able to convert to FreeBasic. This example was written by Roger Rines and is licensed under the GNU Lesser General Public License. If I can receive help getting this to work, I'd like to be able to tell the platform forums members about FreeBasic while providing the converted example. The trading platform is TradeStation and the example DLL is called PB-Bones and is posted on the PowerBasic download pages.

Any masochistic individuals out there with a high pain threshold?
MystikShadows
Posts: 612
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Aug 13, 2008 0:08

I downloaded the PB-Bones zip file I'm gonna look at it, see what and how much work we're talking about here. ;).

Then I'll compare that to my pain threshold. LOL

I'll see what I can do with it and I'll let you know.
Imortis
Moderator
Posts: 1734
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Postby Imortis » Aug 13, 2008 0:32

I have gotten the code MOSTLY correct. If someone could tell me why it wants PB-BONES.DLL, we can work it out.

PB-Bones.bi

Code: Select all

' Main source code file:  C:\dev\pb-dev\DLLs\PB DLL 4 TS\PB-Bones.BAS
' Resulting include file: C:\dev\pb-dev\DLLs\PB DLL 4 TS\PB-Bones.INC
'
' Created by inClean v1.25, 07-28-2003, 10:43:22
' Press Help-button for some useful information and tips.
'
'  60228 lines of include file data read and compared against
'   1481 lines of code in 0.97 seconds.
'
'-----------------------------------------------------------------
' Equates:  6
'-----------------------------------------------------------------
Const WINAPI               = 1
Const ERRORINVALIDBLOCK      = 9
Const DLLPROCESSDETACH      = 0
Const DLLPROCESSATTACH      = 1
Const DLLTHREADATTACH      = 2
Const DLLTHREADDETACH      = 3

'Converted to FB by Imortis Inglorian
'Date: 08-12-08


EL_Globals.bi

Code: Select all

'  EL_Globals.INC                  TradeStation PowerBASIC DLL Template INC
'  ---------------
'  Version  1.0.0 - 27-June-2003
'
'  Copyright (C) 2003  Roger D. Rines
'
'  emailto:rdrines@spamcop.net?Subject[PB-Bones]
'  =============================================================================
'
'   This library is free software; you can redistribute it and/or
'   modify it under the terms of the GNU Lesser General Public
'   License as published by the Free Software Foundation; either
'   version 2.1 of the License, or (at your option) any later version.
'
'   This library is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
'   Lesser General Public License for more details.
'
'   You can read the full GPL Lesser General Public License here:
'   http://www.gnu.org/copyleft/lesser.html
'
'   Or, you should have received a copy of the GNU Lesser General Public
'   License along with this library; if neither happen, you can write to
'   the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
'   Boston, MA  02111-1307  USA
'
'  USE:
'  =============================================================================
'
'  This source file is a PowerBASIC model that is compatible with Omega's
'  TradeStation software.  This code must be used with the PB-Bones.BAS file
'  so the external functions listed here will be meaningful to the DLL.
'
'  PB-Bones.BAS is intended to be a PowerBASIC code-skeleton for creating
'  TradeStation compatible DLL modules.  Nothing in this code is considered final
'  but everything has been tested to see if it would work reliably for the task.
'
'  When this template was published, PowerBASIC's PBWin/DLL version was 7.02.
'  To use this code, you'll probably need to have that version of the
'  PowerBASIC PBWIN/DLL 32-bit compiler to get the same results.
'
'  If you find an error, or know of an enhancement that should be added to this
'  template, your comments will be warmly received and considered for inclusion
'  into this source.  Please send your comments to my email address listed above.
'
'  PURPOSE:
'  =============================================================================
'  This module creates a series of GLOBAL Arrays that can be indexed and used
'  store information.  In this module, there are global elements that can be
'  accessed by all processes and some that are restricted to processes that keep
'  their global index assignment private.
'
'  Because memory is allocated when the DLL is attached to TradeStation, it must
'  be initialized at binding so that memory access violation doesn't occur.
'
'  Later, if a more dynamic memory model is needed, a simple client process can
'  triggered to handle storage and retrieval of global values.
'
'  =============================================================================
'  EXPOSED DEFINITIONS
'  =============================================================================
Declare Function ClearFloat (ByVal ElementIndex As Long) As Long
Declare Function PutFloat (ByVal FloatValPtr As Dword Ptr, ByVal ElementIndex As Long) As Long
Declare Function GetFloat (ByVal ElementIndex As Long) AS Single
Declare Function GetString (ByVal ElementIndex As Long) AS String

'  =============================================================================
'  GLOBAL VARIABLE DEFINITIONS
'  =============================================================================

Const EL_Globals_Loaded = -1         '  Constant Assignment that communicates this file
                                    '  Loaded in the INCLUDE files.
Const MaxGlobalElements = 100
Const GlobalArrayStart = 0
Const ERR_SUBSCRIPT_POINTER_OUT_OF_RANGE = ERROR_INVALID_BLOCK

Type StringRecord
   Text1 AS STRING * 25
End Type

Dim Shared glStr() AS StringRecord
Dim SHared gFloat() AS SINGLE
     

'  =============================================================================
'     Local Functions and Subs
'  =============================================================================
Declare Sub InitializeGlobals
Declare Function ClearGlobalElement (ElementIndex AS LONG) AS LONG
       
       
'  =============================================================================
'     Global Handler for PB-BONES.DLL Template
'  =============================================================================

'  -----------------------------------------------------------------------------
'  When the DLL is attached and a DLL_PROCESS_ATTACH message is detected, this
'  SUB must be triggered so the DLL can create enough memory space to handle the
'  global elements requirements.
'
Sub InitializeAllGlobals
   
   '  Size the Globals
   ReDim glStr(GlobalArrayStart TO MaxGlobalElements)
   ReDim gFloat(GlobalArrayStart TO MaxGlobalElements)
   
   '  Add whatever else needs to happen here
         
End Sub  '  InitializeGlobals


'  -----------------------------------------------------------------------------
'  This FUNCTION is used to Clear the values from all Global elements assigned
'  to a process ID Index.  By clearing these elements, they can be used by other 
'  processes that might come along later. 
'
Function ClearFloat (ByVal ElementIndex As Long) As Long Export

   If ElementIndex >= GlobalArrayStart And ElementIndex <= MaxGlobalElements Then
      gFloat(ElementIndex) = 0
      Function = 0                                 '  Zero Return Indicates no ERROR
   Else
      Function = ERR_SUBSCRIPT_POINTER_OUT_OF_RANGE   '  Return Error Value
   End If

End Function   '  ClearGlobalElement


'  -----------------------------------------------------------------------------
'  This FUNCTION is used to place a Long value in a Global element assigned
'  to a process ID Index.  The value assignment is placed in a wrapper FUNCTION 
'  to prevent a program process attempting to assign values to elements not within
'  the GLOBAL array dimension range. 
'
Function PutFloat (ByVal FloatValPtr As Dword Ptr, ByVal ElementIndex As Long) As Long Export
   
   If ElementIndex >= GlobalArrayStart And ElementIndex <= MaxGlobalElements Then
     
      gFloat(ElementIndex) = Cast(Dword, @FloatValPtr)
      Function = 0                                 '  Zero Return Indicates no ERROR
   Else
      Function = ERR_SUBSCRIPT_POINTER_OUT_OF_RANGE '  Return Error Value
   End If

End Function   '  ClearGlobalElement


'  -----------------------------------------------------------------------------
'  This FUNCTION is used to retrieve a values from a Global element assigned
'  to a process ID Index.  By using a wrapper FUNCTION, a dimension range test
'  can be performed so an out of bounds error isn't created should the calling
'  program request an element index location not within the Global array range. 
'
Function GetFloat (ByVal ElementIndex As Long) As Single Export
   
   If ElementIndex >= GlobalArrayStart And ElementIndex <= MaxGlobalElements Then
      Function = gFloat(ElementIndex)     
   Else
      Function = 0                     '  Zero Return Indicates possible ERROR
   End If

End Function   '  ClearGlobalElement

'============================================
'============================================
'  -----------------------------------------------------------------------------
'  This FUNCTION is used to Clear the values from all Global elements assigned
'  to a process ID Index.  By clearing these elements, they can be used by other 
'  processes that might come along later. 
'
'FUNCTION ClearFloat (BYVAL ElementIndex AS LONG) EXPORT AS LONG
'
'   IF ElementIndex >= %GlobalArrayStart AND ElementIndex <= %MaxGlobalElements THEN
'      gFloat(ElementIndex) = 0
'      FUNCTION = 0                                 '  Zero Return Indicates no ERROR
'   ELSE
'      FUNCTION = %ERR_SUBSCRIPT_POINTER_OUT_OF_RANGE   '  Return Error Value
'   END IF
'
'END FUNCTION   '  ClearGlobalElement


'  -----------------------------------------------------------------------------
'  This FUNCTION is used to place a Long value in a Global element assigned
'  to a process ID Index.  The value assignment is placed in a wrapper FUNCTION 
'  to prevent a program process attempting to assign values to elements not within
'  the GLOBAL array dimension range. 
'
Function PutString (ByVal FloatValPtr As Dword Ptr, ByVal ElementIndex As Long) As Long Export
   
   If ElementIndex >= GlobalArrayStart And ElementIndex <= MaxGlobalElements Then
     
      gFloat(ElementIndex) = Cast(Dword, @FloatValPtr)
      Function = 0                                 '  Zero Return Indicates no ERROR
   Else
      Function = ERR_SUBSCRIPT_POINTER_OUT_OF_RANGE   '  Return Error Value
   End If

End Function   '  ClearGlobalElement


'  -----------------------------------------------------------------------------
'  This FUNCTION is used to retrieve a values from a Global element assigned
'  to a process ID Index.  By using a wrapper FUNCTION, a dimension range test
'  can be performed so an out of bounds error isn't created should the calling
'  program request an element index location not within the Global array range. 
'
Function GetString (ByVal ElementIndex As Long) As String Export
   
   If ElementIndex >= GlobalArrayStart And ElementIndex <= MaxGlobalElements Then
      Function = glStr(ElementIndex).Text1
   Else
      Function = ""                     '  Zero Return Indicates possible ERROR
   End If

End Function   '  ClearGlobalElement
'  =============================================================================
'     END OF CODE for EL_Globals.INC
'  =============================================================================

'Converted to FB by Imortis Inglorian
'Date: 08-12-08


PB-Add-Free.bi

Code: Select all

'  =============================================================================
'  PB-Add-Free.INC                   TradeStation PowerBASIC DLL Template INC
'  ---------------
'  Version  1.0.0 - 27-June-2003
'
'  Copyright (C) 2003  Roger D. Rines
'
'  emailto:rdrines@spamcop.net?Subject[PB-Bones]
'  =============================================================================
'
'   This library is free software; you can redistribute it and/or
'   modify it under the terms of the GNU Lesser General Public
'   License as published by the Free Software Foundation; either
'   version 2.1 of the License, or (at your option) any later version.
'
'   This library is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
'   Lesser General Public License for more details.
'
'   You can read the full GPL Lesser General Public License here:
'   http://www.gnu.org/copyleft/lesser.html
'
'   Or, you should have received a copy of the GNU Lesser General Public
'   License along with this library; if neither happen, you can write to
'   the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
'   Boston, MA  02111-1307  USA
'
'  USE:
'  =============================================================================
'
'  This source file is a PowerBASIC model that is compatible with Omega's
'  TradeStation software.  This code must be used with the PB-Bones.BAS file
'  so the external functions listed here will be meaningful to the DLL.
'
'  PB-Bones.BAS is intended to be a PowerBASIC code-skeleton for creating
'  TradeStation compatible DLL modules.  Nothing in this code is considered final
'  but everything has been tested to see if it would work reliably for the task.
'
'  When this template was published, PowerBASIC's PBWin/DLL version was 7.02.
'  To use this code, you'll probably need to have that version of the
'  PowerBASIC PBWIN/DLL 32-bit compiler to get the same results.
'
'  If you find an error, or know of an enhancement that should be added to this
'  template, your comments will be warmly received and considered for inclusion
'  into this source.  Please send your comments to my email address listed above.
'


'  =============================================================================
'  EXPOSED DEFINITIONS
'  =============================================================================
 
Declare Sub Dll_Add Lib "PB-BONES.DLL" Alias "Dll_Add" (ByVal elThreadId As Dword)
Declare Sub Dll_Free Lib "PB-BONES.DLL" Alias "Dll_Free" (ByVal elThreadId As Dword)
Declare Sub Dll_Context Lib "PB-BONES.DLL" Alias "Dll_Context" (ByVal elThreadId As Dword)

Declare Function GetIDNumIndex(ByVal ELIdNum As Long) As Long


'  =============================================================================
'  GLOBAL VARIABLE DEFINITIONS
'  =============================================================================

Const PB_Add_Free = -1               '  Constant Assignment that communicates this file
                                    '  Loaded in the INCLUDE files.

Const MaxScreenNums = 10            '  Arbitrary value to limit the Maximum number of
                                    '  processes that can reliably attach to this program.
                             

Type EL_ProcessRecord               '  UDT Record to manage process ID values
   hID As Long                        '  ID Value submitted to DLL_ADD
   hIndex As Long                     '  Element Location Index reference
   hUsed As Byte                     '  FLAG to show previous use
End Type


'  Record Array to hold the Process ID Number and its Index location.
Dim Shared TsID () As EL_ProcessRecord '  Keep ZERO Position for Error Location

Dim Shared elID As Dword          '  Holds current EL-Instance Handle

'  Counts of the # of times an EL-Instance calls one of the Thread routines - Debug
Dim Shared AddCount As LongInt, FreeCount As LongInt, ContextCount As LongInt


Dim Shared IdIndex As Long
Dim Shared WorkID As Long
Dim Shared LastAddID As Long, LastContextID As Long, LastFreeID As Long
Dim Shared LogMsg As String

'  =============================================================================
'     Local Functions and Subs
'  =============================================================================

Declare Function StoreELID(ELIDNum As Long) As Long
Declare Function GetNextIndex(CurrentIndex As Long) As Long
Declare Function RemoveIDNum(ELIdNum As Long) As Long
Declare Function FindIDNum(ELIDNum As Long) As Long
Declare Sub InitIdRecords


'  =============================================================================
'     Dll_Add, Dll_Context & Dll_Free  - Call by Easy Language hidden processes
'  =============================================================================
'
'  If these SUB - Routines are not exposed or included in a DLL, Easy Language
'  ignores them, but the programmer looses the ability to syncronize and direct
'  calls from the various workspaces because the calling ID will be lost.

'  ....................
'  Used to initialize, a thread space, mutex or semiphore
'  This SUB is called when the program that uses this DLL becomes active in the
'  chart space.
'
Sub Dll_Add(ByVal elThreadId As Dword) Export   '  Establish Space for ID#

   elID = elThreadId
   AddCount += 1

   If ElID = LastAddID Then
      '   Don't Change the Index value or look it up

      LogMsg = "Dll_Add - CallCount = " +_
               Str(AddCount) +_
               "  elID =" + Str(elThreadId)+_
               " Ignore This Call"                                '  - Debug

   Else
      '  This ID Number is different, check it out for storage action
      LastAddID = ElID                         '  Keep an ID copy
      IDIndex = StoreELID( ElID)               '  Store Current ID Index

      LogMsg = "Dll_Add - CallCount = " + Str(AddCount) +_
            "  elID =" + Str(elThreadId) +_
             " ID Index=" + Str(IDIndex)                         '  - Debug
   End If   '  ElID = LastAddID

   WriteLog( LogMsg)                                        '  - Debug
End Sub  '  Dll_Add

'  ....................
'  Used to direct calls to a thread space, mutex or semiphore
'  This SUB is called each time a program wants information from the DLL, which in
'  many, if not most, case is once for each bar loaded into the chart space.
'  In other words, this SUB gets called a lot of time for each chart space.
'
Sub Dll_Context(ByVal elThreadId As Dword) Export  '   Direct work to space ID#

   elID = elThreadId
   ContextCount += 1

   If ElID = LastAddID Then
     '   Don't Change the Index value or look it up

      LogMsg = "Dll_Context - ID No Change!"    '  - Debug

   Else
      '  This ID Number is different, check it out for storage action
      LastAddID = ElID                         '  Keep an ID copy
      IDIndex = StoreELID( ElID)               '  Store Current ID Index

      LogMsg = "Dll_Context - CallCount ="_
               + Str(ContextCount) +_
               "  elID =" + Str(elThreadId) +_
               " ID Index=" + Str(IDIndex)                       '  - Debug
   End If   '  ElID = LastAddID

   WriteLog( LogMsg)                                        '  - Debug
End Sub  '  Dll_Context

'  ....................
'  Used to terminate a thread space, mutex or semiphore
'  For each time Dll_Add is called, a new ID# is issued.  For each ID# issued,
'  this SUB is called when the status of the programs are turned off, or the chart
'  is closed.  There will always be an equal number of calls to this SUB as there are
'  the Dll_Add SUB.
'
Sub Dll_Free(ByVal elThreadId As Dword) Export  '  Terminate Protected Space for an ID#
   Dim hIndex As Long

   elID = elThreadId
   FreeCount += 1

   '  Remove this ID Number from the place holder list
   hIndex = RemoveIDNum(elID)

   LogMsg = "Dll_Free - CallCount = " + Str(FreeCount) +_      '  - Debug
          "  elID =" + Str(elThreadId)+ " hIndex=" + Str(hIndex)'  - Debug
       WriteLog( LogMsg)                                        '  - Debug
End Sub  '  Dll_Free



'  =============================================================================
'                 ID Handling Routines
'  =============================================================================

'  -----------------------------------------------------------------------------
'  This Function is called by DLL_ADD and returns ZERO if it is successful

Function StoreELID( ELIDNum As Long) As Long
   Dim IDTest As Long

   '  Check to be sure ID number hasn't been given before - Error Check
   IDTest = FindIDNum(ELIDNum)

   If IDTest = 0 Then   '  Number wasn't found in the list

      '  Look for next available Index location
      IdIndex = GetNextIndex(IdIndex)

      '  Store the TradeStation ID number in an element of the array
      TSID(IdIndex).hID = ELIDNum

      '  Turn In-Use FLAG ON
      TSID(IdIndex).hUsed = 1

      Function = IdIndex
   Else
      ' If you get here, you are in trouble
'      MSGBOX "This number:" + STR$(ELIDNum) + " was used before!"        ' - Debug

      '  When we get here, we either panic or get creative in how to handle the
      '  ID duplication.  A way to handle it is to clear the variables for working array
      '  data array assigned to that ID series.

      '  I don't know if a screen is closed whether EL will re-use ID numbers.  I haven't
      '  seen it with my testing, but that hasn't been exhaustive

      '  If they do re-use them, then removing them when the EL-screen is closed is best
      Function = IDTest
   End If

End Function   '  StoreELID

'  -----------------------------------------------------------------------------
'  This Function locates the next available Index location
'
Function GetNextIndex(CurrentIndex As Long) As Long
   Dim TempIndex As Long
   Dim ElNum As Long
   Dim NextID As Long
   Dim LoopCount As Long

   If CurrentIndex <= MaxScreenNums And CurrentIndex > 0 Then '  Are we below the Processing Limit?
      TempIndex = CurrentIndex            '  If yes, begin looking here
   Else
      TempIndex = 1                       '  Start at the beginning hoping for a hole
   End If   '  CurrentIndex <= %MaxScreenNums

   LoopCount = 0
   NextID = 0

   '  Search Index Array for next available Index
   For ElNum = TempIndex To MaxScreenNums

      If TSID(ElNum).hID = 0 Then         '  If we find an open Element,...
        NextID = TSID(ElNum).hIndex       '  Use the Index Value associated with it
        Exit For
      Else
         LoopCount += 1
      End If   '  TSID(ElNum).hID = 0

   Next ElNum

   If NextID = 0 And LoopCount < MaxScreenNums Then

      For ElNum = 1 To MaxScreenNums

         If TSID(ElNum).hID = 0 Then
           NextID = TSID(ElNum).hIndex
           Exit For
         End If
      Next ElNum

      NextID = 0
   End If

   Function = NextID

End Function   '  GetNextIndex


'  -----------------------------------------------------------------------------
'  This function is called by DLL_CONTEXT and it returns the Index value
'  assigned to the referenced ID number
'
Function GetIDNumIndex(ByVal ELIdNum As Long) As Long  Export
   
   '  Locate Index for this ID Number
   IdIndex = FindIDNum(ELIDNum)

   Function = IdIndex   '  If ZERO, ID Number isn't in ID-List

End Function   '  GetIDNumIndex


'  -----------------------------------------------------------------------------
'  This function, called by DLL_FREE, removes ID numbers from the ARRAY by
'  setting TSID(IDTest).hID = 0.
'
'  It preserves the Index Element as a place holder for the next process that
'  needs its number stored, and it clears the IN-Use FLAG after it Initializes
'  the Global variables.
'
Function RemoveIDNum(ELIdNum As Long) As Long

   '  Get the Element position for this ID number
   IdIndex = FindIDNum(ELIDNum)

   '  Clear the ID number from the place holder
   TSID(IdIndex).hID = 0

   If TSID(IdIndex).hUsed = 1 Then  '  Should always be true

      '  Initialize Global Variables to Remove Old Data
      ' Call a Clearing Function HERE

      '  Turn Off Contamination FLAG
      TSID(IdIndex).hUsed = 0
   End If

   Function = IdIndex    '   Return the Element number position - ZERO indicates ERROR
End Function   '  RemoveIDNum


'  -----------------------------------------------------------------------------
'  This function does a linear search of the small array by looking at all the
'  elements for a matching ID value.
'
Function FindIDNum(ELIDNum As Long) As Long
   Dim IDTest As Long
   Dim ElNum As Long

   IDTest = 0

   For ElNum = 1 To UBound(TSID)

      '  Look for the first empty element location
      If TSID(ElNum).hID = ELIDNum Then
         IDTest = TSID(ElNum).hIndex   '  This Index value is available

         Exit For
      End If   '  TSID(ElNum).hID = 0
   Next ElNum

   Function = IDTest                   '  If ZERO is returned, list is full

End Function   '  FindIDNum


'  -----------------------------------------------------------------------------
'  When PB-Add-Free.INC is loaded into a DLL-Template, %DLL_PROCESS_ATTACH calls
'  this SUB to Initialize the INDEX and Clear all the Records.  If this module
'  isn't present, %DLL_PROCESS_ATTACH ignores procedure
'
Sub InitIdRecords
   Dim ELNum As Long, ErrNum As Long
   Dim ErrorPlace As String

   '  Size the Array here
   ReDim TsID(MaxScreenNums)

   Msg = "InitIdRecords - ElNum = " + Str(ElNum)           ' - Debug
   WriteLog( Msg)                            '  Write Debug Message - Debug

   '  Clear all ID Elements and Insert Index Values
   For ElNum = 1 To MaxScreenNums
      TSID(ElNum).hID = 0
      TSID(ElNum).hIndex = ElNum
      TSID(ElNum).hUsed = 0
   Next ElNum
   
   If ErrNum <> 0 Then
      ErrorPlace = "Error #:" + Str(Err) + " occurred in "
      SendFastMsg("All Globals Initialized", ErrorPlace )
   End If
   
End Sub  '  InitIdRecords

'  =============================================================================
'                 ID Handling Routines
'  =============================================================================

'Converted to FB by Imortis Inglorian
'Date: 08-12-08


PB-DebugLog.bi

Code: Select all

'  =============================================================================
'  PB-DebugLog.INC                    TradeStation PowerBASIC DLL Template
'  ---------------
'  Version  1.0.0 - 27-June-2003
'
'  Copyright (C) 2003  Roger D. Rines
'
'  emailto:rdrines@spamcop.net?Subject[PB-Bones]
'  =============================================================================
'   
'   This library is free software; you can redistribute it and/or
'   modify it under the terms of the GNU Lesser General Public
'   License as published by the Free Software Foundation; either
'   version 2.1 of the License, or (at your option) any later version.
'   
'   This library is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
'   Lesser General Public License for more details.
'   
'   You can read the full GPL Lesser General Public License here:
'   http://www.gnu.org/copyleft/lesser.html
'   
'   Or, you should have received a copy of the GNU Lesser General Public
'   License along with this library; if neither happen, you can write to
'   the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
'   Boston, MA  02111-1307  USA
'   
'  USE:
'  =============================================================================

'  This source file is a PowerBASIC model that is compatible with Omega's
'  TradeStation software.  This code must be used with the PB-Bones.BAS file.
'  =============================================================================
Declare Function StartLog(LogFile As String) As Integer   '  Starts the Log file        - Debug
Declare Sub WriteLog( LogRecord As String)               '  Writes to the Log file     - Debug
Declare Sub EndLog()                                       '  Closes the log file        - Debug                                                                   

'  =============================================================================
'  GLOBAL VARIABLE DEFINITIONS
'  =============================================================================

Const MsgDashCount = 78

Dim Shared LogNum As Integer                '  File Number of the LogFile          - Debug
Dim Shared Msg As String                                                         '  - Debug


'  =============================================================================
'           StartLog%, WriteLogRecord & EndLog    - Debug
'  =============================================================================

'  A Function and two Subs used to Open a file, write logging records and close
'  the file used for storing Debug log messages.   -  Debug

'  These three procedures can be removed, along with their definitions and calls
'  to them located throughout the source code.  They are left here so new
'  PBWin developers have a simple way of generating information from the source
'  code they enter.  They are also a good way to understand how TradeStation is
'  working with the DLL program.  If you don't need this type of utility, don't
'  be afraid to remove everything with a DEBUG line, or anything else you don't
'  need
'  ....................

Function StartLog(LogFile As String) As Integer                '  - Debug
   
   LogNum  = FreeFile                   '  Log File DOS Handle #  - Debug   
   Open LogFile For Output As #LogNum   '  Open OR Create a File  - Debug
     
   Print #LogNum , " "                                         '  - Debug
   Print #LogNum , String (78, "=")                            '  - Debug
   Print #LogNum , "Log File OPENED @ ";Date ;" - ";Time       '  - Debug
   Print #LogNum , ""                                          '  - Debug
                                                               
   StartLog  = LogNum                     '  Return the Logging file's handle
End Function   '  StartLog%                                    '  - Debug

'  ....................
'  Writes a one line Log message
Sub WriteLog( LogRecord As String)                             '  - Debug
         
   Print #LogNum , "-> ";LogRecord                             '  - Debug
   
End Sub  '  WriteLog                                           '  - Debug

'  ....................
'  Used to close the Log file
Sub EndLog                                                     '  - Debug
               
   Print #LogNum , " "                                         '  - Debug
   Print #LogNum , String (MsgDashCount, "-")                  '  - Debug
   Print #LogNum , "Log File Closed @ ";Date ;" - ";Time       '  - Debug
   Print #LogNum , ""                                          '  - Debug
   Print #LogNum , String ( MsgDashCount, "=")                 '  - Debug
   
   Close #LogNum                          '  Close this File   '  - Debug
End Sub  '  EndLog


'  ....................
'  Fast File Open - Send Message process to create a popup text messages

Sub SendFastMsg( TextStringMsg As String, CallingProcessName As String )
   Dim FilNum As Long
   
   FilNum = FreeFile                        '  Log File DOS Handle #
   Open "C:\ErrMsg.Txt" For Output As #FilNum '  Open OR Create a File 
     
   Print #FilNum, " "             
   Print #FilNum, String ( MsgDashCount, "=")
   Print #FilNum, "Fast Message from: "; CallingProcessName;" - ";Time
   Print #FilNum, ""             
   Print #FilNum, "-> ";TextStringMsg
   Print #FilNum, ""                         
   Print #FilNum, String ( MsgDashCount, "=")
   
   Close #FilNum                         '  Close this File

   Shell("NotePad.EXE C:\ErrMsg.Txt")

End Sub

'  =============================================================================
'                                END of DLL SOURCE CODE
'  =============================================================================

'Converted to FB by Imortis Inglorian
'Date: 08-12-08


ELKit32PB.bi

Code: Select all

'  =======================================================================================
'  ELKit32PB.INC
'  -------------
'
'  Version  1.0.0 - 27-June-2003
'
'  Copyright (C) 2003  Roger D. Rines
'
'  emailto:rdrines@spamcop.net?Subject[PB-Bones]
'  =============================================================================
'   
'   This library is free software; you can redistribute it and/or
'   modify it under the terms of the GNU Lesser General Public
'   License as published by the Free Software Foundation; either
'   version 2.1 of the License, or (at your option) any later version.
'   
'   This library is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
'   Lesser General Public License for more details.
'   
'   You can read the full GPL Lesser General Public License here:
'   http://www.gnu.org/copyleft/lesser.html
'   
'   Or, you should have received a copy of the GNU Lesser General Public
'   License along with this library; if neither happen, you can write to
'   the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
'   Boston, MA  02111-1307  USA

'  USE:
'  =======================================================================================

'  This INCLUDE file is a "C" header conversion to PowerBASIC.  Include this file in any
'  DLL source code if you intended to work with Easy Language to access the exposed
'  Functions contained in the ELKit32.DLL.
'
'  As the author of this file, any use of this information is allowed as long as it
'  isn't sold as a source file.

'  All Functions listed have been tested with TradeStation 2000i (Versions 5),
'  TradeStation version 6 and TradeStation version 7.02 (current release).

'  Place this file in your PowerBASIC DLL code list just below the Win32API.INC file if you
'  need to use the ELKit32.DLL functions in your DLL.
'
'  Once your DLL has been compiled, it should be placed in a directory where TradeStation can
'  find it.  This is usually in the same directory as "\Program Files\Omega Research\Program\"
'  If you place your DLL file in any other location, you will need to add the path to the
'  Declaration statements listed at the top of your Easy Language program.

'  EXAMPLE:
'    DefineDLLFunc: "PB-Bones.DLL", FLOAT, "MinutesToTime", FLOAT ;         { Program Directory }
'    DefineDLLFunc: "C:\Temp\PB-Bones.DLL", FLOAT, "MinutesToTime", FLOAT ; { Temp Directory    }
'
'  ELKit32.DLL Function Information:   
'  =======================================================================================
'  FUNCTIONS:
'      FindAddress_Open         
'      FindAddress_High
'      FindAddress_Low 
'      FindAddress_Close   
'      FindAddress_Volume
'      FindAddress_OpenInt
'      FindAddress_UpTicks
'      FindAddress_DownTicks
'      FindAddress_Date
'      FindAddress_Time
'      FindAddress_Var
'      FindAddress_Array
'
'  All above FUNCTIONS return a 32-bit address for the named data object listed in the FUNCTION's
'  name-suffix.  All FUNCTIONS require the address of one data object and an OffSet value.
'  OffSet values that are positive, move back in time, and negative OffSets move forward.
'  Data object request should not use OffSet values that are later than the CurrentBar
'  value and shouldn't attempted access that are earlier than the MaxBarsBack value
'  currently set in the attached Easy Language program.

'  If keeping the number of DLL_ADD and DLL_FREE calls the same, don't use the AutoDetect
'  option made available for determining the correct number of MaxBarsBack.
'
'  DECLARATIONS:
'  =======================================================================================

'  Locate the address of the OPEN price field value
Declare Function FindAddress_Open Lib "ELKit32.DLL" Alias "FindAddress_Open"_   
                                    (ByVal lpOpen As Dword, ByVal nOfs As Long) As Dword

'  Locate the address of the HIGH price field value 
Declare Function FindAddress_High Lib "ELKit32.DLL" Alias "FindAddress_High"_ 
                                    (ByVal lpHigh As Dword, ByVal nOfs As Long) As Dword

'  Locate the address of the LOW price field value      
Declare Function FindAddress_Low Lib "ELKit32.DLL" Alias "FindAddress_Low"_
                                    (ByVal lpLow As Dword, ByVal nOfs As Long) As Dword

'  Locate the address of the CLOSE price field value 
Declare Function FindAddress_Close Lib "ELKit32.DLL" Alias "FindAddress_Close"_
                                     (ByVal lpClose As Dword, ByVal nOfs As Long) As Dword

'  Locate the address of the VOLUME field value
Declare Function FindAddress_Volume Lib "ELKit32.DLL" Alias "FindAddress_Volume"_
                                       (ByVal lpVolume As Dword, ByVal nOfs As Long) As Dword

'  Locate the address of the OPEN INTEREST field value
Declare Function FindAddress_OpenInt Lib "ELKit32.DLL" Alias "FindAddress_OpenInt"_
                                       (ByVal lpOpenInt As Dword, ByVal nOfs As Long) As Dword

'  Locate the address of the UpTicks field value - Intraday data 
Declare Function FindAddress_UpTicks Lib "ELKit32.DLL" Alias "FindAddress_UpTicks"_
                                       (ByVal lpUpTicks As Dword, ByVal nOfs As Long) As Dword

'  Locate the address of the DownTicks field value -  Intraday data
Declare Function FindAddress_DownTicks  Lib "ELKit32.DLL" Alias "FindAddress_DownTicks"_
                                 (ByVal lpDownTicks As Dword, ByVal nOfs As Long) As Long

'  Locate the address of the Date field value
Declare Function FindAddress_Date Lib "ELKit32.DLL" Alias "FindAddress_Date"_
                                  (ByVal lpDate As Dword, ByVal nOfs As Long) As Dword

'  Locate the address of the Time field value
Declare Function FindAddress_Time Lib "ELKit32.DLL" Alias "FindAddress_Time"_
                                 (ByVal lpTime As Dword, ByVal nOfs As Long) As Dword
                                   
'  Locate the address of a Series Variable
Declare Function  FindAddress_Var Lib "ELKit32.DLL" Alias "FindAddress_Var"_
                    (ByVal lpVar As Dword, ByVal nOfs As Long,_
                     ByVal wStartAddr As Dword,_
                     ByVal wVarSize As Dword) As Dword

'  Locate the address or Array Element
Declare Function FindAddress_Array Lib "ELKit32.DLL" Alias "FindAddress_Array"_
                      (ByVal lpArray As Dword,_
                       ByVal nSpaceOfs As Long,_
                       ByVal nTimeOfs As Long,_
                       ByVal wStartAddr As Dword,_
                       ByVal wArraySize As Dword) As Dword


'  =======================================================================================
'   These FUNCTIONS are inherent in Easy Language and are NOT called outside of the DLL
'  =======================================================================================
                       
'  Accepts a Easy Language Julian Date value and returns an Easy Language Date
Declare Function JulianToDate Lib "ELKit32.DLL" Alias "JulianToDate" (ByVal jDay As Word) As Dword

'  Accepts an Easy Language Date value and returns an Easy Language Julian Day value
Declare Function DateToJulian Lib "ELKit32.DLL" Alias "DateToJulian" (ByVal cDate As Dword) As Word

'  =======================================================================================
'                             ELKit32PB.INC file END
'  =======================================================================================

'Converted to FB by Imortis Inglorian
'Date: 08-12-08
Imortis
Moderator
Posts: 1734
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Postby Imortis » Aug 13, 2008 0:37

Sorry. Wouldn't fit in the above post.

PB-Bones.BAS

Code: Select all

'=============================================================================
'  PB-Bones.BAS                    TradeStation PowerBASIC DLL Template
'  ------------
'  Version  1.0.0 - 27-June-2003
'
'  Copyright (C) 2003  Roger D. Rines
'
'  emailto:rdrines@spamcop.net?Subject[PB-Bones]
'  =============================================================================
'   
'   This library is free software; you can redistribute it and/or
'   modify it under the terms of the GNU Lesser General Public
'   License as published by the Free Software Foundation; either
'   version 2.1 of the License, or (at your option) any later version.
'   
'   This library is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
'   Lesser General Public License for more details.
'   
'   You can read the full GPL Lesser General Public License here:
'   http://www.gnu.org/copyleft/lesser.html
'   
'   Or, you should have received a copy of the GNU Lesser General Public
'   License along with this library; if neither happen, you can write to
'   the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
'   Boston, MA  02111-1307  USA
'   
'  USE:
'  =============================================================================

'  This source file is a PowerBASIC model that is compatible with Omega's
'  TradeStation software.  This code must be used with the ELKit32PB.INC file
'  so the external functions of TradeStation's ELKit32.DLL module are accessible
'  to this DLL.
'
'  PB-Bones.BAS is intended to be a PowerBASIC code-skeleton for creating
'  TradeStation compatible DLL modules.  Nothing in this code is considered final
'  but everything has been tested to see if it would work reliably for the task.
'
'  Error prevention is not included as part of the skeleton because that chore
'  is usually incorporated as a global process, or as part of the code logic. 
'  While I use error checking to handle potential problems, many people don't
'  and don't seem to have much trouble.  No matter what you do your GPF points
'  will vary.
'
'  When this template was published, PowerBASIC's PBWin/DLL version was 7.02.
'  To use this code, you'll probably need to have that version of the 
'  PowerBASIC PBWIN/DLL 32-bit compiler to get the same results.
'
'  If you find an error, or know of an enhancement that should be added to this
'  template, your comments will be warmly received and considered for inclusion
'  into this source.  Please send your comments to my email address listed above.
'
'  =============================================================================
   
'#DIM ALL

'#COMPILE DLL "PB-Bones.DLL"      '  Prefix part can be almost any name you like
#INCLUDE "windows.bi"         '  Everything in WIN32API isn't needed in Template,
                                 '  so PB-Bones.INC is being used in this example

#Include "PB-Bones.bi"           '  This INC contains the minimum required Equates

#Include "PB-DebugLog.bi"        '  Contains Debug LogFile Functions

#Include "PB-Add-Free.bi"        '  Includes the DLL_ADD, DLL_CPNTEXT & DLL_FREE
                                 '  SUB calls TradeStation will use when they are
                                 '  included in a DLL.                 
                                 
#Include "EL_Globals.bi"         '  Routines for handling the storage and retrieval
                                 '  of Global values from array elements
                                 
#Include "ELKit32PB.bi"          '  TradeStation API declaration file 



'  =============================================================================
'  GLOBAL VARIABLE DEFINITIONS
'  =============================================================================
                                  '  Elements that show "Debug" can be removed
                                  '  as they were only inserted to give a new user
                                  '  an idea of what happens when the DLL is
                                  '  loaded and accessed.
                             
Dim Shared gNumOfTimes As Dword   '  Counts # of times LibMain is called - Debug


'  =============================================================================
'  EQUATE DEFINITIONS
'  =============================================================================
'DLL_VERSION = "1.0.0"        '  Holds the Current DLL version Number
                                                                               

#Ifndef PB_Add_Free           '  If PB-Add_Free.INC isn't used, set to ZERO
   PB_Add_Free = -1
#EndIf                 
                                                                               
'  =============================================================================                                                                               
'  EXPOSED DEFINITIONS
'  =============================================================================
   
Declare Function OpenPriceVal (ByVal OpenPtr As Dword,_               '  Pointer to Variable
                               ByVal Offset As Long,_                 '  Bar Offset Value
                               ByVal Scale As Single) As Single       '  PriceScale Value
                               
Declare Function HighPriceVal (ByVal HighPtr As Dword,_               '  Pointer to Variable
                               ByVal Offset As Long,_                 '  Bar Offset Value
                               ByVal Scale As Single) As Single       '  PriceScale Value
                               
Declare Function LowPriceVal (ByVal LowPtr As Dword,_                 '  Pointer to Variable
                              ByVal Offset As Long,_                  '  Bar Offset Value
                              ByVal Scale As Single) As Single        '  PriceScale Value
                             
Declare Function ClosePriceVal (ByVal ClosePtr As Dword,_             '  Pointer to Variable
                                ByVal Offset As Long,_                '  Bar Offset Value
                                ByVal Scale As Single) As Single      '  PriceScale Value

Declare Function VolumeVAL (ByVal VolPTR As Dword,_                   '  Pointer to Variable
                            ByVal Offset As Long) As Single           '  Bar Offset Value
                           
Declare Function OpenIntVAL (ByVal OpnIntPTR As Dword,_               '  Pointer to Variable
                             ByVal Offset As Long) As Single          '  Bar Offset Value

Declare Function UpTickVAL (ByVal UpTikPTR As Dword,_                 '  Pointer to Variable
                            ByVal Offset As Long) As Single           '  Bar Offset Value
                           
Declare Function DownTickVAL (ByVal DnTikPTR As Dword,_               '  Pointer to Variable
                              ByVal Offset As Long) As Single         '  Bar Offset Value

Declare Function BarDateJulianVAL (ByVal BarDatePTR As Dword,_        '  Pointer to Variable
                                   ByVal Offset As Long) As Single    '  Bar Offset Value
                                   
Declare Function BarDateYMD(ByVal BarDatePTR As Dword,_               '  Pointer to Variable
                            ByVal Offset As Long) As Single           '  Bar Offset Value

Declare Function BarTimeMinutes (ByVal BarTimePTR As Dword,_          '  Pointer to Variable
                                 ByVal Offset As Long) As Single      '  Bar Offset Value
                                 
Declare Function BarTimeHHMM(ByVal BarTimePTR As Dword,_              '  Pointer to Variable
                             ByVal Offset As Long) As Single          '  Bar Offset Value

Declare Function VariableVAL (ByVal VariablePTR As Dword,_            '  Pointer to Variable
                              ByVal Offset As Long,_                  '  Bar Offset Value
                              ByVal VarStartAddr As Dword,_           '  Variable Starting Address
                              ByVal VarSize As Long) As Single        '  Variable Type Size

Declare Function ArrayElementValue (ByVal ArrayElement As Dword,_     '  Pointer to Array-Element
                                    ByVal Offset As Long,_            '  Bar Offset Value
                                    ByVal StartAddr As Dword,_        '  Start Address of ARRAY
                                    ByVal ArraySize As Dword) As Single' ArraySize Value
   
Declare Function dllAverageClose(ByVal PricePTR As Dword,_            '  Pointer to Variable
                                 ByVal Offset As Long,_               '  Bar Offset Value
                                 ByVal Length As Long,_               '  Look back Value
                                 ByVal Scale As Single) As Single     '  PriceScale Value

Declare Function MinutesToTime (ByVal nMinutes As Single) As Single   '  Converts Minutes to HHMM
Declare Function TimeToMinutes (ByVal ClockTime As Single) As Single  '  Won't validate Time received

Declare Function DoubleIt (ByVal AnyPrice As Single) As Single        ' Simple Value Doubler
Declare Function IncrNum (ByVal AnyVariableNum As Single) As Single   ' Increments a Number by 1

'DECLARE FUNCTION MakeCalDate (BYVAL ELDateStr AS ASCIIZ PTR,_         '  Pass Date as STRING PTR
'                              BYVAL NotUS AS LONG) AS STRING          '  Returns a Modified STRING   

Declare Function MakeCalDate (ELDateStr As String,_               '  Pass Date as STRING PTR
                              ByVal NotUS As Long) As String          '  Returns a Modified STRING   

'  =============================================================================
'  LOCAL DEFINITIONS - NOT Exposed
'  =============================================================================
'  Functions and Subs to show functionality - Not needed unless you want them
'  =============================================================================

                                                                   

'  =============================================================================
'                          ACCESS MODULES START HERE
'  =============================================================================

'  Main DLL Module Function is called when the DLL is attached and when it
'  is terminated.  If any initialization of the DLL is needed, create a procedure
'  that can be called when '%DLL_PROCESS_ATTACH' is triggered.
'
'  When the DLL is ready to terminate, put a call to cleanup procedures
'  in the '%DLL_THREAD_DETACH' section. 
'
'  When an Easy Language Program is attached to the DLL, TradeStation will trigger
'  an event that will call DLL_ADD and a ID-number will be passed to the DLL. 
'
'  When TradeStation detaches from the DLL, it will trigger an event that calls
'  the DLL_FREE procedure, and it will tell the DLL which instance is terminating. 
'
'  All program request for information from the DLL will trigger a call to
'  DLL_CONTEXT procedure and it will include the instance ID-number originally
'  established by the EL program running in the space of the identified instance.
'
'  Each time Easy Language attaches a DLL to a program, it sends the DLL an event
'  handle that can be used to identify the process that is attaching, requesting
'  and detaching.  This event-handle identification passed with each call
'  will allow the programmer of the DLL to create seperate THREADS, or change
'  the current index value on global arrays that aren't intended to be accessed
'  across instances.
'
'  IF the SUBs DLL_ADD, DLL_CONTEXT & DLL_FREE are left out of the code or not
'  exposed, TradeStation will detect their absence and won't issue any calls to
'  them.  It also won't be sending any ID information as well, so if knowing
'  which process is asking the DLL for something isn't important, leave the
'  SUBs out and a tiny speed improvement may be the result.
'
'  EL = Easy Language
'  =============================================================================
'  LIBMAIN is always called when it is attached to another program.  When the first
'  Easy Language program sends the '%DLL_PROCESS_ATTACH' call, the processing and
'  communication environment is established and '%DLL_PROCESS_ATTACH' is not called
'  again until it has been released by all processes accessing the DLL.  This means,
'  that as long as any Easy Language program is using the '%DLL_THREAD_DETACH'
'  signal will not be sent.
'
Function LIBMAIN(ByVal hInstance As Dword,_
                 ByVal Reason    As Long,_
                 ByVal Reserved  As Long) As Long
   
   Dim Msg As String                                     '  Variable for Debug - Debug
   
   gNumOfTimes += 1                                      '  Counts LibMain calls - Debug
   
   Select Case Reason
      Case DLL_PROCESS_ATTACH
         '  Start the Logging process
         LogNum = StartLog("C:\Z\TS-DLL\CallLog.TXT")  '  Open named log file - Debug

         '  Write a Log Record
         Msg = "%Dll_PROCESS_ATTACH - " + _
                "%PB_Add_Free = " + Str ( PB_Add_Free)                        ' - Debug
              WriteLog( Msg )                            '  Write Debug Message - Debug

         '  Write a Log Record
         Msg = "%Dll_PROCESS_ATTACH - Count = " + " elID = " +_
               Str (elID)+ " Lib Call Count = " + Str (gNumOfTimes)           ' - Debug
              WriteLog( Msg )                            '  Write Debug Message - Debug

         
         '   initialize DLL here with whatever you need initialized       
         If PB_Add_Free Then InitIdRecords              '  Initializes ID Records         
         
         '  Write a Log Record
         Msg  = "%Dll_PROCESS_ATTACH - Count = " + " elID = " +_
               Str (elID)+ " Lib Call Count = " + Str (gNumOfTimes)           ' - Debug
              WriteLog( Msg )                            '  Write Debug Message - Debug
         
         LIBMAIN = 1
         Exit Function                                   '  LIBMAIN


      Case DLL_PROCESS_DETACH
         '   This is where app unloads the DLL
         
         '  END the Logging process
         Msg  = "%Dll_PROCESS_DETACH - Count = " + " elID = " +_
                Str (elID)+ " Lib Call Count = " + Str (gNumOfTimes)          ' - Debug
              WriteLog( Msg )                            '  Write Debug Message - Debug
              EndLog                                     '  CLOSE this named log file - Debug
         
         Exit Function                                   '  LIBMAIN
         
         
      Case  DLL_THREAD_ATTACH
         '   This is like %DLL_PROCESS_ATTACH
         Msg  = "%Dll_THREAD_ATTACH - Count = " + " elID = " +_
                Str (elID)+ " Lib Call Count = " + Str (gNumOfTimes)          ' - Debug
              WriteLog( Msg )                            '  Write Debug Message - Debug
         
         Exit Function                                   '  LIBMAIN
   
   
      Case  DLL_THREAD_DETACH                               
         '   This is like %DLL_PROCESS_DETACH
         
         '   Global Variables, etc. will be lost at this point
         Msg  = "%Dll_THREAD_DETACH - Count = " + " elID = " +_
                 Str (elID)+ " Lib Call Count = " + Str (gNumOfTimes)         ' - Debug
              WriteLog( Msg )                            '  Write Debug Message - Debug
         
         Exit Function                                   '  LIBMAIN
     
      End Select  '  CASE Reason
   
   
   ' If you get here, you are in serious trouble
   'MSGBOX "Windows Error in PB-Dones.DLL - LIBMAIN() - Reboot Windows"        ' - Debug
   
   '   A Serious Failure has Occured!
   LIBMAIN = 0 
End Function   '  LIBMAIN


'  =============================================================================
'                          EXPORTED FUNCTIONS & SUBroutines
'  =============================================================================
'
'  These address access FUNCTIONSs are the calls EL, or other SUBs and FUNCTIONS
'  in the DLL can use to simplify access to the data ojects used by TradeStation.
'
'  ------------------------------------
'  Finds the Price Value for the OPEN at Offset Location
Function OpenPriceVal(ByVal OpenPtr As Dword, ByVal Offset As Long,_
                      ByVal Scale As Single) As Single Export
   Dim ElementPTR As Dword Ptr

   '  Get the Address of this Price Bar Element
   ElementPTR = Cast(Dword Ptr,FindAddress_Open ( OpenPtr, Offset))

   ' Adjust Returned Value to Reflect Price Storage Adjustments
   If Scale <> 0 Then
      Function = Cast(Single, *ElementPTR / Scale)
   Else
      Function = Cast(Single, *ElementPTR)
   End If   '  Scale <> 0

End Function   '  OpenPriceVal

'  ------------------------------------
'  Finds the Price Value for the HIGH at Offset Location
Function HighPriceVal(ByVal HighPtr As Dword, ByVal Offset As Long,_
                      ByVal Scale As Single) As Single Export
   Dim ElementPTR As Dword Pointer
   
   '  Get the Address of this Price Bar Element
   ElementPTR = Cast(Dword Ptr,FindAddress_High( HighPtr, Offset))
   
   ' Adjust Returned Value to Reflect Price Storage Adjustments
   If Scale <> 0 Then
      Function = *ElementPTR / Scale
   Else
      Function = *ElementPTR
   End If   '  Scale <> 0

End Function   '  HighPriceVal

'  ------------------------------------
'  Finds the Price Value for the LOW at Offset Location
Function LowPriceVal(ByVal LowPtr As Dword, ByVal Offset As Long,_
                     ByVal Scale As Single) As Single Export
   Dim ElementPTR As Dword Pointer
   
   '  Get the Address of this Price Bar Element
   ElementPTR = Cast(Dword Ptr,FindAddress_Low( LowPtr, Offset))
   
   ' Adjust Returned Value to Reflect Price Storage Adjustments
   If Scale <> 0 Then
      Function = *ElementPTR / Scale
   Else
      Function = *ElementPTR
   End If   '  Scale <> 0

End Function   '  LowPriceVal

'  ------------------------------------
'  Finds the Price Value for the CLOSE at Offset Location
Function ClosePriceVal (ByVal ClosePtr As Dword, ByVal Offset As Long,_
                        ByVal Scale As Single) As Single Export
   Dim ElementPTR As Dword Pointer
           
   '  Get the Address of this Price Bar Element
   ElementPTR = Cast(Dword Ptr,FindAddress_Close( ClosePTR, Offset))
     
   ' Adjust Returned Value to Reflect Price Storage Adjustments
   If Scale <> 0 Then
      Function = *ElementPTR / Scale   '  Scale = Chart display setting
   Else
      Function = *ElementPTR
   End If   '  Scale <> 0

End Function   '  ClosePriceVal

'  ------------------------------------
'  Finds the Price Value for the VOLUME at Offset Location
Function VolumeVAL(ByVal VolPTR As Dword, ByVal Offset As Long) As Single Export
   Dim ElementPTR As Dword Pointer   

   '  Get the Address of this Price Bar Element      
   ElementPTR = Cast(Dword Ptr,FindAddress_Volume( VolPTR, Offset))      
'LPLONG FAR PASCAL FindAddress_Volume (LPLONG lpVolume, INT nOfs);

   Function = *ElementPTR                                             
 
End Function   '  VolumeVAL

'  ------------------------------------
'  Finds the Price Value for the OPEN INTEREST at Offset Location
Function OpenIntVAL(ByVal OpnIntPTR As Dword, ByVal Offset As Long) As Single Export
   Dim ElementPTR As Dword Pointer   
   
   ElementPTR = Cast(Dword Ptr,FindAddress_OpenInt(OpnIntPTR, Offset))
   
   Function = *ElementPTR                                             
 
End Function   '  OpenIntVAL

'  ------------------------------------
'  Finds the Price Value for the UpTick or VOLUME at Offset Location
Function UpTickVAL(ByVal UpTikPTR As Dword,_
                   ByVal Offset As Long) As Single Export
   Dim ElementPTR As Dword Pointer   
   
   ElementPTR = Cast(Dword Ptr,FindAddress_UpTicks( UpTikPTR, Offset))

   Function = *ElementPTR                                             
 
End Function   '  UpTickVAL

'  ------------------------------------
'  Finds the Price Value for the DownTick or OPEN INTERST at Offset Location
Function DownTickVAL(ByVal DnTikPTR As Dword,_
                     ByVal Offset As Long) As Single Export
   Dim ElementPTR As Dword Pointer   
   
   ElementPTR = Cast(Dword Ptr,FindAddress_DownTicks( DnTikPTR, Offset))

   Function = *ElementPTR                                             
 
End Function   '  DownTickVAL

'  ------------------------------------
'  Returns the Value of an Easy Language Variable at OffSet Location
Function VariableVAL(ByVal VariablePTR As Dword,_            '  Pointer to Variable
                     ByVal Offset As Long,_                  '  Bar Offset Value
                     ByVal VarStartAddr As Dword,_           '  Variable Starting Address
                     ByVal VarSize As Long) As Single Export '  Variable Type Size
             
   Dim ElementPTR As Single Pointer   
   
   ElementPTR = Cast(Single Ptr,FindAddress_Var( VariablePTR, Offset, VarStartAddr, VarSize))

   Function = *ElementPTR                                             
 
End Function   '  VariableVAL 

'  ------------------------------------
'  Returns the Value of an Easy Language Array Element at OffSet Location   
Function ArrayElementValue(ByVal ArrayElementPTR As Dword,_  ' Pointer to an Array-Element
                           ByVal Offset As Long,_            ' Contains a LONG-INT Value                     
                           ByVal StartAddr As Dword,_        ' Starting Address of ARRAY Series
                           ByVal ArraySize As Dword ) As Single Export
   
   Dim ElementPTR As Single Pointer
         
   '  Returns a Pointer to a Single Precision Value
   ElementPTR = Cast(Single Ptr,FindAddress_Array(ArrayElementPTR, Offset, 0, StartAddr, ArraySize))
   
   Function = *ElementPTR  ' Return the value for this Array Element
   
End Function   '  ArrayElementValue   

'  ------------------------------------
'  Finds the Price Value for the BAR-DATE at Offset Location
Function BarDateJulianVAL(ByVal BarDatePTR As Dword,_
                          ByVal Offset As Long) As Single Export
   Dim ElementPTR As Word Pointer   
   
   ElementPTR = Cast(Word Ptr,FindAddress_Date( BarDatePTR, Offset))

   Function = *ElementPTR   '  Returns a Julian Date Value

End Function   '  BarDateVAL

'  ------------------------------------
'  Finds the Date Value for the BAR-DATE at Offset Location
Function BarDateYMD(ByVal BarDatePTR As Dword,_
                    ByVal Offset As Long) As Single Export

   Function = JulianToDate(BarDateJulianVAL(BarDatePTR, Offset))
   
End Function   '  BarDateVAL

'  ------------------------------------
'  Finds the Minutes value for the BAR-TIME at Offset Location
Function BarTimeMinutes(ByVal BarTimePTR As Dword,_
                        ByVal Offset As Long) As Single Export
   Dim ElementPTR As Dword Pointer   
       
   ElementPTR = Cast(Dword Ptr,FindAddress_Time( BarTimePTR, Offset))

   Function = *ElementPTR
       
End Function   '  BarTimeVAL
                                                                                         
'  ------------------------------------
'  Finds the TIME (HH:MM) value for the BAR-TIME at Offset Location
Function BarTimeHHMM(ByVal BarTimePTR As Dword,_
                     ByVal Offset As Long) As Single Export
     
   Function = MinutesToTime(BarTimeMinutes(BarTimePTR, Offset))

End Function   '  BarTimeHHMM(                                                                                         
                                                                                         
'  =============================================================================
'                          Testing Functions & Subs
'  =============================================================================

'  ------------------------------------
'  Takes a number containing minutes and converts it to HHMM
Function MinutesToTime (ByVal nMinutes As Single) As Single Export  ' Does NOT check > 24-hours
   Dim Tmp As Single                     
   
   Tmp = (nMinutes / 60)
   Function = (Int(Tmp) * 100) + ((Tmp - Int(Tmp)) * 60)

End Function   '  MinutesToTime

'  ------------------------------------
'  Takes Standard Clock HHMM Converted it the number of minutes since MidNight
Function TimeToMinutes (ByVal ClockTime As Single) As Single Export
   Dim tmpTime As Single
   Dim FractionalHour As Single
   Dim HourMinutes As Long
   
   If ClockTime > 0 Then     '  Does NOT validate Time format received
      tmpTime = (ClockTime * .01)                 
      FractionalHour = (tmpTime - Int(tmpTime))
      HourMinutes = Int(tmpTime) * 60
      FractionalHour = CInt(FractionalHour * 100)
   
      Function = HourMinutes + FractionalHour
    Else 
   
      Function = 0
    End If  '  ClockTime > 0
     
End Function   '  TimeToMinutes


'  ------------------------------------
'  Simple example of how a direct call made from EL can access an external
'  computational process.
'
Function dllAverageClose (ByVal ClosePtr As Dword,_               '  Address from &Close
                          ByVal Offset As Long,_                  '  Same as Easy Language
                          ByVal Length As Long,_                  '  Must NOT EXCEED MaxBarsBack value
                          ByVal Scale As Single) As Single Export '  Charts Current Price Scale
                         
   Dim ElementPTR As Dword Pointer
   Dim BarNum As Long
   Dim ThisCloseVal As Single
   Dim TmpVal As Single
   
   If Length > 0 And ClosePtr > 0 Then
      TmpVal = 0
     
      For BarNum = Offset To Offset + Length - 1
          ThisCloseVal =  ClosePriceVal(ClosePtr, BarNum, Scale)     '  Get this bar's CLOSE
          TmpVal = TmpVal + ThisCloseVal                             '  Sum the values 
      Next BarNum

      Function = TmpVal / Length                                     '  Create an Average
   Else
      Function = 0
   End If   '  Length > 0 AND ClosePtr > 0
   
End Function   '  dllAverageClose

'  ------------------------------------
'  Simple example of how a direct call can be made from EL
'  Passing the actual price value, instead using the address,
'  of the price object to compute a new value
'
Function DoubleIt (ByVal AnyPrice As Single) As Single Export

   Function = AnyPrice * 2                                           ' Double the Price
End Function   '  DoubleIt
                               
'  ------------------------------------
'  Simple example of how a direct call can be made from EL
'  Passing the actual value of a user variable instead using the
'  address the variable object to change the value of the variable
'
Function IncrNum (ByVal AnyVariableNum As Single) As Single Export   ' Increments a Number by 1

   Function = AnyVariableNum + 1
End Function   '  IncrNum                     

'  ------------------------------------
'  Pass an ELDate-Value as a String and Convert it into a US Calendar
'  date in STRING format.  The EL date-value is then passed back as a
'  STRING to show how STRINGS can be passed back and forth between
'  the DLL and Easy Language.
'
Function MakeCalDate (ELDateStr As String, _'  Pass Date as Fixed STRING
                      ByVal NotUS As Long) _           '  ZERO or NOT-ZERO
                      As String Export               '  Return a Modified STRING   
 
   Dim ELDateVal As Long               
   Dim TmpDate As String
   Dim As String Yr, Mnth, Day

   
   'ELDateVal = VAL(@ELDateStr)         '  Make it a Numeric
   ELDateVal = Val(ELDateStr)          '  Make it a Numeric
   ELDateVal = 19000000 + ELDateVal    '  Add Full Century Value
   TmpDate = Trim$(Str$(ELDateVal))    '  Make it a STRING & Remove SPACE     
   
   Yr = Left(TmpDate, 4)            '  Capture Year with Century
   Mnth = Mid(TmpDate, 5, 2)         '  Grab the Month Value
   Day = Right(TmpDate, 2)          '  Day number goes here
   
   If NotUS Then               '  If NOT in US,...
                                                       '                  dd mm yyyy
      Function = Day + "-" + Mnth + "-" + Yr + !"\n" ' Give this format 21-02-2003
   Else
                                                       '                  mm dd yyyy
      Function = Mnth + "-" + Day + "-" + Yr + !"\n" ' US is this format 02-21-2003
   End If   '  ISTRUE(NotUS)

End Function   '  MakeCalDate         



'  =============================================================================
'                                END of DLL SOURCE CODE
'  =============================================================================

'Converted to FB by Imortis Inglorian
'Date: 08-12-08
ZoSo
Posts: 2
Joined: Jul 19, 2008 17:20

Postby ZoSo » Aug 14, 2008 23:01

Imortis, Thank you so much for the work you have done on this. This is far more than I was expecting. I can see where diff will be getting a nice workout while I sort through this.

I don't understand what you are asking for with "If someone could tell me why it wants PB-BONES.DLL, we can work it out." Let me know and I'll do what I can.

If I read things correctly, PB-Bones.INC (PB-Bones.bi) is actually created by a product called inclean that looks at your source and compares it against functions, subs, etc in the WIN32API.INC and only selects the functions, subs, etc., that are actually used thereby reducing exe size and increasing performance. The WIN32API.INC file are the win32 API declarations for PowerBasic and can be found at http://www.powerbasic.com/files/pub/pbwin.

Again my thanks for what you have provided here.
Imortis
Moderator
Posts: 1734
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Postby Imortis » Aug 14, 2008 23:25

What I meant is, if you compile this code, it sends a compiler message saying it could not find PB-BONES.DLL. It is probably because of some silly mistake I made. I was hoping that some forum regulars would help me out on this one.
Amundo
Posts: 57
Joined: Feb 26, 2007 0:25

Postby Amundo » Aug 15, 2008 6:34

Nice work, Imortis.

The lines from "PB-Add-Free.bi":

Code: Select all

'  =============================================================================
'  EXPOSED DEFINITIONS
'  =============================================================================
 
Declare Sub Dll_Add Lib "PB-BONES.DLL" Alias "Dll_Add" (Byval elThreadId As Dword)
Declare Sub Dll_Free Lib "PB-BONES.DLL" Alias "Dll_Free" (Byval elThreadId As Dword)
Declare Sub Dll_Context Lib "PB-BONES.DLL" Alias "Dll_Context" (Byval elThreadId As Dword)


Are actually referencing "PB-BONES.DLL", I think it should be referencing the DLL that you're creating with all this code.

@ZoSo: I like to "dabble" as well, but I like using Amibroker - it's a lot lighter on the resources...
marcov
Posts: 3019
Joined: Jun 16, 2005 9:45
Location: Eindhoven, NL
Contact:

Postby marcov » Aug 15, 2008 7:41

ZoSo wrote:If I read things correctly, PB-Bones.INC (PB-Bones.bi) is actually created by a product called inclean that looks at your source and compares it against functions, subs, etc in the WIN32API.INC and only selects the functions, subs, etc., that are actually used thereby reducing exe size and increasing performance. The WIN32API.INC file are the win32 API declarations for PowerBasic and can be found at http://www.powerbasic.com/files/pub/pbwin.


That sounds as an ugly hack for a defective linker. Usually the linker should remove unused references, and even the horrible GNU LD is capable of this. (though very slow).

Free Pascal comes with 10MB of headers, and it doesn't matter for exesize if I use the complete units or just put my own declarations(*). Even the difference in compilation speed it is sub-second.

(*) it can matter, but this is very small (tens,hundreds of bytes and is related to dynamically testing for certain functions in the case of w2k+ and XP+ functions.
Imortis
Moderator
Posts: 1734
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Postby Imortis » Aug 15, 2008 12:51

Amundo wrote:Nice work, Imortis.

...actually referencing "PB-BONES.DLL", I think it should be referencing the DLL that you're creating with all this code...


I didn't notice that... Should that not be included in the compile then?
Amundo
Posts: 57
Joined: Feb 26, 2007 0:25

Postby Amundo » Aug 17, 2008 23:36

The three SUBs (Dll_Add, Dll_Free and Dll_Context) are part of the final DLL that are built (but can be left out of the code for slight performance gains).

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 6 guests