Solved

Reading and Writing binary File

Posted on 2013-05-20
4
514 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
[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
  • 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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Suggested Solutions

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

749 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