Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Password protection

Posted on 1999-07-27
4
Medium Priority
?
262 Views
Last Modified: 2006-11-17
Hello All
        What is the best way to password protect an application,If you have any source code for password could you also mail it.
cheers T

0
Comment
Question by:turloughm
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 

Author Comment

by:turloughm
ID: 1527700
My Email is turloughm@hotmail.com
0
 
LVL 12

Expert Comment

by:mark2150
ID: 1527701
turloughm,

Posting email only requests is considered bad form here on E-E as it deprives the other members of the benefits of the answers.

Anyway, back to the point. Password is a topic that comes up fairly often. Generally, passwording an app is more trouble than it's worth. Someone with physical access to your workstation can compromise most anything you can code. Problem is where to save the password. You can't really keep it buried in the .EXE, the registry and local files are all easily compromised.

If you're on a LAN you can have absolute control by letting the LAN handle the issue.

What are you after? Are you just trying to block your app from running or are you trying to block access to a database or file? Are you set for stand-alone operation or LAN based? How much security is enough?

M



0
 
LVL 18

Accepted Solution

by:
deighton earned 200 total points
ID: 1527702
Encrypt the users password and put it in a file.  Make the user enter his password at a start up screen then encrypt it as well.  If it matches the encrypted password on file then he's in, if not end.  looking in the password file doesn't help 'cos he only sees coded info.

here's 2 functions encrypt and decrypt for you.

Option Explicit
Private Function BinToB64(B1 As Byte) As String
'----------------------------------------------------------------
'
'    in B1  : Base64 Binary (0-63)
'    return : Base64 Ascii Code
'----------------------------------------------------------------
Dim A1 As String

    If B1 <= 25 Then A1 = Chr(Asc("A") + B1)
    If B1 > 25 And B1 <= 51 Then A1 = Chr(Asc("a") + B1 - 26)
    If B1 > 51 And B1 <= 61 Then A1 = Chr(Asc("0") + B1 - 52)
    If B1 = 62 Then A1 = "+"
    If B1 = 63 Then A1 = "/"

    BinToB64 = A1
'Debug.Print B1; A1
End Function

Private Sub base64decode(B64str As String, Bstr() As Byte, BCnt As Long)
'----------------------------------------------------------------
' BASE64 DECODER [1996/04/27]
'    6bit ASCII -> 8bit Binary
'      in  B64str : Base64 ASCII Code Data
'      out Bstr   : 8bit Binary Data
'      out BCnt   : Bstr Data Length
'----------------------------------------------------------------

Dim Bmode As Integer
Dim ACnt As Long
Dim B1 As Byte
Dim RetVal As Integer
   
    ACnt = 0
    BCnt = 0
    Bmode = 0
   
    Do Until (Mid$(B64str, ACnt + 1, 1) = "=" Or Len(B64str) <= ACnt)
      If Fix(ACnt Mod 100) = 0 Then RetVal = DoEvents()
      B1 = B64ToBin(Mid$(B64str, ACnt + 1, 1))
      If B1 >= 0 And B1 <= 63 Then
        Select Case Bmode
            Case 0
              Bstr(BCnt) = B1 * 4                           'ãˆÊ6Bit
            Case 1
              Bstr(BCnt) = Bstr(BCnt) + (B1 \ 16)           '‰ºˆÊ2Bit
              BCnt = BCnt + 1                               '     +
              Bstr(BCnt) = (&HF And B1) * 16                'ãˆÊ4Bit
            Case 2
              Bstr(BCnt) = Bstr(BCnt) + (B1 \ 4)            '‰ºˆÊ4Bit
              BCnt = BCnt + 1                               '     +
              Bstr(BCnt) = (&H3 And B1) * 64                'ãˆÊ2Bit
            Case 3
              Bstr(BCnt) = Bstr(BCnt) + B1                  'ãˆÊ6Bit
              BCnt = BCnt + 1
        End Select
        Bmode = Bmode + 1
        If Bmode > 3 Then Bmode = 0
      End If
      ACnt = ACnt + 1
    Loop

End Sub


Private Function B64ToBin(A1 As String) As Byte

    Dim B1 As Byte

    If Len(A1) <> 1 Then
        B64ToBin = 255
        Exit Function
    End If
    B1 = 255
    If Asc(A1) >= Asc("A") And Asc(A1) <= Asc("Z") Then B1 = Asc(A1) - Asc("A") + 0
    If Asc(A1) >= Asc("a") And Asc(A1) <= Asc("z") Then B1 = Asc(A1) - Asc("a") + 26
    If Asc(A1) >= Asc("0") And Asc(A1) <= Asc("9") Then B1 = Asc(A1) - Asc("0") + 52
    If A1 = "+" Then B1 = 62
    If A1 = "/" Then B1 = 63

    B64ToBin = B1

End Function

Private Sub base64encode(Bstr() As Byte, Blen As Long, B64str As String)
'----------------------------------------------------------------
' BASE64 ENCODER [1996/04/27]
'    8bit Binary -> 6bit ASCII (A-Z,a-z,0-9,+,/,[=])
'      + Bstr   : 8bit Binary Data
'      + Blen   : Bstr Data Length
'      - B64str : Base64 ASCII Code Data
'----------------------------------------------------------------
Dim Bmode As Integer
Dim Cnt As Long
Dim B1 As Byte
Dim RetVal As Integer
Dim Str1 As String
Dim m As Integer
Dim Pos As Integer

    B64str = ""
    Cnt = 0
    Bmode = 0
       
    Do Until Blen <= Cnt
      If Fix(Cnt Mod 100) = 0 Then RetVal = DoEvents()
      B1 = Bstr(Cnt)
      Select Case Bmode
        Case 0
          B1 = (&HFC And B1) \ 4
        Case 1
          B1 = (&H3 And B1) * 16
          Cnt = Cnt + 1
          If Blen > Cnt Then
            B1 = B1 + (&HF0 And Bstr(Cnt)) \ 16
          End If
        Case 2
          B1 = (&HF And B1) * 4
          Cnt = Cnt + 1
          If Blen > Cnt Then
            B1 = B1 + (&HC0 And Bstr(Cnt)) \ 64 'ãˆÊ2Bit
          End If
        Case 3
          B1 = &H3F And B1                      '‰ºˆÊ6Bit
          Cnt = Cnt + 1
      End Select
     
      B64str = B64str & BinToB64(B1)

      Bmode = Bmode + 1
      If Bmode > 3 Then Bmode = 0
     
    Loop
   
    Select Case Bmode
      Case 0
        B64str = B64str
      Case 1, 2
        B64str = B64str & "=="
      Case 3
        B64str = B64str & "="
    End Select
   
'    Str1 = ""
'    m = 0
  '  Do Until Len(B64str) <= m * 76
 '       Pos = m * 76 + 1
   '     If Len(B64str) - Pos > 76 Then
    '        Str1 = Str1 & Mid$(B64str, Pos, 76) & vbCrLf
      '  Else
'            Str1 = Str1 & Mid$(B64str, Pos, Len(B64str) - m * 76) & vbCrLf
     '   End If
      '  m = m + 1
  '  Loop
   
    Debug.Print "Base64 Last Encode Mode = "; Bmode
   
End Sub
Public Function decode64(x As String) As String

'Private Sub base64decode(B64str As String, Bstr() As Byte, BCnt As Long)

    Dim n() As Byte
    Dim ni As Long
    Dim sString As String
    Dim c As Long
   
    ReDim n(Len(x) + 1)
   
    ni = Len(x)
   
    Call base64decode(x, n(), ni)
   
    For c = 1 To ni
       
        decode64 = decode64 + Chr(n(c - 1))
   
    Next
   
End Function




      Public Function charToBits(ByVal x As Integer) As String

        Dim iBit As Integer

          While x > 0
           
              iBit = x Mod 2
               
              charToBits = CStr(iBit) & charToBits
               
              x = x \ 2
               
          Wend
           
        charToBits = String(8 - Len(charToBits), "0") & charToBits
               

      End Function

'
Public Function encode64(sX As String) As String

    Dim x() As Byte
    Dim iLen As Long, c As Long
    Dim sString As String
   
    iLen = Len(sX)
    ReDim x(iLen - 1)
   
    For c = 0 To iLen - 1
   
        x(c) = Asc(Mid(sX, c + 1, 1))
       
    Next
   
    Call base64encode(x, iLen, sString)
   
    encode64 = sString


End Function

Public Function Encrypt(x As String) As String
   
    Dim c As Long
    Dim lseed As Long
    Dim iShift As Integer
    Dim iAtom As Integer
    Dim sBytes As String
   
    lseed = 4568 + Len(x)
   
    iShift = Rnd(-1)
   
    Randomize lseed
   
    For c = 1 To Len(x)
           
        iShift = Int(Rnd * 256)
        iAtom = Asc(Mid(x, c, 1))
        iAtom = iAtom + iShift
        If iAtom > 255 Then iAtom = iAtom - 256
           
        sBytes = sBytes & Chr(iAtom)
           
    Next
       
    Encrypt = encode64(sBytes)
   
End Function

Public Function decrypt(x As String) As String

    Dim c As Long
    Dim lseed As Long
    Dim iShift As Integer
    Dim iAtom As Integer
    Dim sBytes As String
   
    sBytes = decode64(x)
   
   
    lseed = 4568 + Len(sBytes)
   
    iShift = Rnd(-1)
   
    Randomize lseed
   
   
    For c = 1 To Len(sBytes)
           
        iShift = Int(Rnd * 256)
        iAtom = Asc(Mid(sBytes, c, 1))
        iAtom = iAtom - iShift
        If iAtom < 0 Then iAtom = iAtom + 256
           
        decrypt = decrypt & Chr(iAtom)
           
    Next
       
       
   
End Function

      Public Function StringToBits(x As String) As String

          Dim c As Long

          For c = 1 To Len(x)
           
      StringToBits = StringToBits & charToBits(Asc(Mid(x, c, 1)))
               
          Next
           

      End Function




0
 

Author Comment

by:turloughm
ID: 1527703
The code above is good for my encrypyion ,I will have many levels of user.what type of data storage should i use , How should i go about using this storage
cheers turlough

0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

722 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question