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
Solved

Reading and Writing binary File

Posted on 2013-05-20
4
508 Views
Last Modified: 2013-05-25
I am trying to use a binary file to secure passing of a string.  This would be helpful because if the user emails the excel file they would not have the binary file to be able to connect to data.  Some experts helped me with the below code but the problem I am having is that I do not want to have both the create and read the binary file in the same excel file.  I need to be able to create the file and then read it later.  

Thanks for the help,
Montrof


 Here is the code




Sub ReadBinary(oMyInfo As String)
    Dim mFNo As Long
    Dim DataDir As String, mFleNm As String
    DataDir = "C:\SomeDirectory\"
    mFleNm = "MySuperSecetPassWordFile.Sec"
    mFNo = FreeFile
    On Error Resume Next
    Open DataDir & mFleNm For Binary Access Read Write As #mFNo
    Get #mFNo, 1, oMyInfo
    Close mFNo
    If Err.Number <> 0 Then Err.Clear
    On Error GoTo 0
End Sub

Sub WriteBinary(iMyInfo As String)
    Dim mFNo As Long
    Dim DataDir As String, mFleNm As String
    DataDir = "C:\SomeDirectory\"
    mFleNm = "MySuperSecetPassWordFile.Sec"
    mFNo = FreeFile
    On Error Resume Next
    Open DataDir & mFleNm For Binary Access Read Write As #mFNo
    Put #mFNo, 1, oMyInfo
    Close mFNo
    If Err.Number <> 0 Then Err.Clear
    On Error GoTo 0
End Sub





Sub Main()
    Dim UserName As String, Password As String
    Dim Newstring As String
    'set the login
    UserName = "FredDollarStore"
    Password = "FriedTaters"
    Newstring = Space(10) & ">" & UserName & "<" & String(50, 14) & ">" & Password & "<" & String(59, 12)
    'write the username and password to the file
    WriteBinary Newstring
    'read the user name and password from the file
    ReadBinary Newstring
    UserName = Mid(Newstring, 12, InStr(12, Newstring, "<") - 12)
    Password = Mid(Newstring, InStr(50, Newstring, ">") + 1, (InStr(50, Newstring, "<") - 1) - (InStr(50, Newstring, ">")))
End Sub

Open in new window

0
Comment
Question by:montrof
  • 3
4 Comments
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39181033
The previous Question thread, for reference:

"encypting sql connection string"
[ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28126785.html ]
0
 
LVL 1

Author Comment

by:montrof
ID: 39181038
Thanks
0
 
LVL 1

Accepted Solution

by:
montrof earned 0 total points
ID: 39182400
I was able to figure it out

Private Declare Function GetPrivateProfileStringA Lib _
    "kernel32" (ByVal strSection As String, _
    ByVal strKey As String, ByVal strDefault As String, _
    ByVal strReturnedString As String, _
    ByVal lngSize As Long, ByVal strFileNameName As String) As Long
Private Declare Function WritePrivateProfileStringA Lib _
    "kernel32" (ByVal strSection As String, _
    ByVal strKey As String, ByVal strString As String, _
    ByVal strFileNameName As String) As Long
Public Function Encrypt(ToEncrypt As Variant) As String
tmpEncrypt = ""
Encrypt = ""
For T = 1 To Len(ToEncrypt)
tmpEncrypt = tmpEncrypt & Chr(Asc(Mid(ToEncrypt, T, 1)) + 128)
If Len(tmpEncrypt) = 1000 Then
DoEvents
Encrypt = Encrypt & tmpEncrypt
tmpEncrypt = ""
End If
Next T
Encrypt = Encrypt & tmpEncrypt
End Function

Sub WriteUserInfo()
' saves information in the file IniFileName
    If Not WritePrivateProfileString32("t:\secure.ini","SECURE", _
        "X:", "125255758") Then
        MsgBox "Not able to save user info in " & IniFileName, _
            vbExclamation, "Folder does not exist!"
        Exit Sub
    End If
    WritePrivateProfileString32 "t:\secure.ini","SECURE", _
        "X:", Encrypt("12334")
    WritePrivateProfileString32 "t:\secure.ini", "SECURE", _
        "XX:", Encrypt("543456234")
    WritePrivateProfileString32 "t:\secure.ini","SECURE", _
        "XXX:", Encrypt("245247")
End Sub
Private Function WritePrivateProfileString32(ByVal strFileName As String, _
    ByVal strSection As String, ByVal strKey As String, _
    ByVal strValue As String) As Boolean
Dim lngValid As Long
    On Error Resume Next
    lngValid = WritePrivateProfileStringA(strSection, strKey, _
        strValue, strFileName)
    If lngValid > 0 Then WritePrivateProfileString32 = True
    On Error GoTo 0
End Function


Sub ReadUserInfo()
' reads information from the file IniFileName
    If Dir("C:\Test.ini") = "" Then Exit Sub
    Range("B3").Formula = Decrypt(GetPrivateProfileString32("t:\secure.ini", _
       "SECURE", "X:"))
    Range("B4").Formula = Decrypt(GetPrivateProfileString32("t:\secure.ini", _
       "SECURE", "XX:"))
    Range("B5").Formula = Decrypt(GetPrivateProfileString32("t:\secure.ini", _
       "SECURE", "XXX:"))
End Sub
Private Function GetPrivateProfileString32(ByVal strFileName As String, _
    ByVal strSection As String, ByVal strKey As String, _
    Optional strDefault) As String
Dim strReturnString As String, lngSize As Long, lngValid As Long
    On Error Resume Next
    If IsMissing(strDefault) Then strDefault = ""
    strReturnString = Space(1024)
    lngSize = Len(strReturnString)
    lngValid = GetPrivateProfileStringA(strSection, strKey, _
        strDefault, strReturnString, lngSize, strFileName)
    GetPrivateProfileString32 = Left(strReturnString, lngValid)
    On Error GoTo 0
End Function
Public Function Decrypt(ToDecrypt As Variant) As String
tmpDecrypt = ""
Decrypt = ""
For T = 1 To Len(ToDecrypt)
tmpDecrypt = tmpDecrypt & Chr(Asc(Mid(ToDecrypt, T, 1)) - 128)
If Len(tmpDecrypt) = 1000 Then
DoEvents
Decrypt = Decrypt & tmpDecrypt
tmpDecrypt = ""
End If
Next T
Decrypt = Decrypt & tmpDecrypt
End Function

Open in new window

0
 
LVL 1

Author Closing Comment

by:montrof
ID: 39196301
This is the solution I came up with.
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

809 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