2004-08-14 18:00

'
' ------------------------------------------------------------
' RC4 - CRYPTING AND DECRYPTING - RAPIDQ  ASSEMBLER  FUNCTIONS
' Version 002       Augut 13th, 2004       by Jacques PHILIPPE
' Speed : ~20  MegaBytes  encrypted/second  on  a  DURON  1200
' Type_2b : "RC4Asm.Bin" file required in the directory
' ------------------------------------------------------------
' ============================================================
' -- INCLUDE ASM PROCEDURES -- : RC4BinStr, RC4Init, RC4Pipe
' ============================================================
     $IFNDEF CALL_ASM_PROC_X
      $DEFINE CALL_ASM_PROC_X
      DECLARE FUNCTION CallAsmProc LIB "user32" ALIAS "CallWindowProcA" (ptrProc AS LONG, _
       A1 AS LONG, A2 AS LONG, A3 AS LONG, A4 AS LONG) AS LONG
     $ENDIF
' ============================================================
     $RESOURCE LIB_RC4ASM AS "RC4Asm.rql"
     DIM MS_RC4Asm AS QMEMORYSTREAM
     MS_RC4Asm.ExtractRes(Resource(LIB_RC4ASM))
' ============================================================
     DEFINT ptrRC4BinStr = MS_RC4Asm.Pointer + 0
     FUNCTION RC4BinStr (sDatas AS STRING, sKEY AS STRING) AS LONG
      DEFSTR ssDatas = sDatas
      DEFSTR ssKEY = sKEY
      Result = CallAsmProc (ptrRC4BinStr, VARPTR(ssDatas), VARPTR(ssKEY), 0, 0)
     END FUNCTION
' ------------------------------------------------------------
     DEFINT ptrRC4Init = MS_RC4Asm.Pointer + 311
     FUNCTION RC4Init (sTable AS STRING, sKEY AS STRING) AS LONG
      DEFSTR ssTable = sTable
      DEFSTR ssKEY = sKEY
      Result = CallAsmProc (ptrRC4Init, VARPTR(ssTable), VARPTR(ssKEY), 0, 0)
     END FUNCTION
' ------------------------------------------------------------
     DEFINT ptrRC4Pipe = MS_RC4Asm.Pointer + 499
     FUNCTION RC4Pipe (sTable AS STRING, sDatas AS STRING) AS LONG
      DEFSTR ssTable = sTable
      DEFSTR ssDatas = sDatas
      Result = CallAsmProc (ptrRC4Pipe, VARPTR(ssTable), VARPTR(ssDatas), 0, 0)
     END FUNCTION
' ============================================================
' --- RQ CODE ------------------------------------------------
' ============================================================
' $TYPECHECK ON
' ============================================================
' -- CONSTANTES RETURNED ERROR --
' ----------------------------
     CONST RC4ASM_FINISHED_OK = 0
     CONST RC4ASM_ERROR_PTR_KEY = 1
     CONST RC4ASM_ERROR_LEN_KEY = 2
     CONST RC4ASM_ERROR_PTR_DATAS = 3
     CONST RC4ASM_ERROR_LEN_DATAS = 4
     CONST RC4ASM_ERROR_PTR_STABLE = 5
     CONST RC4ASM_ERROR_FILE_IN_CANT_BE_OPENED = 6
     CONST RC4ASM_ERROR_CANT_CREATE_FILE_OUT = 7
     CONST RC4ASM_ERROR_IBITSIZE_IN_RC4FILE_PIPE = 8
     CONST RC4ASM_ERROR_UNEXPECTED = 255
' ============================================================
' ==== GetRC4AsmErrorByName===================================
'  Returns the Name on an Rc4Asm Error 0 to 7
     FUNCTION GetRC4AsmErrorByName (iError AS LONG) AS STRING
      SELECT CASE iError
      CASE RC4ASM_FINISHED_OK                     ' = 0
       Result = " *** RC4ASM FINISHED_OK *** "
      CASE RC4ASM_ERROR_PTR_KEY                   ' = 1
       Result = " *** RC4ASM ERROR_PTR_KEY *** "
      CASE RC4ASM_ERROR_LEN_KEY                   ' = 2
       Result = " *** RC4ASM ERROR_LEN_KEY *** "
      CASE RC4ASM_ERROR_PTR_DATAS                 ' = 3
       Result = " *** RC4ASM ERROR_PTR_DATAS *** "
      CASE RC4ASM_ERROR_LEN_DATAS                 ' = 4
       Result = " *** RC4ASM ERROR_LEN_DATAS *** "
      CASE RC4ASM_ERROR_PTR_STABLE                ' = 5
       Result = " *** RC4ASM ERROR_PTR_STABLE *** "
      CASE RC4ASM_ERROR_FILE_IN_CANT_BE_OPENED    ' = 6
       Result = " *** RC4ASM ERROR FILE IN CANT BE OPENED ***"
      CASE RC4ASM_ERROR_CANT_CREATE_FILE_OUT      ' = 7
       Result = " *** RC4ASM ERROR CANT CREATE FILE OUT ***"
      CASE RC4ASM_ERROR_IBITSIZE_IN_RC4FILE_PIPE  ' = 8
       Result = " *** RC4ASM ERROR IBITSIZE_IN_RC4FILE_PIPE ***"
      CASE ELSE
       Result = " *** RC4ASM ERRONEOUS ERROR NUMBER :) " & STR$(iError) & " ***"
      END SELECT
     END FUNCTION
' ============================================================
' ==== RC4File ===============================================
' ENCRYPT/DECRYPT sPathFileNameIn in sPathFilNameOut With KEY by splitting
' the file in multiple bits of the same size -except the last bit-. The lenght
' of the bits to RC4 is set iBitsSize
'
     FUNCTION RC4File (PathFileNameIn AS STRING, PathFileNameOut AS STRING, Key AS STRING, iBitsSize AS LONG) AS LONG
      DEFSTR sPathFileNameIn = PathFileNameIn, sPathFileNameOut = PathFileNameOut
      DIM file2Rc4 AS QFILESTREAM
      DIM fileRC4Out AS QFILESTREAM
      DIM sTable AS STRING * 258
      DEFINT iReturn
      DEFINT iFileLengthLeft
      DEFSTR sBits, sTmp
      DEFSTR sKey = KEY
'
      IF iBitsSize < 1 THEN Result = RC4ASM_ERROR_IBITSIZE_IN_RC4FILE_PIPE:EXIT FUNCTION ' = 8
'
      IF file2RC4.OPEN (sPathFileNameIn, 0) <> 0 THEN                ' 0 = fmOpenRead
       IF fileRC4Out.OPEN (sPathFileNameOut, 65535) <> 0 THEN   ' 65535 = fmCreate
        iFileLengthLeft = file2RC4.Size
        file2RC4.Position = 0
            ' Initialise the sTable with the Key
        iReturn = RC4Init (sTable, sKey)
        DO
         IF iReturn = 0 THEN     ' Init OK
          IF iFileLengthLeft >= iBitsSize THEN
           sBits = file2RC4.ReadBinStr (iBitsSize)
           iReturn = RC4Pipe (sTable, sBits)
           IF iReturn <> 0 THEN Result = iReturn:EXIT DO
           fileRC4Out.WriteBinStr (sBits, iBitsSize)
           iFileLengthLeft = iFileLengthLeft - iBitsSize
          ELSE
           sBits = file2RC4.ReadBinStr (iFileLengthLeft)
           iReturn = RC4Pipe (sTable, sBits)
           IF iReturn <> 0 THEN Result = iReturn:EXIT DO
           fileRC4Out.WriteBinStr (sBits, iFileLengthLeft)
           iFileLengthLeft = 0
          END IF
         ELSE                    ' Init Failed
          Result = iReturn
          EXIT DO
         END IF

        LOOP UNTIL iFileLengthLeft = 0
        fileRC4Out.CLOSE
       ELSE
        Result = RC4ASM_ERROR_CANT_CREATE_FILE_OUT  ' = 7
       END IF
       file2RC4.CLOSE
      ELSE
       Result = RC4ASM_ERROR_FILE_IN_CANT_BE_OPENED    ' = 6
       EXIT FUNCTION
      END IF
      IF iFileLengthLeft <= 0 THEN Result = 0
     END FUNCTION
' ============================================================
     $TYPECHECK OFF
'

2004-08-14 18:00