Try this one! Encryption needs

[simoncpage]

Hi, I want to be able to encrypt and decrypt file straight from a dialog box in excel and word. Can anyone tell me of any stuff I can look at on this I am a bit of a beginner to encryption routines. Any help would be great!

Thanks

Simon

 

[930driver]

Here is a pair of elementary encryption functions for you to play with. Watch out for line wraps.


Option Explicit

Function gpcDecryptString(ByVal vsInput As String, ByVal vsKey As String)
As String
' *********************************************************************
' *** gpcDecryptString
' *** function: returns decrypted version of ANSI string
' *** accepts: input string and encrypytion key
' *** returns: decrypted string
' *** date: 3/8/96
' *** author: gpc
' *********************************************************************
' *** LOG date who what
' *** 5/15/96 gpc patched security hole when a string of nulls
' *** is passed; will not handle chars < 32
' ***
' ***************************************************************70col>

' definitions
Dim iString As Integer, iKey As Integer
Dim sRetVal As String, iT As Integer

' error handler
On Error GoTo gpcDecryptString_Err

' START
For iT = 1 To Len(vsInput)
iString = Asc(Mid$(vsInput, iT))
If iString >= 32 Then
iKey = iT Mod Len(vsKey): If iKey = 0 Then iKey = Len(vsKey)
iString = iString - 32
iString = iString - Asc(Mid$(vsKey, iKey))
iString = iString - (223 * (iString < 0))
iString = iString + 32
End If
sRetVal = sRetVal + Chr$(iString)
Next iT

gpcDecryptString_End:
On Error Resume Next
gpcDecryptString = sRetVal

On Error GoTo 0
Exit Function

gpcDecryptString_Err:
MsgBox Error$, 16, &quot;gpcDecryptString&quot;
Resume gpcDecryptString_End

End Function

Function gpcEncryptString(ByVal vsInput As String, ByVal vsKey As String)
As String
' *********************************************************************
' *** gpcEncryptString
' *** function: returns encrypted version of ANSI string
' *** accepts: input string and encrypytion key
' *** returns: encrypted string
' *** date: 3/8/96
' *** author: gpc
' *********************************************************************
' *** LOG date who what
' *** 5/15/96 gpc patched security hole when a string of nulls
' *** is passed; will not handle chars < 32
' ***
' ***************************************************************70col>

' definitions
Dim iString As Integer, iKey As Integer
Dim sRetVal As String, iT As Integer

' error handler
On Error GoTo gpcEncryptString_Err

' START
For iT = 1 To Len(vsInput)
iString = Asc(Mid$(vsInput, iT))
iKey = iT Mod Len(vsKey): If iKey = 0 Then iKey = Len(vsKey)
If iString >= 32 Then
iString = iString + Asc(Mid$(vsKey, iKey))
iString = iString - 32
iString = iString + (223 * (iString > 223))
iString = iString + 32
End If
sRetVal = sRetVal + Chr$(iString)
Next iT

gpcEncryptString_End:
On Error Resume Next
gpcEncryptString = sRetVal

On Error GoTo 0
Exit Function

gpcEncryptString_Err:
MsgBox Error$, 16, &quot;gpcEncryptString&quot;
Resume gpcEncryptString_End

End Function

&quot;The Key, The Whole Key, and Nothing But The Key, So Help Me Codd!&quot;