forum.clarionlife.net

Код: Выделить всё

   PROGRAM
    MAP
SingleProc    Function(...),*CString
    END
c  &CString
  CODE
  c &= SingleProc(...)
! обработка
 Dispose(c)
!End of Program

SingleProc    Function(...)
cStr   &CString
N       LONG
   Code
! вычисление длины N
   cStr &= NEW(CString(N))
! обработка...
 RETURN cStr

Код: Выделить всё

 MAP ! можно в inside the global map, тогда MAP END не надо
 MODULE('WinApi')
 my_memcpy(LONG addrTarget,LONG addrSource,LONG inSize),LONG,RAW,NAME('_memcpy'),PROC
!                куда              откуда       размер
 END
 END

Код: Выделить всё

CopyBufToString PROCEDURE(LONG inLen, LONG inAddr)
loc:Buf                 &STRING
 CODE
 loc:Buf &= NEW STRING(inLen) 
 my_memcpy(ADDRESS(loc:Buf),inAddr,inLen)

 RETURN loc:Buf

Код: Выделить всё

  MAP
      Module ('kernel32.dll')
         ! Unicode CString --> CString
         WideCharToMultiByte(Unsigned CodePage, ULong dwFlags,                |
                             *CString lpWideCharStr,  Signed cchWideChar=-1,  |
                             *CString lpMultiByteStr, Signed cbMultiByte,     |
                             ULong Addr_lpCStr_DefaultChar=0, ULong lpBool_UsedDefaultChar=0), Signed, RAW, Pascal, Dll, Name('WideCharToMultiByte')
         ! CString --> Unicode CString
         MultiByteToWideChar(Unsigned CodePage, ULong dwFlags,                |
                             *CString lpMultiByteStr, Signed cbMultiByte,     |
                             *CString lpWideCharStr,  Signed cchWideChar), Signed, RAW, Pascal, Dll, Name('MultiByteToWideChar')

      End

       GetValFromAddr(String Type_WCS124L6R8, ULong addr, Long Leng=-1), ?, Name('GetValFromAddr@ZWM_Function')
       WideCStr_To_Str(*CString cstr, Long Leng=-1), String, Name('WideCStr_To_Str@ZWM_Function')
       Str_To_WideStr (String str), String, Name('Str_To_WideStr@ZWM_Function')
  END

Код: Выделить всё

!==========================================================================================
GetValFromAddr       FUNCTION (String Type_WCS124L6R8, ULong addr, Long Leng=-1) !, ?
!==========================================================================================
! Реализует возврат значения по указателю.
! На входе: addr    - адрес значения
!           Type_?  - литера 'C' или 'c'         - вернуть String, то есть в ADDR адрес CString
!                     литера 'W' или 'w'         - вернуть String, полагая в ADDR адрес WideString (Unicode),
!                                                  при этом может быть задан параметр Leng > 0 число символов (а не байт)
!                     литера 'S' или 's'         - вернуть String, то есть в ADDR адрес String, при этом обязателен
!                                                  параметр Leng > 0, число байт
!                     литера '1'                 - вернуть Byte,    то есть в ADDR адрес байта
!                     литера '2'                 - вернуть USort,   то есть в ADDR адрес 2-байтового числа
!                     литера 'L' или 'l' или '4' - вернуть Long,    то есть в ADDR адрес 4-байтового числа
!                     литера '6'                 - вернуть строку из 6 байт
!                     литера 'R' или 'r' или '8' - вернуть REAL
! Следующие структуры используют одно и то же место в памяти
! и реализуют получение по адресу значения

AddressX  Group                 ! адрес на значение переменной
addrX       ULong
lng         ULong
          End
pCString  Group,Over(AddressX)    ! ссылка на CSTRING
_str        &CString
          End
p_String  Group,Over(AddressX)    ! ссылка на STRING
_str        &String
          End
pLong     Group,Over(AddressX)    ! ссылка на ULong
_long       &ULong
          End
pByte     Group,Over(AddressX)    ! ссылка на Byte
_byte       &Byte
          End
pUShort   Group,Over(AddressX)    ! ссылка на UShort
_short      &UShort
          End
pReal     Group,Over(AddressX)    ! ссылка на Real
_real       &Real
          End

  CODE
  
  AddressX.addrX = addr
  Case Upper(Type_WCS124L6R8)
    Of 'C'
      Return(pCString._str)
    Of 'W'
      Return( WideCStr_To_Str(pCString._str, Leng) )
    Of 'S'
      If Leng < 1 Then Return ('').
      AddressX.lng = Leng
      Return(p_String._str)
    Of '1'
      Return(pByte._byte)
    Of '2'
      Return(pUShort._short)
    Of '4' OrOf 'L'
      Return(pLong._long)
    Of '6'
      AddressX.lng = 6
      Return(p_String._str)
    Of '8' OrOf 'R'
      Return(pReal._real)
    Else
      IF MESSAGE('Непоправимая ошибка программиста.|'& |
                 'Нужно задавать тип источника как один из:|'& |
                 '  "C" или "c"         - CSTRING|'& |
                 '  "W" или "w"         - Unicode CSTRING или Unicode STRING|'& |
                 '  "S" или "s"         - STRING|'& |
                 '  "L" или "l" или "4" - ULONG|'& |
                 '  "R" или "r" или "8" - REAL|'& |
                 '  "1"                 - BYTE|'& |
                 '  "2"                 - USHORT|'& |
                 '  "6" (специальный)   - STRING(6)||'& |
                 'Для типа "W" может быть задана длина строки Unicode (в символах)'& |
                 'Для типа "S" ДОЛЖНА быть задана длина строки (в байтах)' |
            , 'GetFromAddr - ERROR.', ICON:HAND, '&STOP|&IGNORE') = 1 THEN
        HALT(999)
      END
      Return('')
  End


WideCStr_To_Str  Function(*CString cstr, Long Leng=-1) !, String
buf  CString(2048)
  Code
    WideCharToMultiByte(0, 0, cstr, Leng, buf, Size(buf))
  Return (buf)