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

**ThEiMp** · Jun 13th, 2010, 12:58 AM

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...

**Spoo** · Jun 13th, 2010, 01:23 AM

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

**ThEiMp** · Jun 13th, 2010, 02:13 AM

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

**Spoo** · Jun 13th, 2010, 02:24 AM

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

**whatsup** · Jun 13th, 2010, 06:32 AM

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

**Spoo** · Jun 13th, 2010, 09:23 AM

ThE

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

Features:

You can encrypt each line with a different key
Most of code is spent on dim's and encryption !!
Uses Binary file (and possibly "solves" the "nothing happens" issue in your post #1)
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

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

Spoo

.

**whatsup** · Jun 13th, 2010, 11:07 AM

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

**FireXtol** · Jun 13th, 2010, 01:58 PM

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

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)

**ThEiMp** · Jun 13th, 2010, 07:45 PM

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

**Spoo** · Jun 14th, 2010, 03:09 AM

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

.

**Siddharth Rout** · Jun 14th, 2010, 03:23 AM

I use vb6 inbuilt Capicom.dll

Here is an example

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

**ThEiMp** · Jun 14th, 2010, 07:59 PM

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...

**Code Doc** · Jun 14th, 2010, 08:35 PM

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.

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

**FireXtol** · Jun 14th, 2010, 08:56 PM

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.

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?

**whatsup** · Jun 14th, 2010, 09:12 PM

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.

**ThEiMp** · Jun 15th, 2010, 01:37 AM

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.

**Siddharth Rout** · Jun 15th, 2010, 02:12 AM

@ThEiMp: Did you see post 11?

**ThEiMp** · Jun 15th, 2010, 07:28 PM

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???

**Code Doc** · Jun 16th, 2010, 10:50 AM

Originally Posted by FireXtol

What about palindromes?

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

**Siddharth Rout** · Jun 16th, 2010, 10:54 AM

[OFFTOPIC]

Originally Posted by Code Doc

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

From Wiki

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]

**Spoo** · Jun 16th, 2010, 11:21 AM

[WAYOFFTOPIC]

Kool

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

Spoo

[/WAYOFFTOPIC]

**FireXtol** · Jun 16th, 2010, 03:39 PM

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)

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

**ThEiMp** · Jun 16th, 2010, 07:08 PM

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

**dilettante** · Jun 16th, 2010, 07:10 PM

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?

**ThEiMp** · Jun 16th, 2010, 07:16 PM

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???

**dilettante** · Jun 16th, 2010, 09:22 PM

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

**dilettante** · Jun 16th, 2010, 09:25 PM

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.

**ThEiMp** · Jun 17th, 2010, 01:08 AM

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...

**Siddharth Rout** · Jun 17th, 2010, 01:55 AM

Originally Posted by dilettante

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

Beats me

**dilettante** · Jun 17th, 2010, 06:06 PM

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:

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?"

**ThEiMp** · Jun 17th, 2010, 06:25 PM

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

**dilettante** · Jun 17th, 2010, 08:19 PM

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

**ThEiMp** · Jun 17th, 2010, 08:21 PM

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...

**FireXtol** · Jun 17th, 2010, 08:30 PM

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

Could also easily be used for binary.

**ThEiMp** · Jun 17th, 2010, 08:45 PM

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???

**FireXtol** · Jun 17th, 2010, 09:00 PM

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)

**dilettante** · Jun 17th, 2010, 09:11 PM

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?

**FireXtol** · Jun 17th, 2010, 09:22 PM

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.

**ThEiMp** · Jun 18th, 2010, 12:08 AM

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

**ThEiMp** · Jun 18th, 2010, 12:33 AM

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???

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

Thread Tools

Display

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

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Re: How to Write an encripted Text File???

Posting Permissions