Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 538
  • Last Modified:

Reading and Writing binary File

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
montrof
Asked:
montrof
  • 3
1 Solution
 
[ fanpages ]IT Services ConsultantCommented:
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
 
montrofAuthor Commented:
Thanks
0
 
montrofAuthor Commented:
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
 
montrofAuthor Commented:
This is the solution I came up with.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now