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_1a : "RC4Asm.Bin" and "RC4Asm.Rqh" file required in the
'           directory
' ------------------------------------------------------------
'
' ============================================================
' -- INCLUDE ASM PROCEDURES -- : RC4BinStr, RC4Init, RC4Pipe
' ----------------------------
     $INCLUDE "RC4Asm.Rqh"
' ============================================================
' --- 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