|
|
|
| Делаю программку для фитнес клуба.
Фотки клиентов будут хранится в папке FOTO
как защитить эту папку от любопытных, в то же время программно - продолжать пользоваться этой папочкой. | |
|
| |
|
|
|
| Атрибуты файла.
Option Compare Database
Option Explicit
Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Declare Function SetFileAttributes Lib "kernel32.dll" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Const Slash As String = "\"
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
'An archive file (which most files are).
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
'A file residing in a compressed drive or directory.
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
'A directory instead of a file.
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
'A hidden file, not normally visible to the user.
Public Const FILE_ATTRIBUTE_NORMAL = &H80
'An attribute-less file (cannot be combined with other attributes).
Public Const FILE_ATTRIBUTE_READONLY = &H1
'A read-only file.
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
'A system file, used exclusively by the operating system.
Declare Function GetFileTime Lib "kernel32.dll" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
Declare Function SetFileTime Lib "kernel32.dll" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
Declare Sub GetSystemTimeAsFileTime Lib "kernel32.dll" (lpSystemTimeAsFileTime As FileTime)
Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32.dll" (lpFileTime As FileTime, lpLocalFileTime As FileTime) As Long
Declare Function FileTimeToSystemTime Lib "kernel32.dll" (lpFileTime As FileTime, lpSystemTime As SYSTEMTIME) As Long
Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const CREATE_ALWAYS = 2
Public Const CREATE_NEW = 1
Public Const OPEN_ALWAYS = 4
Public Const OPEN_EXISTING = 3
Public Const TRUNCATE_EXISTING = 5
Public Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Public Const FILE_FLAG_NO_BUFFERING = &H20000000
Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
Public Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Public Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Public Const FILE_FLAG_WRITE_THROUGH = &H80000000
Public Sub SetFilesAtt(DirTmp As String, _
IntArchive As Integer, _
IntHidden As Integer, _
IntReadonly As Integer, _
IntSystem As Integer, _
IntCompressed As Integer)
On Error GoTo errs
If Len(Dir(DirTmp) & "") <> 0 Then
Dim AttrTmp As Long
If IntArchive = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "Archive") = 1) Then
AttrTmp = AttrTmp + 32
End If
If IntHidden = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "Hidden") = 1) Then
AttrTmp = AttrTmp + 2
End If
If IntReadonly = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "Readonly") = 1) Then
AttrTmp = AttrTmp + 1
End If
If IntSystem = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "System") = 1) Then
AttrTmp = AttrTmp + 4
End If
If IntCompressed = 1 Or (IntArchive = 0 And GetFilesAtt(DirTmp, "Compressed") = 1) Then
AttrTmp = AttrTmp + 2048
End If
Call SetFileAttributes(DirTmp, AttrTmp)
End If
errs:
End Sub
|
Примеры:
Private Sub BtnDel_Click()
If MsgBox("Отменить прикрепление файла " & Me.FileKRPIshDocFiles & "." & ExtKRPIshDocFiles & " ?", vbYesNo + vbQuestion + vbDefaultButton2, "Внимание") = vbYes Then
Dim PathFile As String
PathFile = StrDirTmp & Format(Me.IdKRPIshDoc, "00000000") & "\" & Format(Me.IdKRPIshDocFiles, "00000000") & "." & Me.ExtKRPIshDocFiles
On Error Resume Next
SetFilesAtt PathFile, -1, -1, -1, -1, -1
Kill (PathFile)
If Len(Dir(PathFile)) = 0 Then
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE TblKRPIshDocFiles.*, TblKRPIshDocFiles.IdKRPIshDocFiles FROM TblKRPIshDocFiles WHERE TblKRPIshDocFiles.IdKRPIshDocFiles=" & Me.IdKRPIshDocFiles & ";")
DoCmd.SetWarnings True
Me.Requery
Else
SetFilesAtt PathFile, 0, 0, 1, 0, 0
MsgBox "При отмене прикрепления файла произошла ошибка !", vbInformation, "Ошибка"
End If
End If
End Sub
Private Sub btnopen_Click()
Dim PathFile As String
PathFile = StrDirTmp & Format(Me.IdKRPIshDoc, "00000000") & "\" & Format(Me.IdKRPIshDocFiles, "00000000") & "." & Me.ExtKRPIshDocFiles
If Len(Dir(PathFile)) <> 0 Then
SetFilesAtt PathFile, 0, 0, 1, 0, 0
Call fHandleFile(PathFile, Win_MAX) 'Это проц. открытия файла программой по умолчанию (если надо - код дам)
Else
MsgBox "Прикрепленый файл не найден !", vbInformation, "Ошибка"
End If
End Sub
|
| |
|
| |
|
|
|
| а можно немного описания?
я не всё понял. | |
|
| |
|
|
|
| создаешь truecrypt диск
на нем будет база и папка с фотками.
базу с формами можно тоже туда же запихнуть.
До начала работы оператор должен смонтировать диск.
По горячим клавишам диск может размонтироваться.
Научить оператора, что как только он отошел от компа - комп блокируется (стандартной заставкой с паролем) | |
|
| |
|
|
|
| Почитал. Спасибо.
Круто.
А попроще?
http://bezopasnik.org/info/36.htm
|
| |
|
| |