Solved

registry

Posted on 2000-04-08
4
294 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
[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
 
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

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

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…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
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…
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…

751 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