Solved

Reading and Writing binary File

Posted on 2013-05-20
4
488 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

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

758 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

18 Experts available now in Live!

Get 1:1 Help Now