Solved

registry

Posted on 2000-04-08
4
288 Views
Last Modified: 2010-05-02
I have written a set of preferences to the registry using

GetSetting(App.Title, "Settings", "prefs")

and

SaveSetting App.Title, "Settings", "prefs", "some value"

This is ok for most things, but to keep a couple of things from being easily accessable, I'd like to have them written in binary or something - that is to get and save the values to the registry with something other than text.  I believe this is possible, but I'm not sure of the method or one similar to it.
0
Comment
Question by:Daron1
  • 2
4 Comments
 
LVL 1

Accepted Solution

by:
skip99 earned 300 total points
ID: 2697110
Convert the String into Just that Binary (ones and zeros), and save it, then when you want to read it back in convert it back. Unless somebody wants to write an application to convert the setting back it's pretty safe.

Add the following code to a module and your on your way!

'-------------------------------------
'Convert text To Binary:
' SaveSetting App.Title, "Settings", "prefs", TextToBinary("string you want to convert")
'
'Convert Binary back to Text:
'Dim VariableX as String
'
'VariableX = BinaryToText(GetSetting(App.Title, "Settings", "prefs"))


Public Function ChrAscii(Char As String) As Long
    Dim GetAscii&


    For GetAscii& = 0 To 255


        If Mid(Char$, 1, 1) = Chr(GetAscii) Then
            ChrAscii = GetAscii
            Exit Function
        End If
    Next GetAscii&
End Function

Public Function TextToBinary(StringT As String) As String
    Dim Ascii, FinalBinary$, GetNum&
    FinalBinary$ = ""


    For GetNum& = 1 To Len(StringT$)
        Ascii = ChrAscii(Mid(StringT$, GetNum, 1))
        ' 128


        If Ascii >= 128 Then
            FinalBinary$ = FinalBinary$ & "1"
            Ascii = Ascii - 128
        Else
            FinalBinary$ = FinalBinary$ & "0"
        End If
       
        ' 64


        If Ascii >= 64 Then
            FinalBinary$ = FinalBinary$ & "1"
            Ascii = Ascii - 64
        Else
            FinalBinary$ = FinalBinary$ & "0"
        End If
       
        ' 32


        If Ascii >= 32 Then
            FinalBinary$ = FinalBinary$ & "1"
            Ascii = Ascii - 32
        Else
            FinalBinary$ = FinalBinary$ & "0"
        End If
       
        ' 16


        If Ascii >= 16 Then
            FinalBinary$ = FinalBinary$ & "1"
            Ascii = Ascii - 16
        Else
            FinalBinary$ = FinalBinary$ & "0"
        End If
       
        ' 8


        If Ascii >= 8 Then
            FinalBinary$ = FinalBinary$ & "1"
            Ascii = Ascii - 8
        Else
            FinalBinary$ = FinalBinary$ & "0"
        End If
       
        ' 4


        If Ascii >= 4 Then
            FinalBinary$ = FinalBinary$ & "1"
            Ascii = Ascii - 4
        Else
            FinalBinary$ = FinalBinary$ & "0"
        End If
       
        ' 2


        If Ascii >= 2 Then
            FinalBinary$ = FinalBinary$ & "1"
            Ascii = Ascii - 2
        Else
            FinalBinary$ = FinalBinary$ & "0"
        End If
       
        ' 1


        If Ascii >= 1 Then
            FinalBinary$ = FinalBinary$ & "1"
            Ascii = Ascii - 1
        Else
            FinalBinary$ = FinalBinary$ & "0"
        End If


        If Mid(StringT$, GetNum + 1, 1) = Chr(32) Then
            FinalBinary$ = FinalBinary$ '& " "
        Else
            FinalBinary$ = FinalBinary$ '& Chr(32)
        End If
    Next GetNum&
    TextToBinary$ = FinalBinary$
End Function


Public Function BinaryToText(BinaryString As String) As String
    Dim GetBinary&, Num$, Binary&, FinalString$, NewString$
NextChr:


For GetBinary& = 1 To 8
    Num$ = Mid(BinaryString$, GetBinary&, 1)


    Select Case Num$
       
        Case "1"


        If GetBinary = 1 Then
            Binary = Binary + 128
        ElseIf GetBinary = 2 Then
            Binary = Binary + 64
        ElseIf GetBinary = 3 Then
            Binary = Binary + 32
        ElseIf GetBinary = 4 Then
            Binary = Binary + 16
        ElseIf GetBinary = 5 Then
            Binary = Binary + 8
        ElseIf GetBinary = 6 Then
            Binary = Binary + 4
        ElseIf GetBinary = 7 Then
            Binary = Binary + 2
        ElseIf GetBinary = 8 Then
            Binary = Binary + 1
        End If
    End Select
Next GetBinary&
FinalString$ = FinalString$ & Chr(Binary)
NewString$ = Mid(BinaryString$, 9)



If NewString$ = "" Then
BinaryToText$ = FinalString$
Else
BinaryString$ = NewString$
Binary = 0
GoTo NextChr
End If
End Function


Public Function IsBinary(StringB As String) As Boolean
    Dim XX$, GetLet&


    For GetLet& = 1 To Len(StringB$)
        XX$ = Mid(StringB$, GetLet&, 1)


        If XX$ <> "0" Or XX$ <> "1" Then
            If XX$ = "0" Or XX$ = "1" Then GoTo GetNext
            IsBinary = False
            Exit Function
        Else
            '''
        End If
GetNext:
    Next GetLet&
    IsBinary = True
End Function


0
 

Author Comment

by:Daron1
ID: 2697145
Adjusted points from 200 to 300
0
 

Author Comment

by:Daron1
ID: 2697146
This works perfect.  I have hit a small problem though.  The binary is quite a bit longer than I expected.  I copied the binary in the registry to be the default value at the end of the getsetting call. It is so big it takes VB6 4 forced line breaks to display it(this particular variable is a long sentence string).  Are you aware of something that operates exactly the same but requires fewer characters than binary?  I don't mind modifying this code you've supplied if I know I'm working in the right direction.
0
 
LVL 14

Expert Comment

by:wsh2
ID: 2697180
Rather than play with REG_DWORD and REG_BINARY functions what you really need is an data Encryption/Decryption routine. Fortunately, to make one is not a hard thing to do.. <smile>.

Try This..

1. Create a New Standard.Exe Project and Copy/Paste the following into the code window.
2. Press F5 to run.

<----- Code Begin ----->

Option Explicit

Private Sub Form_Load()
   ' Routines that will encrypt/decrypt up to 94 characters
   Dim strWork1 As String
   Dim strWork2 As String
   strWork1 = xEncrypt("Your Password Here")
   strWork2 = xDecrypt(strWork1)
   MsgBox strWork1 & vbCrLf & strWork2
End Sub

Private Function xEncrypt _
(ByVal strInput As String) _
As String

   If Len(strInput) <= 0 _
   Or Len(strInput) >= 94 _
   Then
      Exit Sub
   End If
   
   Dim lngEncrypt As Long
   Dim lngIndex As Long
   Dim strOutput As String
   
   strOutput = Space(Len(strInput))
   For lngIndex = 1 To Len(strInput)
      lngEncrypt = Asc(Mid(strInput, lngIndex, 1))
      If lngEncrypt >= 32 _
      And lngEncrypt <= 126 _
      Then
         lngEncrypt = lngEncrypt + lngIndex
         If lngEncrypt > 126 _
         Then
            lngEncrypt = lngEncrypt - 126 + 32
         End If
      End If
      Mid(strOutput, Len(strInput) - lngIndex + 1, 1) = Chr(lngEncrypt)
   Next lngIndex
   xEncrypt = strOutput

End Function

Private Function xDecrypt _
(ByVal strInput As String) _
As String

   If Len(strInput) <= 0 _
   Then
      Exit Sub
   End If
   
   Dim lngEncrypt As Long
   Dim lngIndex As Long
   Dim strOutput As String
   strOutput = Space(Len(strInput))
   For lngIndex = 1 To Len(strInput)
      lngEncrypt = Asc(Mid(strInput, lngIndex, 1))
      If lngEncrypt >= 32 _
      And lngEncrypt <= 126 _
      Then
         lngEncrypt = lngEncrypt - (Len(strInput) - lngIndex + 1)
         If lngEncrypt < 32 _
         Then
            lngEncrypt = lngEncrypt + 126 - 32
         End If
      End If
      Mid(strOutput, Len(strInput) - lngIndex + 1, 1) = Chr(lngEncrypt)
   Next lngIndex
   xDecrypt = strOutput

End Function

<----- Code End ----->

Naturally you can embellish it if you like.. <smile>.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

706 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now