| 0
- 06.06.2012 - 10:59
|
У меня такая задача, может кто поможет решить. Существует локальная сеть предприятия. На всех компах есть файл таблицы excel с определённой базой данных. Базу обновляю я и через время она расползается по всей сетке по всем компам путём копипаста. Начало работы с файлом начинается с нажатия на кнопку гиперссылки внутри файла. Задача что-то сделать с файлом, чтобы к определённой дате он испортился (удалился, стёрлись, заменились данные, не важно). Не знаю как реализовать этот механизм. Может макрос кто поможет написать, или как то по другому? Если я не в той теме пишу, укажите правильную. Заранее спасибо.     | | ||
| 1
- 06.06.2012 - 13:03
| Как насчет "Rights Management Services"? Он же AD RMS. | | ||
| 2
- 06.06.2012 - 15:59
|
Значит-с, так. Если самозачищаемых файлов много - можно сделать их самоуничтожаемыми при открытии в заданный день или отстоящий на N дней, при открытии не там, не тем пользователем, не на том компьютере, не в рабочее время итп - это достаточно легко. Если файло один и очень секретный - то расползающиеся тараканы это плохо - надо работать с файлом ТОЛЬКО на сервере. Вот идеи: 1) Можно макросом запретить диалог SaveAs "Сохранить как", для 80% юзеров это уже достаточно. Искать в иностранной книге Трюки и эффекты (код выложен на сайте изд-ва) 2) Можно, при открытии книги, неотключаемым в Excel даже по Ctrl+Break автомакросом читать путь, и если путь не-сервер - а) забивать содержимое бессмыслицей б) сохранять в) удалять. Если просто сразу файл удалить методом kill - он почти 100% восстановим, хотя в корзину он не попадает. Это пункт помогает в остальных 19% случаев. 3) Но можно открыть XLS не в Excel, а в OpenOffice/LibreOffice или пересохранить его в XLSX идр "немакросные" форматы. И автомакрос при этом не сработает. Поэтому нужна подстраховка - Разрешить открывать только в Excel, путем стойкого "несовместимого" шифрования. ... Макроссы может здесь наваять, а Вопросы по RMS лучше задавать на форуме "Сети". | | ||
| 3
- 09.06.2012 - 11:21
| 2-economist >А можешь написать макрос в этом файле если кину по почте? | | ||
| 4
- 11.06.2012 - 23:10
| Могу - какой именно вариант идеи? Я введу в макросе условное имя и/или IP адрес сервера. Надо будет после размещения у себя на серваке закомментировать нужные строки кода и проверить работоспособность в случае переписывания на другую машину. В принципе, мне не нужен ваш секретный файл, но имя его мне понадобится, если оно слишком специфично - переименуйте попроще. Тогда в мой файл достаточно будет переместить листы из вашего, пересохранить с заменой - и вуаля... | | ||
| 5
- 13.06.2012 - 08:33
|
'---------------------------------------------- Private Sub Workbook_Open() ' (c) economist Все как есть - без гарантий! ' Макрос в книге при открытии файла читает имя компа и сравнивает его с РАЗРЕШЕННЫМ ' и если совпадения нет - "самоуничтожается" путем перезаписи с пустым содержимым всех листов ' Макрос вставить в после Alt+F11 в объект ЭтаКнига ' Проверить на пустом файле, введя бессмылице в ячейки листов, убедиться что после открытия НЕ на сервере ячейки очистились ' затем уже сделать на рабочем (можно путем переноса листов вручную) ' Если неизвестно имя компьютера-сервера - узнать у сисадмина! Dim legalServer As String Dim HostName As String legalServer = "SERVERNAMEUPPERCASE" ' ВВЕДИТЕ разрешенный сервер, на котором файл живет (в верх регистре) HostName = CreateObject("WScript.Network").ComputerName ' узнали имя компа If legalServer <> HostName Then ' если сервер нелегален, то Dim sh As Object For Each sh In ThisWorkbook.Sheets sh.Cells.ClearContents Next sh ThisWorkbook.Save End If End Sub | | ||
| 6
- 13.06.2012 - 08:39
| Можно отследить имя сервера и по его IP-адресу, но если в он "динамически" выдается - будут некоторые сложности в реализации (придется лезть в кущеряки, типа оснасток WMI, а там высока вероятность что злой админ запретил их). Кстати, Макрос не заработает если у вас админ запретил и Wscript. Тогда надо ему какбэ намекнуть что он не прав, и его параною можно вылечить... | | ||
| 7
- 13.06.2012 - 15:21
|
Автор, побольше бы исходных данных. Цитата:
Цитата:
В организации есть какие-либо домены и прочее? Можно сделать скрипт, который при первом запуске будет осуществлять поиск файлов с каким либо признаком (можно даже по содержимому файла, например содержимому гиперсылки) и удалять подобные файлы. Ну или какой-то подобный механизм. А еще лучше посмотреть в сторону оптимизации предоставления информации пользователям. | | ||
| 8
- 13.06.2012 - 16:15
| +5: Я вот тут поразмыслил - в мой макрос нужно добавить вот еще что - чтение/сравнение пути самой книги XLS. Иначе файл будет самоочищаться при любом доступе извне. Завтра допишу. | | ||
| 9
- 13.06.2012 - 17:49
| Постановка задачи неверная и попадает под статью УК. Так что правильный подход в этом случае следующий где то на своем сервере разместить такие "ценные" данные, а пользователям предоставлять доступ к ним по сети через клиентское приложение или web интерфейс. Использовать нормальную клиент-серверную БД, а не страдать фигней с excel файлом. Доступ для пользователей сделать платным т.е. заплатил - получил логин и пароль действительный в течении определенного времени, о чем пользователь должен быть уведомлен. Естественно можно сделать контроль чтобы под одним логином не лезло несколько особо хитрых пользователей. | | ||
| 10
- 14.06.2012 - 05:12
|
Если закрыт Wscript можно использовать такой код Private Declare Function GetComputerNameA Lib "kernel32" _ (ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function WNetGetUserA Lib "mpr.dll" _ (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long Function GetComputerName() As String Dim sBuffer As String * 255 If GetComputerNameA(sBuffer, 255&) <> 0 Then GetComputerName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1) End If End Function Function GetUserName() As String Dim sUserNameBuff As String * 255 sUserNameBuff = Space(255) Call WNetGetUserA(vbNullString, sUserNameBuff, 255&) GetUserName = Left$(sUserNameBuff, InStr(sUserNameBuff, vbNullChar) - 1) End Function | | ||
| 11
- 14.06.2012 - 09:11
|
Вот исправленный макрос под задачи автора - грохать открытое не там. Private Sub Workbook_Open() ' (c) economist. Как есть - без гарантий! ' ************************************************** ************************************************** ********************************* ' ******* Самоудалялка XLS-VBA, если открыли файл не там где можно ***** ' ************************************************** ************************************************** ********************************* ' Макрос в книге при открытии файла XLS определяет ГДЕ находится сам XLS- ' файл, с поддержкой всех видов путей (буквы диска, LAN, UNC) ' и если не там где РАЗРЕШЕНО - "самоуничтожается" путем перезаписи с ' пустым содержимым всех листов. Задать легальный сервер (имя, IP)! ' Макрос вставить в после Alt+F11 в объект ЭтаКнига ' Проверить на пустом файле, введя бессмылицу в ячейки листов, убедиться что после открытия НЕ на сервере ячейки очистились ' затем уже сделать на рабочем (можно путем переноса листов вручную) ' Если неизвестно имя/IP компьютера-сервера - узнать у сисадмина! ' TODO: Если сеть одноранговая с дин.-IP - подумать Dim legalServerIP As String ' создали перем для IP "разрешенного" сервера XLS Dim legalServer As String ' создали перем для имени "разрешенного" сервера XLS Dim NetPath, RealPath ' создали перем для IP адреса компа, с которого реально открыт файл XLS Dim fso As New Scripting.FileSystemObject ' создали перем для файловых объектов Dim sh As Object ' премененная для затирания листов legalServerIP = "10.0.0.10" ' ВВЕДИТЕ IP - адрес разрешенного сервера XLS, на котором файл живет (в верх регистре) legalServer = "Server1" ' ВВЕДИТЕ DNS-имя разрешенного сервера XLS (первая буква обычно большая) DriveXLS = Left(ThisWorkbook.Path, 1) ' прочли имя диска (м.б. сетевого), если открыли через сеть - \ NetPath = Split(ThisWorkbook.Path, "\") ' разбили путь на части ' Файл в Windows можно открыть по разному: ' А - C локального диска (с любой буквой) ' Б - С сетевого диск (с любой буквой) ' В - Через UNC - то есть \\server1\folder\filename.xls ' Г - или без DNS имен - то есть \\XXX.XXX.XXX.XXX\folder\filename.xls ' Поэтому в программе будет ветвление - первый символ - диск или \ ' Для \\server1\folder\filename.xls и \\10.0.0.100\folder\filename.xls If DriveXLS = "\" Then ' если вдруг открыли файл через сетевое окружение RealPath = NetPath(2) ' прочли ИМЯ сервера server1 If (legalServer <> RealPath And legalServerIP <> RealPath) Then For Each sh In ThisWorkbook.Sheets sh.Cells.ClearContents Next sh ThisWorkbook.Save End If End ' закончили случай с \\server и \\XXX.XXX.XXX.XXX End If ' Для локальных дисков С:-F: и сетевых G:-Z: (к примеру) C:\folder\filename.xls и G:\folder\filename.xls If DriveXLS <> "\" Then ' если это буква диска NetPath = Split(fso.Drives(DriveXLS).ShareName, "\") On Error Resume Next ' RealPath = NetPath(2) ' прочли ИМЯ сервера server1 If (legalServer <> RealPath And legalServerIP <> RealPath) Then For Each sh In ThisWorkbook.Sheets sh.Cells.ClearContents Next sh ThisWorkbook.Save End If On Error GoTo 0 End If ' закончили случай с буквами диска End Sub | | ||
| 12
- 14.06.2012 - 09:13
| Очень форуму не хватает подсветки кода, или хотя бы моноширинности. В моей вики просто глаз радуется от "цветника", здесь же - как будто школьник напЫсал... | | ||
| 13
- 14.06.2012 - 12:55
|
Рюкзак - замечу также, что работа с XLS с самих рабочих станций предполагается прямо на сервере, а не борьба с уже расползшимися тараканами по сети. ... Тут Naix и TVV1 говорят что инструментарий (Excel) неподходящий - вполне возможно. Но есть хорошие примеры одновременной(!) работы в одном(!) файле Excel 3-5 активных пользователей (с парольной защитой, журналированием/откатом изменений) и это не просто "туповвод", а работа с развернутыми формами, справочниками (все сделано на формулах/диапазонах), и реализовать такое на СУБД+морде выйдет на несколько месяцев и сотню+две тысяч рублей ЗП с налогами дороже, чем просто самоуничтожалка, быстро приучающая юзверей работать с сетевой шарой. Для полнофункционального решения в Excel еще надо бы: а) написать перехватчик Ctrl+Break (чтобы не остановить макрос) (легко гуглится) б) заблокировать кодом SaveAs (легко гуглится) в) стойко запаролить файл и сам модуль (разными паролями) г) предупредить юзера модальным окном, чтобы он не пытался сделать копии с файла д) заблокировать на время работы макроса прорисовку интерфейса (Application.ScreenUpdating=False), а то юзер увидит как его циферки быстренько исчезают. Впрочем, педагогический эффект внушаиитттьь... | | ||
| 14
- 14.06.2012 - 13:25
|
з) Вспомнил еще, что если в Excel отключить заблокировать макросы, то файл откроется не очистившись. Но на каждую жп найдется и лерка и метчик. Добавить так: Dim sh As Object ' переменная для затирания листов ' сильно скрыть листы 1-2 (последний должен быть видимым, если что - добавить ручками) ' такое скрытие в Excel без макроса не раскрыть ThisWorkbook.Sheets(1).Visible = xlSheetVeryHidden ThisWorkbook.Sheets(2).Visible = xlSheetVeryHidden а далее после каждого ThisWorkbook.Save добавить ThisWorkbook.Save ThisWorkbook.Sheets(1).Visible = True ThisWorkbook.Sheets(2).Visible = True PS Данные из ячеек скрытого листа, зная пароль все равно можно прочитать безо всякого программирования, просто отобразив их формулами, ссылающимися на книгу/лист/ячейку, но 99% юзверей об этом трюке не знают. К тому же можно их сделать неактуальными/неправильными по какому-нить алгоритму. | | ||
| 15
- 16.06.2012 - 10:46
|
' (c) economist. Как есть - без гарантий! ' ******* Самоудалялка XLS-VBA, если открыли файл не там где можно ***** ' Макрос в книге при открытии файла XLS определяет ГДЕ находится сам XLS- ' файл, с поддержкой всех видов путей (буквы диска, LAN, UNC) ' и если не там где РАЗРЕШЕНО - "самоуничтожается" путем перезаписи с ' пустым содержимым всех листов. Задать легальный сервер (имя, IP)! ' Макрос вставить в после Alt+F11 в объект ЭтаКнига ' Проверить на пустом файле, введя бессмылицу в ячейки листов, убедиться что после открытия НЕ на сервере ячейки очистились ' затем уже сделать на рабочем (можно путем переноса листов вручную) ' Если неизвестно имя/IP компьютера-сервера - узнать у сисадмина! ' TODO: Если сеть одноранговая с дин.-IP - подумать ' (с) daxy. Расширение функционала ' Отключено сохранение книги Файл-Сохранить как ' Теперь работаем со всеми листами книги ' При загрузке книги без макросов не отображаются листы с данными, а отображается лист с приветствием. Option Explicit Const legalServerIP As String = "10.0.0.10" ' ВВЕДИТЕ IP - адрес разрешенного сервера XLS, на котором файл живет (в верх регистре) Const legalServer As String = "Server1" ' ВВЕДИТЕ DNS-имя разрешенного сервера XLS (первая буква обычно большая) Const PR As String = "ВКЛЮЧИТЕ МАКРОСЫ!" ' ИМЯ КНИГИ НАПОМИНАЛКИ Dim sh As Object Dim fso As Object Private Sub Valid_Server() ' Файл в Windows можно открыть по разному: ' А - C локального диска (с любой буквой) ' Б - С сетевого диск (с любой буквой) ' В - Через UNC - то есть \\server1\folder\filename.xls ' Г - или без DNS имен - то есть \\XXX.XXX.XXX.XXX\folder\filename.xls ' Поэтому в программе будет ветвление - первый символ - диск или \ ' Для \\server1\folder\filename.xls и \\10.0.0.100\folder\filename.xls Set fso = CreateObject("Scripting.FileSystemObject") 'в отличии от Dim fso As New Scripting.FileSystemObject не требует включения референсов в библу VBA Dim NetPath, RealPath, DriveXLS As Variant ' создали перем для IP адреса компа, с которого реально открыт файл XLS DriveXLS = Left(ThisWorkbook.Path, 1) ' прочли имя диска (м.б. сетевого), если открыли через сеть - \ NetPath = Split(ThisWorkbook.Path, "\") ' разбили путь на части On Error Resume Next If DriveXLS = "\" Then ' открыли файл через сетевое окружение RealPath = NetPath(2) ' прочли ИМЯ сервера server1 If (legalServer <> RealPath Or legalServerIP <> RealPath) Then Kill_And_Save 'была видимо ошибка, не И а ИЛИ надо но не утверждаю Else 'Открыли файл с буквами диска NetPath = Split(fso.Drives(DriveXLS).ShareName, "\") RealPath = NetPath(2) ' прочли ИМЯ сервера server1 If (legalServer <> RealPath Or legalServerIP <> RealPath) Then Kill_And_Save End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Workbook_Save Cancel = True End Sub Private Sub Workbook_Save() On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False WorkSheets_VeryHidden ThisWorkbook.Save WorkSheets_Visible DeletePR Application.EnableEvents = True Application.ScreenUpdating = True End Sub Private Sub WorkSheets_Visible() For Each sh In ThisWorkbook.Sheets ThisWorkbook.Sheets(sh.Name).Visible = True Next sh DeletePR End Sub Private Sub WorkSheets_VeryHidden() AddPR For Each sh In ThisWorkbook.Sheets If sh.Name <> PR Then ThisWorkbook.Sheets(sh.Name).Visible = xlSheetVeryHidden Next sh End Sub Private Sub AddPR() DeletePR Sheets.Add Sheets(ActiveSheet.Name).Name = PR Sheets(PR).Tab.Color = vbRed Range("A2") = "ВКЛЮЧИТЕ МАКРОСЫ!" Range("A1", "K3").Select Selection.Interior.Color = vbRed Selection.Font.Size = 48 End Sub Private Sub DeletePR() On Error Resume Next Application.DisplayAlerts = False Sheets(PR).Delete Application.DisplayAlerts = True End Sub Private Sub Kill_And_Save() If MsgBox("Обнаружен не разрешенный носитель для этой книги" & vbCr & "Удалить данные на листах?", vbYesNo) = vbNo Then Exit Sub 'Чтобы не удалить данные при проверке, в реальной работе строчку удалить For Each sh In ThisWorkbook.Sheets sh.Cells.ClearContents 'ClearContents оставляет примечание и прочее Next sh Workbook_Save End Sub Private Sub Workbook_Open() Application.ScreenUpdating = False WorkSheets_Visible Application.ScreenUpdating = True Valid_Server End Sub | | ||
| 16
- 16.06.2012 - 19:06
| dax - отлично! VBA способен в офисе изменить сам характер труда, а каждый "шкодер" должен поощряться за любую инициативу! Как работодатель я этому следую издавна, но на пути автоматизации много бревен в глазах и роялей в кустах... | | ||
| 17
- 21.06.2012 - 20:16
| Ахи....ть!!!! :О Куда это всё вставлять?! | | ||
| 18
- 21.06.2012 - 20:43
|
Я понял что я далёк от слова макрос. Люди, всё на много проще!!! Бся база данных состоит из кучи вордовских файлов лежащих в папке на которые простые гиперссылки из файла эксель. Никакими мудрёными эскюэлями и даже аксесами там не пахнет. Эту всю хрень пользуясь своими мягко говоря скудными знаниями экселя и паинтбраша:) слепил я и никакие статьи мне за удаление не грозят. Просто наши начальники нашли это очень удобным и все работники пользуются базой которую я создал фактически для себя. А вот со мной хотят поступить очень не честно. За то что я отказался идти на корпоратив, а главное сдавать деньги на это началась на меня травля. Было бы за дело ёптать! В общем хочу если меня уволят позлорадствовать. Суть вот в чём. Все работники никакие не програмисты и от слоб БазаДанных падают в обморок. Так что самая простая и глупая подлянка вряд ли будет замечена и должна сработать. Хочу сделать так, чтоб в какой нибудь клеточке экселя белыми чернилами на белом фоне (ну чтоб не видно было) стояла дата порчи этого файла. По умолчанию стоял какой нибудь 31.12.2100. Но если меня увольняют, я туда вписываю дату эдак через месяцок после сегодня, сохраняю. Со временем файл расползается по всем компам и в указанную дату ТРАХ!!!! ))))) Привет от меня! Файл вылодил тут: http://depositfiles.com/files/kodt4603c | | ||
| 19
- 21.06.2012 - 23:28
|
to18 Если ты слепил это в рабочее время и за это получал зарплату и использовал для этого свое рабочее место, то вопрос очень спорный Потом то что ты описал попадает даже не под одну статью, а под несколько http://www.zakonrf.info/uk/272/ http://www.zakonrf.info/uk/273/ | | ||
| 20
- 21.06.2012 - 23:35
| to18 И еще вопрос как ты думаешь куда денется макрос из xls файла и сколько потребуется времени в случае разбора полетов для выявления причины исчезновения данных. | | ||
| 21
- 22.06.2012 - 07:28
|
Рюкзак - прямо какие-то "Заметки отечественного западлостроения" :-)) В терминологии программистов это называется "закладка". Довольно распространенный прием, "страховка" на случай неплатежа/увольнения. За рубежом считается очень дурным тоном, но там и реалии несколько другие. ... А ваша причина конфликта настолько смешна, что огород городить не советую и помогать не буду. Ходить или нет на корпоратив - дело каждого, и вы это право подтвердили, в другой раз травить не будут. Лучше вашу злость конвертировать в упорство, направить его на обучение, изучить макросы и написать такое полезное для конторы приложение, что вас будут на корпоративы возить/кормить/поить бесплатно. Вот тогда и "закладка" будет уместна, а сейчас - несерьезно. ... TVV1 - в Excel нет ничего невозможного. Есть как минимум 2 способа. 1) Если включено доверие к объектной модели VBA - любой модуль VBA можно удалить самим VBA по волшебной команде: Application.ThisWorkbook.VBProject.VBComponents.Re move Application.ThisWorkbook.VBProject.VBComponents.It em("Module1") Сила это команды настолько велика, что она может убить даже тот модуль, в котором сама находится! 2) Макрос может самоуничтожиться вместе с самим XLS-файлом. В коде VBA создаем BAT-файл вида ..del base.xls, запускаем его и закрываем excel. Батник срабатывает и... Все: ни файла, ни макроса. Корзина тоже пуста. Хотя правильнее сначала перезаписать файл бессмыслицей того же объема, тогда поиски ни к чему не приведут. | | ||
| 22
- 22.06.2012 - 07:31
|
В п. 21 в коде вкрались пробелы: Application.ThisWorkbook.VBProject.VBComponents.Re move_ Application.ThisWorkbook.VBProject.VBComponents.It em("Module1") ... Если модулей несколько - то циклом, или перебором коллекции (особенно при нестандартных именах или коде в объектах - листах, Workbook итд). | | ||
| 23
- 22.06.2012 - 09:12
| 19-TVV1 >Не в рабочее! Дома составил. И мне за это ничегошеньки не платили, так что думаю не попадаю. А по поводу макроса, ну вычислят, ну поймут, ну и что? Я ничего никому не обещал и к этому времени буду уволен.21-economist > мне тоже очень смешно что меня за такую фигню до увольнения доводят (((( | | ||
| 24
- 25.06.2012 - 14:09
| 23 У нас такое было. Дамочка удалила все свои наработки и уничтожила все отчеты на бумажных носителях перед увольнением. Бегали по ментовкам, писали какие-то бумажки, 70 тыщ. на лапу адвокату и следователю давали, а наказать злодейку так и не смогли. | | ||
| 25
- 25.06.2012 - 15:29
|
Рюкзак, запомни самое главное правило: Хорошо всегда там, где нас нет. Так что... если тебя хотят "слить" - используй свою контору как средство поиска работы, согласись и возьми рекомендательное письмо, и флаг тебе в руки. ...но сдаётся мне ты лукавишь. Ни разу не видел такого, чтобы человека сливали из-за того что не пошел на корпоратив. | | ||
| 26
- 03.03.2015 - 07:27
| Не может быть-) | |
Интернет-форум Краснодарского края и Краснодара |
