[RESOLVED] How to Write an encripted Text File???

I am writing a text file, that stores the username and password, along with other items like position of work, etc. Into a text file. But I find that the statement Output, is something like a downer, because anyone can read the contents of the file, and then login into it. How am I able to write a text file, that is only Binary and nothing else.

And yes: I have tried Binary Access Write, and Random to work with it. And nothing happens. But I have contructed a simple text file, without encription and that works in my program. So its not the way that the program, handles the access of the file. But rather than, how the file is saved using the program.

How can I write the file, using Open, Print and then Close statments. But also I don't wish to even use, nor see CommonDialog control being used in this matter at hand. Becuase I don't like using it. Trying to write my own, CommonDialog, one that is able to work better using less code, etc!!

But that is for later on, when I have better resources at hand...

ThE

How about if you use Asc function? Loop through each
character in username and password, and just do a
"normal" Write using the returned integers (0 - 255).

Your app would then use the Chr function to decrypt.

You could also introduce a key -- say, offset everything
by 10, 15, or whatever, so someone using the Chr function
themselves would not immediately see the "real" stuff.

Spoo

But right now, I am using only the Output statement to write and the Input statement to read the files. I am trying to use the Open, Print and Close statements more as possible. Becuase I can trust them to work, right.

Code:

---

Open "Test1.dat" For Binary As #1
    Print #1, Form4.Text2.Text
Close #1

---

ThE

Sorry, but I'm confused by your last post.
Could you explain how or if that has any bearing on using Asc and Chr functions.

Spoo

Quote:

---

Originally Posted by ThEiMp

But right now, I am using only the Output statement to write and the Input statement to read the files. I am trying to use the Open, Print and Close statements more as possible. Becuase I can trust them to work, right.

Code:

---


Open "Test1.dat" For Binary As #1
    Print #1, Form4.Text2.Text
Close #1

---

---

you can print the whole file in one command, not an issue.
but you need to encrypt it first, as Spoo suggested.

in your case it can be something like:

Code:

---


  Dim Str1 As String
  Dim i1 As Long, i2 As Long
  Dim c1 As Byte

  Str1$ = ""

  i2 = Len(Form4.Text2.Text)
  For i1 = 1 To i2
    c1 = Asc(Mid$(Form4.Text2.Text, i1, 1))
    ' here you can encrypt c1, by xor or other method
    Str1$ = Str1$ & CStr$(c1) & ","
  Next

  Open "Test1.dat" For OutPut As #1
    Print #1, Str1$
  Close #1

---

on my signature there is a source code of mail sender that stores encrypt passwords/usernames, in INI (text) file

ThE

As an alternative to the code that whatsup posted,
you could do something like this:

Features:

1. You can encrypt each line with a different key
2. Most of code is spent on dim's and encryption !!
3. Uses Binary file (and possibly "solves" the "nothing happens" issue in your post #1)
4. The output file will be placed in same subdirectory as your app (but you can change this)

Here is the code .. see also 3 images below.

Code:

---

        Dim txUN As String      ' raw username
        Dim txPW As String      ' raw password
        Dim txPOW As String    ' raw position of work
        Dim txSTR As String    '
        '
        Dim enKey As Integer    ' encryption key setting
        Dim enSTR As String    ' encrypted string
        '
        Dim lenSTR As Integer  ' length of string
        Dim nnASC As Integer
        '
        Dim aaBYT() As Byte
        ' 0. initialize
        enSTR = ""
        ' 0. hardwired initialize (as example)
        txUN = "Spoo"
        txPW = "password"
        txPOW = "Position of work: 12"
        ' 1. encrypt
        For ii = 1 To 3
            ' 1a. individualize the "key"
            Select Case ii
                Case 1
                    enKey = 100    ' setting for "username"
                    txSTR = txUN
                Case 2
                    enKey = 125    ' setting for "password"
                    txSTR = txPW
                Case 3
                    enKey = 0      ' setting for "position of work"
                    txSTR = txPOW
            End Select
            ' 1b. encrypt
            lenSTR = Len(txSTR)
            For jj = 0 To lenSTR - 1
                nnASC = Asc(Mid(txSTR, jj + 1, 1)) + enKey
                enSTR = enSTR + Chr(nnASC)
            Next jj
            ' 1c. add Cr+LF
            enSTR = enSTR + vbCrLf
        Next ii
        ' 2. create byte array
        lenSTR = Len(enSTR)
        ReDim aaBYT(lenSTR)
        For ii = 0 To lenSTR - 1
            aaBYT(ii) = Asc(Mid(enSTR, ii + 1, 1))
        Next ii
        ' 3. create file
        Open "Test2.txt" For Binary As #1
        Put #1, , aaBYT
        Close #1

---

Decryption would be very similar.
I take it you can handle it from here, but holler if you have questions.

Images: The 3 images below use these different combinations of enKey settings

1. enKey = 0 for all 3 lines of text ... ie, no encryption
2. enKey = 1 for username, 1 for password, 0 for line 3
3. enKey = 100 for username, 125 for password, 0 for line 3 ... these values appear in the above code frag

Spoo

.

my example above is good only for standard strings not for text files.

here is a short example for text file:

Code:

---


Option Explicit


Sub EncryptFile(ByVal sText As String, ByVal fName As String)
  Dim bBuf() As Byte
  Dim i1 As Long, i2 As Long
  Dim c1 As Integer

  On Error GoTo Error0000

  i2 = Len(sText$)
  If i2 = 0 Then Exit Sub

  i2 = i2 - 1
  ReDim bBuf(0 To i2)

  For i1 = 0 To i2
    c1 = Asc(Mid$(sText$, i1 + 1, 1))
    ' here you can encrypt c1, by xor or other method
    c1 = 0 - c1
    c1 = c1 + 10
    bBuf(i1) = c1 And &HFF
  Next

  Open fName$ For Binary Access Write As #1
  Put #1, 1, bBuf

Error0000:

  On Error Resume Next

  Close #1
End Sub


Function DecryptFile(ByVal fName As String) As String
  Dim bBuf() As Byte
  Dim Str1 As String
  Dim i1 As Long, i2 As Long
  Dim c1 As Integer

  Str1$ = ""

  On Error GoTo Error0000

  i2 = FileLen(fName$)
  If i2 = 0 Then GoTo Exit0000

  i2 = i2 - 1
  ReDim bBuf(0 To i2)

  Open fName$ For Binary Access Read As #1
  Get #1, 1, bBuf

  For i1 = 0 To i2
    c1 = bBuf(i1)
    ' here you can encrypt c1, by xor or other method
    c1 = c1 - 10
    c1 = 0 - c1
    Str1$ = Str1$ & Chr$(c1 And &HFF)
  Next

Error0000:
  On Error Resume Next

  Close #1

Exit0000:
  DecryptFile$ = Str1$
End Function

Private Sub Command1_Click()
  Call EncryptFile(Form1.Text1.Text, "c:\test1.dat")
End Sub

Private Sub Command2_Click()
  Form1.Text1.Text$ = DecryptFile$("c:\test1.dat")
End Sub

---

This function both encrypts and decrypts. Meaning es(es(string)) = string.

vb Code:

Public Function es(sv As String) As String
Dim ih As Long, nt As String
Rnd -1
Randomize 251 'you can change this number, it's the random seed
For ih = 1 To Len(sv)
  nt = nt & Chr$(Asc(MID$(sv, ih, 1)) Xor Int(Rnd * 255))
Next
es = nt
End Function

Quote:

---

How can I write the file, using Open, Print and then Close statments.

---

In Binary mode you ought use Get and Put.

To use Get you must allocate a buffer, and read data into it from the desired byte location.

Example:

vb Code:

dim strData as String
Open "file" for Binary as #1
strData = Space(LOF(#1)) 'allocate buffer
'Get filenumber, byte_location, buffer
Get #1, 1, strData 'pass a buffer of length=LOF(1), read entire file
'strData is now storing a identical copy of the file
Close #1
'or with a byte array
dim bData() as Byte
Open "file" for Binary as #1
redim bData(LOF(#1)-1) 'dimension byte array
'Get filenumber, byte_location, buffer
Get #1, 1, bData 'pass byte array as buffer
'bData is now storing a identical copy of the file
Close #1
'this byte array can be converted into a string thusly: strData = StrConv(bData,vbUnicode)

My source code now looks like this:

Code:

---

Public Sub cmd_Ok1_Click()
On Error Resume Next

Dim ii As Integer
Dim jj As Integer
Dim txUN As String
Dim txPW As String
Dim txPOW As String
Dim txSTR As String
Dim enKey As Integer
Dim enSTR As String
Dim lenSTR As Integer
Dim nnASC As Integer
Dim aaBYT() As Byte

Item1 = Form4.Text2.Text

If Form4.Text1.Text = "" Or Form4.Text2.Text = "" Then
    MsgBox "Please fill out this Form in the correct manner!!", , "Message"
    Form4.cmd_OK1.Enabled = False
    Exit Sub
Else
  Form4.cmd_OK1.Enabled = True
End If

        enSTR = ""
        txUN = Form4.Text1.Text
        txPW = Form4.Text2.Text

        For ii = 1 To 2
            Select Case ii
                Case 1
                    enKey = 100
                    txSTR = txUN
                Case 2
                    enKey = 125
                    txSTR = txPW
            End Select
       
            lenSTR = Len(txSTR)
           
            For jj = 0 To lenSTR - 1
                nnASC = Asc(Mid(txSTR, jj + 1, 1)) + enKey
                enSTR = enSTR + Chr(nnASC)
            Next jj
            enSTR = enSTR + vbCrLf
        Next ii
       
        lenSTR = Len(enSTR)
        ReDim aaBYT(lenSTR)
       
        For ii = 0 To lenSTR - 1
            aaBYT(ii) = Asc(Mid(enSTR, ii + 1, 1))
        Next ii
       
Open App.Path & "\program\usernames\" & Form4.Text1.Text & ".pas" For Binary As #1
    If Not Dir(App.Path & "program\usernames\" & Form4.Text1.Text & ".pas") = "" Then
        MsgBox "Username file already exists, on the Network System!!", , "Message"
        Exit Sub
    Else
        MsgBox "Username file, has been correctly saved!!", , "Message"
    End If
        Put #1, , aaBYT
Close #1

Form4.Hide
Form4.Text1.Text = ""
Form4.Text2.Text = ""
Form4.cmd_OK1.Enabled = False

End Sub

---

This is my loading the Text File into memory, source code. Which was rewritten using what code, that you have provided me with. Thanks again, it works in encription coding, but I cannot get my program (Login Console) to read it enough to Login into the program with.

Code:

---

Public Sub Text5_Click()
On Error Resume Next

Dim aaBYT() As Byte

If Form3.Text6.Text = "" Then
    Form3.Text7.Text = ""
    Exit Sub
Else
Open App.Path & "\program\usernames\" & Form3.Text6.Text & ".pas" For Input As #1
    Do Until EOF(1)
        Put #1, , aaBYT
        Form3.Text7.Text = aaBYT
    EOF (1)
    Loop
Close #1
End If

End Sub

---

ThE

OK, you were close !!

See if this works for you .. see image below for
contents of aaBYT and how we use the vbCrLF
(the 13 and 10, respectively)

Code:

---

        Dim aaBYT() As Byte
        Dim nnASC As Integer
        '
        Dim enSTR As String    '
        Dim enKey As Integer    ' key
        Dim enUN As String      ' encrypted username
        Dim enPW As String      ' encrypted password
        '
        Dim dcUN As String      ' decrypted username
        Dim dcPW As String      ' decrypted password
        '
        Dim fName As String
        Dim nnCrLf As Integer
        ' 1. get encrypted data into array
        fName = "Test2.txt"    ' << alter as required
        Open fName For Binary As #1
        ReDim aaBMP(FileLen(fName))
        Get #1, , aaBYT
        Close #1
        ' 2. extract enUN and enPW from array
        nnCrLf = 0
        enUN = ""
        enPW = ""
        For ii = 0 To UBound(aaBYT)
            ' 2a. get an element from the array
            nnASC = aaBYT(ii)
            ' 2b. put into proper variable
            Select Case nnCrLf
                Case 0                    ' 0. username
                    If nnASC = 10 Then
                        nnCrLf = nnCrLf + 1        ' incr for next case
                    ElseIf Not nnASC = 13 Then
                        enUN = enUN + Chr(nnASC)    ' add to enUN
                    End If
                Case 1                      ' 1. password
                    If nnASC = 10 Then
                        nnCrLf = nnCrLf + 1        ' incr for next case
                    ElseIf Not nnASC = 13 Then
                        enPW = enPW + Chr(nnASC)    ' add to enPW
                    End If
                Case 2                      ' 2. finished
                    Exit For
            End Select
        Next ii
        ' 3. decrypt
        For ii = 1 To 2
            ' 3a. use the individualized "key"
            Select Case ii
                Case 1
                    enKey = 100    ' setting for "username"
                    txSTR = enUN
                Case 2
                    enKey = 125    ' setting for "password"
                    txSTR = enPW
            End Select
            ' 3b. decrypt
            lenSTR = Len(txSTR)
            For jj = 1 To lenSTR
                nnASC = Asc(Mid(txSTR, jj , 1)) - enKey
                If ii = 1 Then
                    dcUN = dcUN + Chr(nnASC)    ' decrypted username
                ElseIf ii = 2 Then
                    dcPW = dcPW + Chr(nnASC)    ' decrypted password
                End If
            Next jj
        Next ii

---

I've gone a little overboard in coding, but that
is intentional .. for illustrative purposes. Feel
free to combine steps and tighten up the code
as you see fit.

Notice that this time, we subtract enKey

Holler if you have any questions.

Spoo

.

I use vb6 inbuilt Capicom.dll

Here is an example

http://www.vbforums.com/showpost.php...23&postcount=6

Here is my coding files, can you please help me. My program becomes non responsive, and then crashes when trying to access the code: From "Form3.Text5.Text". That is where all the problems arise from...

One of the easiest and fastest ways to encrypt a file is the reverse the order of all the characters in the file. Then when you decrypt, reverse the order back to the original sequence. Usually that's sufficient to protect the contents without getting really fancy. :ehh:

If you want to go further, start swapping ASCII values on top of that. The more that you do, the slower the read.

Quote:

---

Originally Posted by Code Doc

One of the easiest and fastest ways to encrypt a file is the reverse the order of all the characters in the file. Then when you decrypt, reverse the order back to the original sequence. Usually that's sufficient to protect the contents without getting really fancy. :ehh:

If you want to go further, start swapping ASCII values on top of that. The more that you do, the slower the read.

---

What about palindromes? :lol:

i think the best way to encrypt files is compress + a short password string to xor on the file header
the compress is done directly from vbasic using zlib.dll or some other open source.
if anyone think there is something not good with this, i'll be glad to hear.

Well then I am going to code the text file, using Windings that just are given the a number reference, and then work from there. This means that I am going to give it a limit of ten characters, of either 1-0 to a-z and A-Z. So then I don't run into anything like a major problem as such.

@ThEiMp: Did you see post 11?

Well just looked over it right now, even!!
But there is one more thing, I must ask...

With trying to read a certain Byte from a String, how do you go and do that???

Code:

---

Public Sub Text1_Change()
On Error Resume Next

If Form3.Text1.Text = Dir(App.Path & "\program\usernames\" & Form3.Text1.Text & ".pas") <> "" Then
    Call OpenFile1
Else
    Exit Sub
End If

End Sub

Public Sub OpenFile1()
On Error Resume Next

Dim Item1 As String

Form3.Label1.Caption = "This Server Console is now accessing your Login Details!!"

Form3.Text1.Enabled = False
Form3.Text2.Enabled = True

Open App.Path & "\program\usernames\" & Form3.Text1.Text & ".pas" For Input As #1
    Input #1, Item1
    Item1 = Form3.Text3.Text
Close #1

Form3.Label1.Caption = "This Server Console has now found your Login Details!!"

End Sub

Public Sub Text2_Click()
On Error Resume Next

If Form3.Text2.Text = "" Then
    Form3.Text3.Text = ""
   
    Form3.Command1.Enabled = True
    Form3.Command3.Enabled = True
   
    Form3.Text1.Enabled = False
    Form3.Text2.Enabled = False
End If

End Sub

Public Sub FixUpEncription1()
Form3.Label1.Caption = "Please wait until this process has been completed!!"

If Form3.Text3.Text = "1" Then Form3.Text4.Text = "!"
If Form3.Text3.Text = "2" Then Form3.Text4.Text = "@"
If Form3.Text3.Text = "3" Then Form3.Text4.Text = "#"
If Form3.Text3.Text = "4" Then Form3.Text4.Text = "$"
If Form3.Text3.Text = "5" Then Form3.Text4.Text = "&#37;"
If Form3.Text3.Text = "6" Then Form3.Text4.Text = "^"
If Form3.Text3.Text = "7" Then Form3.Text4.Text = "&"
If Form3.Text3.Text = "8" Then Form3.Text4.Text = "*"
If Form3.Text3.Text = "9" Then Form3.Text4.Text = "("
If Form3.Text3.Text = "0" Then Form3.Text4.Text = ")"

If Form3.Text3.Text = "a" Then Form3.Text4.Text = "1"
If Form3.Text3.Text = "b" Then Form3.Text4.Text = "2"
If Form3.Text3.Text = "c" Then Form3.Text4.Text = "3"
If Form3.Text3.Text = "d" Then Form3.Text4.Text = "4"
If Form3.Text3.Text = "e" Then Form3.Text4.Text = "5"
If Form3.Text3.Text = "f" Then Form3.Text4.Text = "6"
If Form3.Text3.Text = "g" Then Form3.Text4.Text = "7"
If Form3.Text3.Text = "h" Then Form3.Text4.Text = "8"





If Form3.Text3.Text = "A" Then Form3.Text4.Text = "Z"
If Form3.Text3.Text = "B" Then Form3.Text4.Text = "X"





If Form3.Text3.Text = Form3.Text4.Text Then
    Form3.Label1.Caption = "Process is complete!!"
End If

End Sub

---

This is what process, I am going to add in the code. But don't have any Byte selecting inside an Array, as yet. Just getting the core stuff down, into it as of now...
Then after this, I guess that I am required to add in Array sorting code, that will be able to select the differnet elements that I have defined in the above code???

Quote:

---

Originally Posted by FireXtol

What about palindromes? :lol:

---

There aren't very many. I think the longest one in the English language is "reviver". :ehh:

[OFFTOPIC]

Quote:

---

Originally Posted by Code Doc

There aren't very many. I think the longest one in the English language is "reviver". :ehh:

---

From Wiki :wave:

Quote:

---

Long palindromes
The longest palindromic word in the Oxford English Dictionary is the onomatopoeic tattarrattat, coined by James Joyce in Ulysses (1922) for a knock on the door. The Guinness Book of Records gives the title to detartrated, the past tense of detartrate, a somewhat contrived chemical term meaning to remove tartrates. Rotavator, a trademarked name for an agricultural machine, is often listed in dictionaries. The term redivider is used by some writers but appears to be an invented term—only redivide and redivision appear in the Shorter Oxford Dictionary. Malayalam, an Indian language, is of equal length.

---

[/OFFTOPIC]

[WAYOFFTOPIC]

Kool

Detartrated is kinda catchy .. something Paris Hilton
could benefit from being

Spoo

[/WAYOFFTOPIC]

Back to the topic....

You can convert a string to a byte array thusly:

vb Code:

Dim bString() as Byte
Dim sInput as String
bString = StrConv(sInput, vbFromUnicode)
For x = 0 to UBound(bString)
  'do something with bString(x)
Next X

Instead of your 'unrolled' code for replacements, you can use what is termed a Look Up Table(LUT). This is simply an array which stores replacements for the index, and can be used for bi-directional look ups.

vb Code:

Dim X as long, Y as long, bChr as Byte
Dim baLUT(255) as Byte '0 to 255, aka ANSI/ASCII
 
'initialize LUT array with unique values
For x = 0 to 255
  baLUT(x) = x
Next x
 
'randomly shuffle array
Rnd -1 'reset the rnd generator
Randomize SEED 'use a number here for the random seed, ensuring repeatable output
'these two random calls ensure that the follow sequence of RNDs will be the same
For x = 1 to 255
  y = Int(x*Rnd)
  If x <> y Then
    bChr = baLUT(x)
    baLUT(x) = baLUT(y)
    baLUT(y) = bChr
  End If
Next X

Now we can put these two pieces of code together:

vb Code:

Dim bString() as Byte
dim bOutString() as Byte
Dim sInput as String
bString = StrConv(sInput, vbFromUnicode)
ReDim bOutString(UBound(bString))
For x = 0 to UBound(bString)
  bOutString(x) = baLUT(bString(x))
Next X
strFinal = StrConv(bOutString, vbUnicode)

Now we need to create a LUT that'll turn this back into the original:

vb Code:

Dim backLUT(255) as Byte
For x = 0 to 255
  backLUT(baLUT(x)) = x
Next X

Which now we can write a decryption for it:

vb Code:

Dim bString() as Byte
dim bOutString() as Byte
Dim sInput as String
bString = StrConv(sInput, vbFromUnicode)
ReDim bOutString(UBound(bString))
For x = 0 to UBound(bString)
  bOutString(x) = backLUT(bString(x))
Next X
strFinal = StrConv(bOutString, vbUnicode)

:wave:
P.S. I did not test any of this, but it looks good.

Can you please send a working demo, of your work. I am not sure where to start!!

A lot of these suggestions fall apart if your software crosses locales though. Those ANSI conversions are a killer.

What was the problem with the CAPICOM suggestion way back there anyway?

Lol, me about it!!
When I was working as a programmer, I never did encription. Cause never needed it.
Like anyone was going to rip open a print driver like that!!

With trying to read each Byte in an Array, how do I do that???

Code:

---

Dim Chr As Byte

Rem Then something goes in here?
Dir(Chr$.................)

---

Right, or is there something that I am missing???

Maybe:

Code:

---

Dim Ary() As Byte
Dim I As Integer
Dim B as Byte

Ary = "Hello"
For I = 0 To UBound(Ary)
    B = Ary(I)
    'Use B?
Next

Ary = StrConv("Hello", vbFromUnicode)
For I = 0 To UBound(Ary)
    B = Ary(I)
    'Use B?
Next

---

BTW:

Here's a small demo preserving Unicode characters and using CAPICOM for encrypting. You need to have CAPICOM 2.x installed for this to work though.

Quote:

---

Originally Posted by dilettante

Maybe:

Code:

---

Dim Ary() As Byte
Dim I As Integer
Dim B as Byte

Ary = "Hello"
For I = 0 To UBound(Ary)
    B = Ary(I)
    'Use B?
Next

Ary = StrConv("Hello", vbFromUnicode)
For I = 0 To UBound(Ary)
    B = Ary(I)
    'Use B?
Next

---

---

Can you please be more specific, in terms of handlers, sub routines and so on. I cannot tell where the open and save code begins and ends...

Quote:

---

Originally Posted by dilettante

What was the problem with the CAPICOM suggestion way back there anyway?

---

Beats me :confused:

Quote:

---

Originally Posted by ThEiMp

Can you please be more specific, in terms of handlers, sub routines and so on. I cannot tell where the open and save code begins and ends...

---

There was no open or save code there, you asked:

Quote:

---

With trying to read each Byte in an Array, how do I do that???

---

Sorry, I must have misinterpreted the question, so I would ask you to clarify your question. Are you trying to ask something like "How do I read a whole file into a Byte array?" Or maybe "How do I write a Byte array to a file?"

Can you please add some more code. Eg: The name of the Handlers, and/or the sub routines names???

The attached demo project saves and loads the encrypted text. I'm not sure this is what you were asking for though.

I just tried that example code that you had sent to me on this thread. And I need to do encription without any OCXs, or even DLLs in the source code. Is there a way to do so, without using these types of files. What about using the ASCII character codes, and then turing them into binary. That way they will always be one special type of code, and then be encripted twice over...

http://www.vbforums.com/showpost.php...9&postcount=22

Could also easily be used for binary.

Quote:

---

Remove the StrConvs and that code should handle BSTRs/UTF-16.

---

Can you please post some source code. I am not quite sue what a: LUT or something is, also not quite sure about the handlers, and the name of items. As you can tell, I have never done file data encription, you might have been able to tell???

Ok... sure.

Add this for a new project, inside a form:

vb Code:

Option Explicit
 
Private baLUT(255) As Byte, backLUT(255) As Byte '0 to 255, aka ANSI/ASCII
 
 
Private Sub InitLUT()
Dim X As Long, Y As Long, bChr As Byte
 
'initialize LUT array with unique values
For X = 0 To 255
  baLUT(X) = X
Next X
 
'randomly shuffle array
Rnd -1 'reset the rnd generator
Randomize 1234 'use a number here for the random seed, ensuring repeatable output
'these two random calls ensure that the follow sequence of RNDs will be the same
For X = 1 To 255
  Y = Int(X * Rnd)
  If X <> Y Then
    bChr = baLUT(X)
    baLUT(X) = baLUT(Y)
    baLUT(Y) = bChr
  End If
Next X
 
For X = 0 To 255
  backLUT(baLUT(X)) = X
Next X
End Sub
 
Private Sub FXInCipher(strIn As String, bOutString() As Byte)
Dim X As Long
Dim bString() As Byte
bString = strIn
ReDim bOutString(UBound(bString))
For X = 0 To UBound(bString)
  bOutString(X) = baLUT(bString(X))
  Debug.Print bString(X) & ">" & bOutString(X) & ",";
Next X
End Sub
 
Private Function FXDeCipher(strIn() As Byte) As String
Dim X As Long
Dim bString() As Byte
Dim bOutString() As Byte
bString = strIn
 
ReDim bOutString(UBound(bString))
For X = 0 To UBound(bString)
  bOutString(X) = backLUT(bString(X))
  Debug.Print bString(X) & "<" & bOutString(X) & ",";
Next X
FXDeCipher = bOutString
End Function

Finally, add a command button and try this:

vb Code:

Dim bAry() As Byte
FXInCipher "text to encrypt", bAry
'read/write bAry here
'such as
Open filename for Binary as #1
If Operation = Read then 'psuedocode
  ReDim bAry(LOF(1)-1) 'allocate read buffer
  Get 1,1, bAry
ElseIf Operation = Write then 'more psuedocode
  Put 1,1, bAry
End if 'final line of pseudocode
MsgBox FXDeCipher(bAry)

You can't write much of a program in VB6 without using a few OCXs. And for that matter you'll generally need a DLL or two but maybe you meant ActiveX DLLs.

About the only time anyone insists on this they really mean they're unwilling to create an installer. This is really hard to understand. Are you trying to create some sort of malware? Why else would you want to bypass the step of running an installer? I'm curious.


If you really need to run such a program without registering components you could create an "XCopy deployment" package by use of an isolation manifest and registration-free COM. Then the user could just unzip the files and go, or even run it via a a self-extracting EXE wrapper.

If you insist on just a VB6 EXE you'll find you can't use a lot of useful controls. You'd also have to fall back on directly calling the Crypto API instead of using it via CAPICOM.


I really don't see why you're thinking that saving a String as "binary" is going to obfuscate anything. Saving a VB6 String value into a binary file merely writes it as it is in the String, i.e. as a UTF-16LE text file anyone can open in Notepad. Writing it "as text" from VB6 only does a Unicode to ANSI translation first.

VB6 does not work in "ASCII" anyway. Strings contain UTF-16LE. The Asc() and Chr$() functions perform translation to/from ANSI (not ASCII) using the current locale's codepage. "ANSI" as it applies to Windows is just a term used to mean a localized 8-bit character set. It is more than an accident that the first 128 character codes normally map to the 7-bit ASCII character set, but it is not ASCII. The second 128 character codes vary based on the current locale (and codepage). We have AscW() and ChrW$() for working directly with String character values without translation.


My CAPICOM example can save the encrypted text as binary instead of as Base64 encoded binary with some small changes. Is this closer to what you are looking for?

Standard ASCII is only the first 128 characters. ANSI Extended ASCII is the technical term for Window's default '8-bit glyphs'.

Hope that helps confuse everybody. :wave:

Thanks Post: #36. That was what I was looking for!!

Well when opening the binary text file, that I had created. It looks the same as a normal Text File. Eg: It is readable, quite easily and contains no such thing as Binary level code inside it. It is ASCII Text and in normal English as well. That I cannot do, it is just like the Output File mode, found in the Open statement.

I will post the source code that I am using, and here it is:

Code:

---

Option Explicit
'
Private baLUT(255) As Byte, backLUT(255) As Byte
'

Public Function FXDeCipher(strIn() As Byte) As String
Dim X As Long
Dim bString() As Byte
Dim bOutString() As Byte

bString = strIn

ReDim bOutString(UBound(bString))

For X = 0 To UBound(bString)
    bOutString(X) = backLUT(bString(X))
    Debug.Print bString(X) & "<" & bOutString(X) & ",";
Next X

FXDeCipher = bOutString

End Function

Public Sub InitLUT()
Dim X As Long, Y As Long, bChr As Byte

For X = 0 To 255
    baLUT(X) = X
Next X

Rnd -1
Randomize 1234

For X = 1 To 255
    Y = Int(X * Rnd)
    If X <> Y Then
        bChr = baLUT(X)
        baLUT(X) = baLUT(Y)
        baLUT(Y) = bChr
    End If
Next X

For X = 0 To 255
    backLUT(baLUT(X)) = X
Next X

End Sub

Public Sub FXInCipher(strIn As String, bOutString() As Byte)
Dim X As Long
Dim bString() As Byte

bString = strIn

ReDim bOutString(UBound(bString))

For X = 0 To UBound(bString)
    bOutString(X) = baLUT(bString(X))
    Debug.Print bString(X) & ">" & bOutString(X) & ",";
Next X

End Sub

Public Sub Command1_Click()
Open "c:\program files\visual director 2010\program\usernames\" & Form1.Text1.Text & ".pas" For Binary As #1
    Put 1, 1, Form1.Text2.Text
Close #1

End Sub

---

What can we do to make it totally unlegiable in any way in the norm??? But I was thinking that there is something missing with this source code, that I must have taken out or something like that. Can you please look at it, someone???

vb Code:

Public Sub Command1_Click()
InitLUT 'this must be called before the cipher sub/function
 
Dim bAry() as Byte
Call FXInCipher(Form1.Text2.Text, bAry)
Open "c:\program files\visual director 2010\program\usernames\" & Form1.Text1.Text & ".pas" For Binary As #1
    Put 1, 1, bAry
Close #1
 
End Sub

Conversely:

vb Code:

Public Sub Command1_Click()
InitLUT 'this must be called before the cipher sub/function
 
Dim bAry() as Byte
Open "c:\program files\visual director 2010\program\usernames\" & Form1.Text1.Text & ".pas" For Binary As #1
    reDim bAry(lof(1)-1)
    Get 1, 1, bAry
Close #1
msgbox FXDeCipher(bAry)
End Sub

Thanks!!
I will try what you had posted!!

Right now: It saves the binary text file.

Problem: The file's contents can't be loaded in TextBox, named: Text3.Text. User inputs the samething in Text2, then it will Command1.Enabled = True. If not, then the Command Button is never .Enabled = True.

eg:

Code:

---

If Form1.Text3.Text = Form1.Text2.Text Then
      Form1.Command1.Enabled = True
Else
      Form1.Command1.Enabled = False
End If

---

You have to decrypt the content of the file before assigning the contents of a file to a textbox.

vb Code:

Public Sub Command1_Click()
InitLUT 'this must be called before the cipher sub/function
 
Dim bAry() as Byte
Open "c:\program files\visual director 2010\program\usernames\" & Form1.Text1.Text & ".pas" For Binary As #1
    reDim bAry(lof(1)-1)
    Get 1, 1, bAry
Close #1
Form1.Text3.Text = FXDeCipher(bAry) 'like this
End Sub

Thanks I will try that!!

This is how i solved it:

First I googled a hashing algorithm (I found one which is one way hashing algorithm)

Then I created a username and password, and stored the raw username and the hashed password and an access number (will tell you how i calculated this number)

When you login just hash the password and compare the username and hashed passwords combination. if they match resolve the access number.

The access number was calculated in the following way (this can be done in various ways but its the most foolproof idea i had)

I made a string with all alphabet both caps, lower case and numbers. Then I go through the username letter by letter and search for it in that alphanumeric string, adding the position in the string it is found to a variable. When all username is added up i add 4 for admin rights, 8 for level 1, 16 for level 2 and so on and so forth. to find access level when you login just perform the strign search of the username and subtract the number read from the file to the total added. if it's 4 give him admin rights, 8 levle 1 etc etc

this way even if they try to hash a password or leave it empty or something they still have to crack the "encryption" behind the access number...

Well it serves, my purpose for encription. I am quite sure that it is over 9-Bit of encription ciypher code strength.

Quote:

---

Originally Posted by ThEiMp

Well it serves, my purpose for encription. I am quite sure that it is over 9-Bit of encription ciypher code strength.

---

Don't take this the wrong way, I do it myself at times but...

... it is considerd the height of arrogance and foolishness to write your own encryption code. It is just too easy to make a mess of or produce something very weak or flawed.


And using Asc/Chr$ here you've deisgned in a "Unicode bug" that will bite you sooner or later.

What are you talking about. Where is the bug in the source code. That has been posted???

The "bug" is that if you encrypt this way on a UK English machine, send the encryted text to say a Saudi Arabic machine, and decrypt it with your code... it will get mangled.

Just how badly depends on how many characters in the plaintext were outside the range 0 to 127 and how many within that range are mapped differently using the two codepages.

Well this is meant for plain Western English typed machines. I am going to write an add on to work with changing text formats, also for .Text .Caption and so on. But I am trying to work with it for now. But will come up with a good multi-langague written file format. Even, for things like .Text and .Captions as well. Will me multi-langague. But that will have to be written into the program. As for now, that supports my rerquirements for the file formats.

Ok, just trying to save you some grief later. These might come in handy then:

Visual Basic Concepts: ANSI, DBCS, and Unicode: Definitions

The Absolute Minimum Every Software Developer Absolutely, Positively Must Know About Unicode and Character Sets (No Excuses!)

Here's a funny one too:

ASP and encryption

Quote:

---

What do I recommend? As both a security and VBScript expert, let me make this extremely clear:

UNDER NO CIRCUMSTANCES SHOULD YOU EVER IMPLEMENT YOUR OWN ENCRYPTION ALGORITHM. NEVER NEVER NEVER.

---

I assume you know who Eric Lippert is. You can blame him for little things like the FSO, major parts of the VBScript and JScript engines, VSTO, parts of C#, etc.

Quote:

---

Originally Posted by dilettante

The "bug" is that if you encrypt this way on a UK English machine, send the encryted text to say a Saudi Arabic machine, and decrypt it with your code... it will get mangled.

Just how badly depends on how many characters in the plaintext were outside the range 0 to 127 and how many within that range are mapped differently using the two codepages.

---

that's surprising, in other basic i work (bcx) the asc and chr are only type cast,
they don't use any table to make the replacement.
only type cast,
for example:
the asc input is a string, and the output is integer/byte
chr input is integer/byte and the output is string

are you saying, in vb these functions use a table to make the converting ?
do they use api for that ?

Not sure, I didn't write it???

i'm sorry, i referred to dilettante