Module Dll.pkg

     1//*************************************************************************
     2//*
     3//*  Copyright (c) 1997 Data Access Corporation, Miami Florida,
     4//*  All rights reserved.
     5//*  DataFlex is a registered trademark of Data Access Corporation.
     6//*
     7//*************************************************************************
     8//*
     9//*  Module Name:
    10//*      DLL.PKG
    11//*
    12//*  Creator:
    13//*      Data Access Corporation
    14//*
    15//*  Purpose:
    16//*      Define the commands and replacements needed to call external
    17//*      function in Dynamic Link Libraies.
    18//*
    19//*  Modifications:
    20//*      JVH - Apr 30, 1999
    21//*      Changed Pointer, DWord & Handle types from Number to Integer. They
    22//*      should always have been this way. Now we can use the Handle type
    23//*      to store Object ID's.
    24//*          Previously we defined the pointer data type as a DataFlex number.
    25//*          This was a flag that will tell the DLL calling code that the passed parameter
    26//*          is a pointer and should be placed on the stack as a 4 byte value. (no longer done)
    27//*      JJT: 3/28/2006 - moved the alias datatypes (handle, pointer, dword, void_type) and the
    28//*          external function calls to fmac.
    29//*
    30//*************************************************************************
    31
    32
    33
    34// Define the sizes of the known data types
    35#REPLACE CHAR_DTSIZE 1
    36#REPLACE UCHAR_DTSIZE 1
    37#REPLACE BYTE_DTSIZE 1
    38#REPLACE SHORT_DTSIZE 2
    39#REPLACE USHORT_DTSIZE 2
    40#REPLACE WORD_DTSIZE 2
    41#REPLACE INTEGER16_DTSIZE 2
    42#REPLACE HANDLE16_DTSIZE 2
    43#REPLACE INTEGER_DTSIZE 4
    44#REPLACE UINTEGER_DTSIZE 4
    45#REPLACE DWORD_DTSIZE 4
    46#REPLACE BOOLEAN_DTSIZE 4
    47#REPLACE FLOAT_DTSIZE 4
    48#REPLACE DATE_DTSIZE 4
    49#REPLACE NUMBER_DTSIZE 4
    50#REPLACE HANDLE_DTSIZE 4
    51#REPLACE ADDR_DTSIZE 4
    52#REPLACE TIME_DTSIZE 6
    53#REPLACE BIGINT_DTSIZE 8
    54#REPLACE UBIGINT_DTSIZE 8
    55#REPLACE CURRENCY_DTSIZE 8
    56#REPLACE REAL_DTSIZE 8
    57#REPLACE DATETIME_DTSIZE 16
    58#REPLACE TIMESPAN_DTSIZE 16
    59
    60#COMMAND TYPE
    61  #PUSH !Zo
    62  #SPUSH !$             // save the old STRING
    63  #SET ZO$ 1
    64  #SET $$ !1                // retain the name of the TYPE
    65#ENDCOMMAND
    66
    67#COMMAND END_TYPE
    68  #PUSH !q
    69  #SET Q$ (!Zo - 1)
    70  #REPLACE !$_SIZE !q
    71  #POP Q$
    72  #SPOP
    73  #POP ZO$
    74#ENDCOMMAND
    75
    76#COMMAND FIELD _R "AS" _R _D .
    77  #PUSH !q
    78  #IF (!0>3)
    79    #SET Q$ (!3_DTSIZE * !4)
    80  #ELSE
    81    #SET Q$ !3_DTSIZE
    82  #ENDIF
    83  #REPLACE !1 !Zo !q
    84  #SET ZO$ (!Zo + !q)
    85  #POP Q$
    86#ENDCOMMAND
    87
    88#COMMAND Element _R "AS" _R _D .
    89  #PUSH !q
    90  #IF (!0>3)
    91    #SET Q$ (!3_DTSIZE * !4)
    92  #ELSE
    93    #SET Q$ !3_DTSIZE
    94  #ENDIF
    95  #REPLACE !1 !Zo-1
    96  #SET ZO$ (!Zo + !q)
    97  #POP Q$
    98#ENDCOMMAND
    99
   100
   101// Since DF allows the imbedding of binary zeros in strings, strings
   102// passed back to DF (via reference pointers) often need to be sized
   103// based on the position of the zero terminator.  This function will
   104// a valid DF string from a 'C' string.
   105
   106Function DWORDtoBytes Global Integer aDWORD Returns String
   107    Function_Return ( ;
   108          character(low(aDWORD) iand 255) + ;
   109          character(low(aDWORD) / 256) + ;
   110          character(hi(aDWORD) iand 255) + ;
   111          character(hi(aDWORD) / 256) )
   112End_Function
   113
   114Function SHORTtoBytes Global Integer aSHORT Returns String
   115    Function_Return ( ;
   116          character( aSHORT iand 255) + ;
   117          character( aSHORT / 256) )
   118End_Function
   119
   120Function BytesToSHORT Global String Buffer Integer Offset Returns Integer
   121    integer in1 in2
   122    ascii (mid(Buffer,1,Offset)) to in1
   123    ascii (mid(Buffer,1,Offset+1)) to in2
   124    move ( in1 + (in2*256) ) to in1
   125    if in2 gt 127 Move (in1 - 65536) to in1
   126    function_return ( in1 )
   127End_Function
   128
   129Function BytesToDWORD Global String Buffer Integer Offset Returns Integer
   130    Integer in1 in2 in3 in4
   131
   132    ascii (Mid( Buffer, 1, offset )) to in1
   133    ascii (Mid( Buffer, 1, offset+1 )) to in2
   134    ascii (Mid( Buffer, 1, offset+2 )) to in3
   135    ascii (Mid( Buffer, 1, offset+3 )) to in4
   136
   137    move (in1 + (in2*256) + (in3*65536) + (in4*16777216)) to in1
   138    function_return in1
   139End_Function
   140
   141Function CVTtoBytes Global Integer iValue Integer Offset Integer DSize String Host Returns String
   142    String Buff
   143    if      DSize eq 2 Move (SHORTtoBytes(iValue)) to Buff
   144    Else if DSize eq 4 Move (DWORDtoBytes(iValue)) to Buff
   145        Else               Move (Character(iValue))    to Buff
   146    Function_Return (OverStrike(Buff, Host, Offset))
   147End_Function
   148
   149Function BytestoCVT Global String sValue Integer Offset Integer DSize Returns Integer
   150    Integer iValue
   151    if      DSize eq 2 Move (BytestoShort(sValue,Offset)) to iValue
   152    Else if DSize eq 4 Move (BytestoDWORD(sValue,Offset)) to iValue
   153    Else               Move (Ascii(mid(sValue,1,Offset))) to iValue
   154    Function_Return (iValue)
   155End_Function
   156
   157Function StringtoBytes Global String sValue Integer Offset Integer DSize String Host Returns String
   158    string  Buff
   159    Integer Len
   160    length sValue to Len
   161    If      Len lt DSize Move (sValue+(repeat(character(0),DSize-Len))) to Buff
   162    Else if Len gt DSize Move (left(sValue,DSize)) to Buff
   163    Else                 Move sValue to Buff
   164    Function_Return (OverStrike(Buff, Host, Offset))
   165End_Function
   166
   167// Memory access functions without strings.
   168
   169Function MemoryGetByte Global Integer Buffer Integer Offset Returns Integer
   170    integer in1
   171    move (derefc(Buffer,Offset)) to in1
   172    function_return in1
   173End_Function
   174
   175Function MemoryGetWord Global Integer Buffer Integer Offset Returns Integer
   176    integer in1
   177    move (derefw(Buffer,Offset)) to in1
   178    function_return in1
   179End_Function
   180
   181Function MemoryGetDWORD Global Integer Buffer Integer Offset Returns Integer
   182    Integer in1
   183    move (derefdw( Buffer, offset)) to in1
   184    function_return in1
   185End_Function
   186
   187Procedure MemoryGetField Global Integer pSource Integer pDest Integer iOffset Integer iSize
   188    Boolean bOk
   189    Move (MemCopy(pDest,pSource+(iOffset-1),iSize)) to bok
   190End_Procedure
   191
   192Procedure MemoryPutByte Global Integer iValue Integer Offset integer Host
   193    integer in1
   194    move (storec ( Host, offset, IValue)) to in1
   195End_Procedure
   196
   197Procedure MemoryPutWord Global Integer iValue Integer Offset integer Host
   198    integer in1
   199    move (storew( Host, offset, IValue)) to in1
   200End_Procedure
   201
   202Procedure MemoryPutDWord Global Integer iValue Integer Offset integer Host
   203    Integer in1
   204    move (storedw( Host, offset, IValue)) to in1
   205End_Procedure
   206
   207Procedure MemoryPutField Global Integer pSource Integer pDest Integer iOffset Integer iSize
   208    Boolean bOk
   209    Move (MemCopy(pDest+(iOffset-1),pSource,iSize)) to bok
   210End_Procedure
   211
   212
   213//Requires that value is of the correct data type
   214#COMMAND STOREFIELD R "TO" R "AT" R // value to dest at address
   215    Send MemoryPutField !1 !3 !5 !6
   216#ENDCOMMAND
   217
   218#COMMAND PUT R "TO" R "AT" R // value to dest at address
   219    Move (CVTtoBytes(!1,!5,!6,!3)) to !3
   220#ENDCOMMAND
   221
   222#COMMAND PUT_STRING R "TO" R "AT" R R // value to dest at address
   223    Move (StringtoBytes(!1,!5,!6,!3)) to !3
   224#ENDCOMMAND
   225
   226#COMMAND GETBUFF "FROM" R "AT" R R "TO" R // From Buff at address to value
   227    Move (BytestoCVT(!2,!4,!5)) to !7
   228#ENDCOMMAND
   229
   230//Requires that destination is of the correct data type
   231#COMMAND RETRIEVEFIELD "FROM" R "AT" R R "TO" R // value to dest at address
   232    Send MemoryGetField !2 !7 !4 !5
   233#ENDCOMMAND
   234
   235#COMMAND GETBUFF_STRING "FROM" R "AT" R R "TO" R // From Buff at address to value
   236    Move (Mid(!2,!5,!4)) to !7
   237#ENDCOMMAND
   238
   239#COMMAND FILLTYPE R "WITH" R "TO" R
   240    Move (Repeat( Character(!3), !1_SIZE )) to !5
   241#ENDCOMMAND
   242
   243#COMMAND ZEROTYPE R "TO" R
   244    Move (Repeat( Character(0), !1_SIZE )) to !3
   245#ENDCOMMAND
   246
   247#COMMAND ZEROSTRING R "TO" R
   248    Move (Repeat( Character(0), !1 )) to !3
   249#ENDCOMMAND
   250
   251#COMMAND OFFSET_OF_FIELD R R "TO" R
   252    Move !1 to !4
   253#ENDCOMMAND
   254
   255#COMMAND SIZE_OF_FIELD R R "TO" R
   256    Move !2 to !4
   257#ENDCOMMAND
   258
   259
   260
   261