Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Encrypting a table field
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Divers
Thread ID:
00315680
Message ID:
00316602
Vues:
39
>PMFJI,
>
>I have been using encrypt/decrypt functions based on an article published in Foxpro Advisor by the codebook guy (don't want to try to spell his name without looking it up) but I seem to have trouble in one user's system where oracle 8 seems to have trouble with the higher end characters. Looking for a replacement and I would be interested in seeing your examples. My e-mail address is kemmrich@jkt9000,com.
>
>Thanks,
>
>Kevin


Kevin, I'm appending the 4 routines here in case anyone else is interested:
***********************************************************************
* FUNCTION      EncodeRS.PRG                  LIBRARY  FPRS\PROGS\
***********************************************************************
* Purpose.....: Returns a character string which is an encrypted version
*               of the character string tcString.
* Parameters..: tcString
*               tnSeed
* Returns.....: character -- encoded string
* Notes.......: The input string is stripped of leading and trailing blanks
*               and then padded with blanks to a length which is divisible by 4
*               The encoded string consists of the characters A through P
*               with a blank inserted after every 8 characters.
* Examples....: lcEncodedString = EncodeRS(lcString)
* Calls.......: BintoNib()
* Project.....: Rodes Software FoxPro Utilities
* Version.....: 1999
* Platform....: Visual FoxPro 5.0
* Author......: Peter Robinson
* Copyright...: (c) Rodes Software, 1999
* Created.....: 1999.02.10
* History.....:
**********************************************************************

lparameter  tcString, tnSeed

local   lcString        && Input string with leading & trailing blanks removed
local   lnPad           && number of spaces to add to the end of tcString
local   lnW             && pointer to first byte of each word (4 bytes)
local   lnWord          && bit value of each word
local   lcCrypto        && encoded string

if type("tcString") <> "C" or empty(tcString)
    return ""
endif

if type("tnSeed") <> "N" or tnSeed = 0
    return ""
endif

lcString = alltrim(tcString)

lnPad = len(lcString) % 4
if lnPad <> 0
    lcString = lcString + space(4-lnPad)
endif

rand(tnSeed)

lcCrypto = ""

for lnW = 1 to len(lcString) - 1 step 4
    lnWord = ctobin(substr(lcString,lnW,4))
    lnWord = bitxor(lnWord,rand()*2147483647)
    lcCrypto = lcCrypto + BintoNib(lnWord) + " "
endfor

return lcCrypto


***********************************************************************
* FUNCTION      DecodeRS.PRG                  LIBRARY  FPRS\PROGS\
***********************************************************************
* Purpose.....: Returns a character string which is the plain text      
*               translation of the encoded string tcString.
* Parameters..: tcString
*               tnSeed
* Returns.....: character -- plain text
* Notes.......: The encoded string consists of the characters A through P
*               with a blank inserted after every four characters.
* Examples....: lcPlainText = DecodeRS(lcEncodedString)
* Calls.......: NibtoBin()
* Project.....: Rodes Software FoxPro Utilities
* Version.....: 1999
* Platform....: Visual FoxPro 5.0
* Author......: Peter Robinson
* Copyright...: (c) Rodes Software, 1999
* Created.....: 1999.02.10
* History.....:
**********************************************************************

lparameter  tcString, tnSeed

local   lcString    && Input string with blanks stripped out
local   lnW         && pointer to beginning of each word (8 nibbles)
local   lnWord      && bit value of each word
local   lcPlain     && decoded string

if type("tcString") <> "C" or empty(tcString)
    return ""
endif

if type("tnSeed") <> "N" or tnSeed = 0
    return ""
endif

lcString = chrtran(tcString," ","")

if len(lcString) % 8 <> 0
    return ""
endif   
    
rand(tnSeed)

lcPlain = ""

for lnW = 1 to len(lcString) - 1 step 8
    lnWord = NibtoBin(substr(lcString,lnW,8))
    lnWord = bitxor(lnWord,rand()*2147483647)
    lcPlain = lcPlain + bintoc(lnWord) 
endfor

return lcPlain


***********************************************************************
* FUNCTION      BintoNib.PRG
***********************************************************************
* Purpose.....: Convert a signed integer to the equivalent in nibbles
*               (half-bytes) where 0000 = A, 0001 = B, ...,  1111 = P
* Parameters..: tnWord
* Returns.....: char -- 8 
* Notes.......: Bit patterns:
*                        15 = 00001111   
*                      240 = 11110000  
*                      255 = 00000000 00000000 00000000 11111111 
*                    65280 = 00000000 00000000 11111111 00000000           
*                 16711680 = 00000000 11111111 00000000 00000000 
*
* Examples....: Following expressions produce a true value:
*                 BintoNib(-2147483648) = "IAAAAAAA"    && -2^31
*                 BintoNib(-1)          = "PPPPPPPP"
*                 BintoNib(0)           = "AAAAAAAA"
*                 BintoNib(1)           = "AAAAAAAB"
*                 BintoNib(2147483647)  = "HPPPPPPP"    && 2^31 - 1
*
* Calls.......: none
* Created.....: 1999.02.10
* History.....: 
**********************************************************************

LPARAMETER tnWord

local   lnByte1, lnByte2, lnByte3, lnByte4

if type("tnWord") <> "N"
    return space(8)
endif

lnByte1 = bitrshift(tnWord,24)
lnByte2 = int(bitand(tnWord,16711680) / 65536)
lnByte3 = int(bitand(tnWord,65280) / 256 )
lnByte4 = bitand(tnWord,255)

return chr(65 + bitand(lnByte1,240)/16  ) ;
    +  chr(65 + bitand(lnByte1,15)      ) ;
    +  chr(65 + bitand(lnByte2,240)/16  ) ;
    +  chr(65 + bitand(lnByte2,15)      ) ;
    +  chr(65 + bitand(lnByte3,240)/16  ) ;
    +  chr(65 + bitand(lnByte3,15)      ) ;
    +  chr(65 + bitand(lnByte4,240)/16  ) ;
    +  chr(65 + bitand(lnByte4,15)      ) 


***********************************************************************
* FUNCTION      NibtoBin.PRG
***********************************************************************
* Purpose.....: Convert a nibble string (half-bytes--characters A-P)
*               to the equivalent signed integer
*               where 0000 = A, 0001 = B, ...,  1111 = P
* Parameters..: tnWord
* Returns.....: char -- 8
* Notes.......: Bit patterns:
*                         16 = 00000000 00000000 00000000 00010000
*                        256 = 00000000 00000000 00000001 00000000
*                       4096 = 00000000 00000000 00010000 00000000
*                      65536 = 00000000 00000001 00000000 00000000
*                    1048576 = 00000000 00010000 00000000 00000000
*                   16777216 = 00000001 00000000 00000000 00000000
*                 2147483647 = 01111111 11111111 11111111 11111111 = 2^31-1
*
* Examples....: Following expressions produce a true value:
*                 NibtoBin("IAAAAAAA") = -2147483648
*                 NibtoBin("PPPPPPPP") = -1
*                 NibtoBin("AAAAAAAA") = 0
*                 NibtoBin("AAAAAAAB") = 1
*                 NibtoBin("HPPPPPPP") = 2147483647
*
* Calls.......: none
* Created.....: 1999.02.10
* History.....:
**********************************************************************

lparameter  tcNibbles

local   lcNibble            && input string padded on left with "A"
local   lnNibble1           && numeric value of first nibble
local   lnRest              && numeric value of remaining nibbles

if type("tcNibbles") <> "C" or empty(tcNibbles)
    return 0
endif

lcNibbles = right("AAAAAAAA"+upper(alltrim(tcNibbles)),8)

lnNibble1 = asc(substr(lcNibbles,1,1)) - 65
** avoid setting sign bit

lnRest = (asc(substr(lcNibbles,2,1)) - 65) * 16777216  ;
    +    (asc(substr(lcNibbles,3,1)) - 65) * 1048576  ;
    +    (asc(substr(lcNibbles,4,1)) - 65) * 65536    ;
    +    (asc(substr(lcNibbles,5,1)) - 65) * 4096     ;
    +    (asc(substr(lcNibbles,6,1)) - 65) * 256      ;
    +    (asc(substr(lcNibbles,7,1)) - 65) * 16       ;
    +    (asc(substr(lcNibbles,8,1)) - 65)

return bitor(bitlshift(lnNibble1,28),lnRest)
Peter Robinson ** Rodes Design ** Virginia
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform