Scramble password a little bit

C

count

Hi,
I will have to store permitted usernames and passwords in a file - for
validation routine in VBA.
I think that users might discover that file so I plan to scramble passwords
a little bit.
I was thinking of:
1. store passwords in numeric form, converting each char to 3-digit number
(ASCII multiplied by 13?... 17? subtract 29 on odd positions?)
2. introducing a few dummy chars - so I can detect manipulation e.g. when
they clear pass field completely

Has anyone got better=simpler idea, possibly with a code that does it?
Help greatly appreciated because the project is late <g>
Regards,
Paul
 
K

keepITcool

The problem with this codec is that the cypher may contain a nullchar,
thus storing it as a string is out of the question.
I've included a quick trick to store the charactar codes..


Sub CodecTest()
Dim c$
Const p = "Please Encode this"

c = Codec(p)
MsgBox "Plain:" & p & vbNewLine & _
"Codec:" & Codec(c) & vbNewLine & _
"Cyper:" & String(Len(c), "*") & vbNewLine & _
"unshielded cypher:" & c & vbNewLine & _
"nullchar? :" & InStr(c, vbNullChar)

Dim ab() As Byte
ab = c
With Application.WorksheetFunction
ActiveCell.Resize(1, 1 + UBound(ab)) = .Transpose(.Transpose(ab))
End With
End Sub


Function Codec(str As String) As String
Const cPW = "mypass"
Dim abStr() As Byte, abKey() As Byte, i%
'Fill the key byte array
'repeat const, same length as str
abKey = Left(Application.Rept(cPW, Len(str)), Len(str))
'Fill the byte array for the string
abStr = str
'De/Encode
For i = LBound(abStr) To UBound(abStr)
abStr(i) = abKey(i) Xor abStr(i)
Next
Codec = abStr
End Function




keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
C

count

Thanks for that!
Regards, Paul

U¿ytkownik "keepITcool said:
The problem with this codec is that the cypher may contain a nullchar,
thus storing it as a string is out of the question.
I've included a quick trick to store the charactar codes..


Sub CodecTest()
Dim c$
Const p = "Please Encode this"

c = Codec(p)
MsgBox "Plain:" & p & vbNewLine & _
"Codec:" & Codec(c) & vbNewLine & _
"Cyper:" & String(Len(c), "*") & vbNewLine & _
"unshielded cypher:" & c & vbNewLine & _
"nullchar? :" & InStr(c, vbNullChar)

Dim ab() As Byte
ab = c
With Application.WorksheetFunction
ActiveCell.Resize(1, 1 + UBound(ab)) = .Transpose(.Transpose(ab))
End With
End Sub


Function Codec(str As String) As String
Const cPW = "mypass"
Dim abStr() As Byte, abKey() As Byte, i%
'Fill the key byte array
'repeat const, same length as str
abKey = Left(Application.Rept(cPW, Len(str)), Len(str))
'Fill the byte array for the string
abStr = str
'De/Encode
For i = LBound(abStr) To UBound(abStr)
abStr(i) = abKey(i) Xor abStr(i)
Next
Codec = abStr
End Function




keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
Click to expand...
 
Top