Announcement

Collapse
No announcement yet.

Opttech raat sort header help needed

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Mike Doty
    replied
    Code:
    'pbread.bas works fine using ASCIIZ in this example  
    'Note: DO not use LSET with ASCIIZ strings
    '
    'To work with dynamic string would STRPTR be used?  
    '
    DECLARE SUB Rsvb LIB "OTSW32.DLL" ALIAS "s_1raat" (BYVAL func AS LONG, IoArea AS ASCIIZ, IOAreaLen AS DWORD, retcode AS LONG)
    'C
    'extern _declspec(dllexport) void _stdcall WINAPI s_1raat(unsigned int,LPSTR,LPINT,LPINT)
     
    FUNCTION PBMAIN AS LONG
      DIM func AS DWORD
      DIM controlstatement AS STRING
      DIM IoArea           AS ASCIIZ * 255
      DIM IoAreaLen        AS LONG
      DIM RetCode          AS DWORD
      DIM sValueToSort     AS STRING
      DIM NumberOfStrings  AS LONG
      DIM randomCharacter  AS LONG
      DIM StringLength     AS LONG
      DIM sResults         AS STRING
      func = 1
      controlStatement = "S(1,2,C,A)"
      IoArea = controlStatement
      IoAreaLen = LEN(controlstatement)
      CALL RSVB(Func,IOArea,IoAreaLen,RetCode)
      IF retcode <> 0 THEN
        ? "Unable to init simple test"
        GOTO endPgm
      END IF
    func = 2
     
    FOR NumberOfStrings = 1 TO 10
      sValueToSort = ""                                        'Create random string
      FOR StringLength  =  1 TO RND(1,10)
       RandomCharacter = RND(65,90)
       sValueToSort = sValueToSort + CHR$(RandomCharacter)
      NEXT
      IoAreaLen = LEN(sValueToSort)
      Ioarea  = sValueToSort
      CALL RSVB(Func,IOArea,IoAreaLen,RetCode)
      IF retcode <> 0 THEN
        ? "Retcode giving first record" + STR$(Retcode)
         GOTO EndPgm
      END IF
    NEXT
    DO
      func = 3
      CALL RSVB(Func,IOArea,IoAreaLen,RetCode)
      IF retcode >0 THEN EXIT DO
      #IF %DEF(%PB_CC32)
          ? MID$(IoArea,1,IoAreaLen)                              'just print using PBCC
      #ELSE
        sResults = sResults + MID$(IoArea,1,IoAreaLen) + $CRLF    'create a string so only 1 MSGBOX with PBWin
      #ENDIF
    LOOP
      ? sResults
    EndPgm:
      #IF %DEF(%PB_CC32)
        ? "Press any key to end"
        WAITKEY$
      #ENDIF
    END FUNCTION

    Leave a comment:


  • Mike Doty
    replied
    Thanks, Michael. I'm going back to the code in a few minutes and will try your suggestions.

    Leave a comment:


  • Michael Mattias
    replied
    Your results seem to suggest the control statement is being ignored.

    In the DECLARE, should "lpstring" be translated to 'BYVAL AS STRING?' I would think it should be "BYVAL AS LONG or DWORD" and you should pass "STRPTR(IoArea)."

    Or, just use a BYVAL override to STRPTR(IoArea), but I'd also check the doc to see if the required length is supposed to include a null terminator, and if so make sure ControlStatement includes CHR$(0) and included in the passed length.

    MCM

    Leave a comment:


  • Mike Doty
    started a topic Opttech raat sort header help needed

    Opttech raat sort header help needed

    Code:
    'pbread.bas
    'Visual Basic declaration
    DECLARE SUB Rsvb LIB "OTSW32.DLL" ALIAS "s_1raat" (BYVAL func AS LONG, BYVAL IoArea AS STRING,  IOAreaLen AS DWORD, retcode AS LONG)
    'C
    'extern _declspec(dllexport) void _stdcall WINAPI s_1raat(unsigned int,LPSTR,LPINT,LPINT)
    FUNCTION PBMAIN AS LONG
      DIM func AS DWORD
      DIM controlstatement AS STRING
      DIM IoArea           AS STRING
      DIM IoAreaLen        AS LONG
      DIM RetCode          AS DWORD
      DIM Testdata         AS STRING
      DIM sDummy           AS STRING
      
      IoArea = SPACE$(80)
      
      
      func = 1
      controlStatement = "S(1,2,C,A)
      ? "controlstatement ";controlstatement
      LSET IoArea = controlStatement
      IoAreaLen = LEN(controlstatement)
      CALL RSVB(Func,IOArea,IoAreaLen,RetCode)
      IF retcode <> 0 THEN
          ? "Unable to init simple test"
      ELSE
          ? "Opttech init successful"
      END IF
      
    func = 2                                      'give 2 values to the sort
      IoAreaLen = 2
      sDummy = "99"
      LSET Ioarea  = sDummy
      CALL RSVB(Func,IOArea,IoAreaLen,RetCode)
      IF retcode <> 0 THEN ? "Retcode giving first record";Retcode: GOTO EndPgm
     ? "First record passed"IoAreaLen
     
      sDummy = "01"
      LSET IoArea = sDummy
      CALL RSVB(Func,IOArea,IoAreaLen,RetCode)
      IF retcode <> 0 THEN  ? "Error giving record";Retcode:GOTO EndPgm
      ?  "Second record passed"
    func = 3
    DO
      CALL RSVB(Func,IOArea,IoAreaLen,RetCode)
      IF retcode >0 THEN EXIT DO
      ? "Returned: " ; MID$(IoArea,1,IoAreaLen)
    LOOP
    EndPgm:
      ? "Last retCode was";RetCode
      ? "Press any key to end"
      WAITKEY$
    END FUNCTION
    '
    'Results wanted:
    '01
    '99
    'Result obtained:
    '01
    '01
Working...
X