Rambler's Top100
Форум: MS ACCESSVBVBA MS OfficeMS SQL server
Новые сообщения: 0000

Форум: MS ACCESS

Вопросы связанные с MS ACCESS

Обновить визитку
Участники «Online»
Все участники

 
 

Доброго времени суток, Посетитель!

вид форума:
Линейный форум Структурный форум

тема: Накидайте советов
 
 автор: час   (23.02.2015 в 20:42)   личное сообщение
 
 

Делаю программку для фитнес клуба.
Фотки клиентов будут хранится в папке FOTO
как защитить эту папку от любопытных, в то же время программно - продолжать пользоваться этой папочкой.

  Ответить  
 
 автор: Дядя Федор   (24.02.2015 в 08:02)   личное сообщение
 
 

Атрибуты файла.

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

  Ответить  
 
 автор: час   (24.02.2015 в 21:49)   личное сообщение
 
 

а можно немного описания?
я не всё понял.

  Ответить  
 
 автор: osmor   (24.02.2015 в 09:37)   личное сообщение
 
 

создаешь truecrypt диск
на нем будет база и папка с фотками.
базу с формами можно тоже туда же запихнуть.
До начала работы оператор должен смонтировать диск.
По горячим клавишам диск может размонтироваться.
Научить оператора, что как только он отошел от компа - комп блокируется (стандартной заставкой с паролем)

  Ответить  
 
 автор: час   (24.02.2015 в 22:02)   личное сообщение
 
 

Почитал. Спасибо.
Круто.

А попроще?

http://bezopasnik.org/info/36.htm

  Ответить  
HiProg.com - Технологии программирования
Rambler's Top100 TopList