Binaryworld - Taking advantage of EFS (Encrypted File System) APIs in Win2K/XP ... [ VB -> Cryptography ]

The Encrypted File System, or EFS, was introduced in version 5 of NTFS to provide an additional level of security for files and directories. It provides cryptographic protection of individual files on NTFS volumes using a public-key system. Typically, the access control to file and directory objects provided by the Windows security model is sufficient to protect unauthorized access to sensitive information. However, if a laptop containing sensitive data is lost or stolen, the security protection of that data may be compromised. Encrypting the files increases security in this scenario.

To determine whether a file system supports file encryption for files and directories, call the GetVolumeInformationAPI function and examine the FS_FILE_ENCRYPTION bit flag. Note that the following items cannot be encrypted:

Compressed files
System files
System directories
Root directories

Sparse files can be encrypted.

Step-By-Step Example

- Create a standard exe project
- Add four command button controls and one label control on the form1
- Add one drive control, one dir control and one file control on the form1
- Add the following code in form1

Note: If you dont have enough rights then EncryptFile call will fail

Click here to copy the following block

'Note: Encryptfile only works on NTFS 5

'//Sh-operations
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4

'//Sh-operations flag
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_CONFIRMMOUSE = &H2
Private Const FOF_FILESONLY = &H80
Private Const FOF_MULTIDESTFILES = &H1
Private Const FOF_NO_CONNECTED_ELEMENTS = &H2000
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_NOCONFIRMMKDIR = &H200
Private Const FOF_NOCOPYSECURITYATTRIBS = &H800
Private Const FOF_NOERRORUI = &H400
Private Const FOF_NORECURSION = &H1000
Private Const FOF_RENAMEONCOLLISION = &H8
Private Const FOF_SILENT = &H4
Private Const FOF_SIMPLEPROGRESS = &H100
Private Const FOF_WANTMAPPINGHANDLE = &H20
Private Const FOF_WANTNUKEWARNING = &H4000

'//File Encryption Status
Private Const FILE_ENCRYPTABLE = 0
Private Const FILE_IS_ENCRYPTED = 1
Private Const FILE_SYSTEM_ATTR = 2
Private Const FILE_ROOT_DIR = 3
Private Const FILE_SYSTEM_DIR = 4
Private Const FILE_UNKNOWN = 5
Private Const FILE_SYSTEM_NOT_SUPPORT = 6
Private Const FILE_READ_ONLY = 8
Private Const FILE_DIR_DISALLOWED = 9

Private Type SHFILEOPSTRUCT
  hWnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAborted As Long
  hNameMaps As Long
  sProgress As String
End Type

Private Declare Function EncryptFile Lib "advapi32.dll" Alias "EncryptFileA" ( _
    ByVal lpFileName As String) As Long

Private Declare Function DecryptFile Lib "advapi32.dll" Alias "DecryptFileA" ( _
    ByVal lpFileName As String, _
    ByVal dwReserved As Long) As Long

Private Declare Function FileEncryptionStatus Lib "advapi32.dll" Alias "FileEncryptionStatusA" ( _
    ByVal lpFileName As String, _
    lpStatus As Long) As Long

Private Declare Function EncryptionDisable Lib "advapi32.dll" ( _
    ByVal DirPath As String, _
    ByVal Disable As Long) As Long

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
    ByRef lpFileOp As SHFILEOPSTRUCT) As Long

Const mFolder = "C:\TestDir"
Const mFile = "APIDemo.txt"
Dim ret As Long, hFile As Long
Dim iFile As Long, FilePath As String

Private Sub DoDemo()
  Dim SHDirOp As SHFILEOPSTRUCT
  '//Disable Encryption for a specified path
  '//Note : EncryptionDisable takes Null terminated Unicode string
  ret = EncryptionDisable(StrConv(mFolder & Chr(0), vbUnicode), 1)
  Encrypt FilePath     '//This will throw an error coz encryption is disabled

  '//Enable Encryption for a specified path
  ret = EncryptionDisable(StrConv(mFolder & Chr(0), vbUnicode), 0)
  Encrypt FilePath

  'EncryptionStatus FilePath

  With SHDirOp
    .wFunc = FO_COPY
    .pFrom = FilePath
    .pTo = mFolder & "\" & "Encrypted_copy_" & mFile
    .fFlags = FOF_NOCONFIRMATION Or FOF_SILENT
  End With
  'Make a copy of encrypted file
  SHFileOperation SHDirOp

  Decrypt FilePath
  EncryptionStatus FilePath
End Sub

Sub Encrypt(sFile As String)
  If EncryptFile(sFile) Then
    MsgBox "The file " & sFile & " succesfully encrypted. Log in as another user and try to access this file."
  Else
    If Err.LastDllError = 6010 Then
      MsgBox "Error: Directory of " & sFile & " is disabled for encryption"
    Else
      MsgBox "Error: " & Err.LastDllError
    End If
  End If
End Sub

Sub Decrypt(sFile As String)
  If DecryptFile(sFile, 0) Then
    MsgBox "The file " & sFile & " succesfully decrypted."
  Else
    MsgBox "Error: " & Err.LastDllError
  End If
End Sub

Function EncryptionStatus(strPath As String, Optional ShowMsg As Boolean = True) As String
  Dim lngEncryptStatus
  ret = FileEncryptionStatus(strPath, lngEncryptStatus)
  If ret > 0 Then
    Select Case lngEncryptStatus
      Case FILE_ENCRYPTABLE
        msg = "The file can be encrypted"
      Case FILE_IS_ENCRYPTED
        msg = "The file is encrypted."
      Case FILE_SYSTEM_ATTR
        msg = "The file is a read-only file."
      Case FILE_ROOT_DIR
        msg = "The file is a root directory. Root directories cannot be encrypted."
      Case FILE_SYSTEM_DIR
        msg = "The file is a system file. System files cannot be encrypted."
      Case FILE_UNKNOWN
        msg = "The file is a system directory. System directories cannot be encrypted."
      Case FILE_SYSTEM_NOT_SUPPORT
        msg = "The file system does not support file encryption."
      Case FILE_READ_ONLY
        EncryptionStatus = "The encryption status is unknown. The file may be encrypted."
      Case FILE_DIR_DISALLOWED
        msg = "Reserved for future use."
      Case Else
    End Select
  Else
    msg = "Error:" & Err.LastDllError
  End If
  EncryptionStatus = msg
  If ShowMsg Then MsgBox msg
End Function

Private Sub Command1_Click()
  If Command1.Caption = "Encrypt Selected File" Then
    Encrypt File1.Path & "\" & File1.FileName
  Else
    Decrypt File1.Path & "\" & File1.FileName
  End If
  RefreshStatus
End Sub

Private Sub Command2_Click()
  If Command2.Caption = "Encrypt Selected Folder" Then
    Encrypt Dir1.Path
  Else
    Decrypt Dir1.Path
  End If
  RefreshStatus
End Sub

Private Sub Command3_Click()
  '//Disable Encryption for a specified path
  '//Note : EncryptionDisable takes Null terminated Unicode string
  ret = EncryptionDisable(StrConv(Dir1.Path & Chr(0), vbUnicode), 1)
  RefreshStatus
End Sub

Private Sub Command4_Click()
  '//Disable Encryption for a specified path
  '//Note : EncryptionDisable takes Null terminated Unicode string
  ret = EncryptionDisable(StrConv(Dir1.Path & Chr(0), vbUnicode), 0)
  RefreshStatus
End Sub

Private Sub Dir1_Change()
  File1.Path = Dir1.Path
  Label1.Caption = EncryptionStatus(Dir1.Path, False)
  RefreshStatus
End Sub

Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
  RefreshStatus
End Sub

Private Sub File1_Click()
  Label1.Caption = EncryptionStatus(File1.Path & "\" & File1.FileName, False)
  RefreshStatus
End Sub

Private Sub Form_Load()
  On Error Resume Next
  '//Create new folder for demo
  MkDir mFolder
  MsgBox "Created new dir " & mFolder

  '//Create new file for demo
  FilePath = mFolder & "\" & mFile
  iFile = FreeFile
  MsgBox "Created new file " & FilePath

  Open FilePath For Output As #iFile
  Print #iFile, "This is test"
  Close #iFile

  Command1.Caption = "Encrypt Selected File"
  Command2.Caption = "Encrypt Selected Folder"

  Command3.Caption = "Disable Encryption on Selected Folder"
  Command4.Caption = "Enable Encryption on Selected Folder"
  RefreshStatus

  '//Quick Demo
  DoDemo
End Sub

Sub RefreshStatus()
  Dim lngEncryptStatusDir, lngEncryptStatusFile

  ret = FileEncryptionStatus(Dir1.Path, lngEncryptStatus)
  ret = FileEncryptionStatus(File1.Path & "\" & File1.FileName, lngEncryptStatusFile)

  If lngEncryptStatus = FILE_IS_ENCRYPTED Then
    Command1.Caption = "Decrypt Selected File"
  Else
    Command1.Caption = "Encrypt Selected File"
  End If

  If lngEncryptStatus = FILE_IS_ENCRYPTED Then
    Command2.Caption = "Decrypt Selected Folder"
  Else
    Command2.Caption = "Encrypt Selected Folder"
  End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Dim SHDirOp As SHFILEOPSTRUCT

  With SHDirOp
    .wFunc = FO_DELETE
    .pFrom = mFolder
    '.fFlags = FOF_NOCONFIRMATION Or FOF_SILENT
  End With

  'Delete the directory
  SHFileOperation SHDirOp
End Sub