Страницы: 1
RSS
Привязка файла к железу HDD, Нужен конкретный макрос привязки к железу к HDD
 
Приветствую,

Нужен конкретный т.е. рабочий макрос - который привязывает файл Excel к номеру HDD

при открытии файла и нажатие на разрешение запуска макросов.

Типа - защита от копирования на другой ПК, при копировании - должен не работать т.к. серийник именно HDD - не совпадает.


С уважением Сергей.
 
Бюджет?
Неизлечимых болезней нет, есть неизлечимые люди.
 
Нереально так сделать, только с использованием макроса (без сайта)
Вот выслали вы человеку файл, и он запустил файл на своем компе.
Откуда макрос узнает, первый это комп или второй?

Для второго компа человек возьмет файл не с первого компа, а высланный вами файл из почты.
Как макрос поймет, что ему нельзя работать?

PS: Любой файл НЕВОЗМОЖНО защитить от копирования
PPS: TheBestOfTheBest, видимо, волшебник, раз спрашивает бюджет и готов такое реализовать.

Впрочем, решение возможно, если вы лично будете устанавливать файл на комп пользователя (чтобы у него не осталась исходного непривязанного файла)
Изменено: Игорь - 25.05.2020 16:00:42
 
Игорь, Вы правы, - сайт есть - с сайтом можно ?
 
Игорь, А если сделать, инсталяционный файл, и удалить его - макросом из файла, а файл привязать к винту...


файл скачивается на диск, по динамической ссылке - допустим ( она больше не повториться )

а не через почту.
 
Цитата
Игорь написал:
Вот выслали вы человеку файл, и он запустил файл на своем компе.Откуда макрос узнает, первый это комп или второй?
Сначала высылается макрос, шифрующий и возвращающий серийник. Потом серийник перешифровывается и вшивается в код, потом только отправляется работающий файл с кодом.
Никому не отвечай, кoгда ты зол, ничего не обeщай, когда ты счастлив, никогда нe решай, когда ты грустeн.
 
Joiner, Вы правы - Маэстро, цена вопроса ?
 
Цитата
sergeyrogov1981 написал:
Joiner , Вы правы - Маэстро, цена вопроса ?
Не-не, извиняюсь, но я занят на ближайший месяц точно вот этим. TheBestOfTheBest,  был первым.
Никому не отвечай, кoгда ты зол, ничего не обeщай, когда ты счастлив, никогда нe решай, когда ты грустeн.
 
Цитата
Игорь написал:
Любой файл НЕВОЗМОЖНО защитить от копирования
теперь возможно - времена и технологии позволяют,
как мини комплекс программный защитить - но может не в Excel - конечно...
Изменено: sergeyrogov1981 - 25.05.2020 17:50:42
 
Цитата
TheBestOfTheBest написал:
Бюджет?
по ценам не ориентируюсь, примерно макрос - привязка к HDD - нужен мне, сколько ? скажите пожалуйста
 
Цитата
sergeyrogov1981 написал:
теперь возможно - времена и технологии позволяют,
У хакеров тоже. Ограничение только в цене вопроса.
Никому не отвечай, кoгда ты зол, ничего не обeщай, когда ты счастлив, никогда нe решай, когда ты грустeн.
 
Цитата
Joiner написал:
У хакеров тоже. Ограничение только в цене вопроса.
согласен, но блокчейн не по зубам.

и файл на компе - который к нету не подключен - только физический доступ. :)

немного - юмора...

поможет кто с макросом привязки - а ребята ?
Изменено: sergeyrogov1981 - 25.05.2020 18:26:56
 
Ну вот получаю я номер

Код
Function HardwareID() As String
    ' © 2015 ExcelVBA.ru
    ' Функция возвращает сигнатуру HDD
    ' работает на 80% компьютеров (протестировано на тысячах разных компьютеров)
    On Error Resume Next: Dim v&, sv$, obj As Object, DriveID$, PartName$, DriveLetter$
    DriveLetter$ = Environ("SystemDrive"): If Not DriveLetter$ Like "[A-Z]:" Then DriveLetter$ = "C:"
    With GetObject("winmgmts:")
        For Each obj In .ExecQuery("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID='" & DriveLetter$ & "'} WHERE AssocClass = Win32_LogicalDiskToPartition"): PartName$ = obj.DeviceID: Next
        For Each obj In .ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & PartName$ & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition"): DriveID$ = obj.DeviceID: Next
        For Each obj In .ExecQuery("SELECT * FROM Win32_DiskDrive WHERE DeviceID='" & Replace(DriveID$, "\", "\\") & "'"): v& = Val(obj.Signature): Next
    End With
    If v& = 0 Then HardwareID = "нет данных" Else HardwareID = CStr(v)
End Function


как привязать к компу ?
Изменено: sergeyrogov1981 - 25.05.2020 18:30:29
 
Этот работает ?

Код
Public Sub GetDiskInfos()
    Dim pWMI As Object, pDisks As Object, pDisk As Object
     
    Set pWMI = GetObject("winmgmts:\\")
    Set pDisks = pWMI.ExecQuery("Select * from Win32_DiskDrive Where BytesPerSector Is Not Null", , 48)
     
    For Each pDisk In pDisks
        Debug.Print "Model:" & pDisk.Model
        Debug.Print "MediaType:" & pDisk.MediaType
        Debug.Print "SerialNumber:" & pDisk.SerialNumber
    Next
End Sub
 
Public Function CheckDiskSerial(ByVal this As String) As Boolean
    Dim pWMI As Object, pDisks As Object, pDisk As Object
    Set pWMI = GetObject("winmgmts:\\")
    Set pDisks = pWMI.ExecQuery("Select * from Win32_DiskDrive Where SerialNumber = '" & this & "'", , 48)
    CheckDiskSerial = False
    For Each pDisk In pDisks
        CheckDiskSerial = True: Exit For
    Next
End Function


Пробовал не работает, вот и спрашиваю у вас Уважаемые, как привязать ?
Изменено: sergeyrogov1981 - 25.05.2020 18:32:40
 
Искал я - все перерыл - у Игоря хорошо реализовано.

Класс !
 
И это не понять как ??? - короче дуб я в этом - а файл добрый собрал - по защите не шарю...


Код
' аварийное завершение произойдет при истекшем лиц. периоде
Private Sub Процедура1()
    Var1 = False

    ...

    ' например, Var2 = &H80000000, а Var3 - содержит кол-во оставшихся дней лиц. периода, тогда если период истек - значение Var3 будет отрицательным и выражение (&H80000000 And <отрицат.>) будет не равно нулю, и это вызовет переход на ваш "левый" код.
    If Var2 And Var3 Then GoTo SomeErr

    ...

    Exit Sub

SomeErr:
    ' здесь какой-нибудь "левый", отвлекающий, код, который вызовет критическую ошибку и не даст продолжить, или отработав просто завершит работу программы.
    ...
    Var4 = Var4 / Var1 ' деление на ноль!
    ...
    End ' или просто завершение программы.
End Sub



' аварийное завершение произойдет при истекшем лиц. периоде
Private Sub Процедура2()
    On Error GoTo ErrHandler

    ... (отлаженный код, не вызывающий ошибок)

    Процедура3

    ... (отлаженный код, не вызывающий ошибок)

    Exit Sub

ErrHandler:
    End
End Sub


Private Sub Процедура3()

    ... (отлаженный код, не вызывающий ошибок)

    ' например, Var5 - срок оконч. лиц., а Var6 - текущая дата (чтобы сильнее "запутать", даты можно хранить в переменных с числовым типом: Long, Single, Double)
    ' и т.к. переменная <счетчик1> имеет тип Byte - когда-то (зависит от первоначального, рандомного знач., присвоенного при запуске программы) это выражение вызовет ошибку переполнения и завершение программы.
    ' причем, ошибка произойдет в этой процедуре, а "точка выхода" будет в Процедура2, что также должно усложнить работу взломщика...
    ' (можно разбросать по коду, по разным функциям, несколько счетчиков с разными рандомными первоначальными значениями, чтобы сложнее было понять условия срабатывания, т.е. при одном запуске программы первонач. знач. может быть большим и ошибка может сгенерится уже при первом или втором вызове процедуры, а при другом запуске - первонач. знач. может быть маленьким и ошибка сгенерится только, например, на 15 вызове процедуры)
    If Var5 >= Var6 Then <счетчик1> = <счетчик1> + 32
    'If Var5 >= Var6 Then <счетчик1> = <счетчик1> - 7 ' (или так)

    ... (отлаженный код, не вызывающий ошибок)

End Sub




' аварийное завершение произойдет при неверном ключе
Private Sub Процедура4()
    On Error GoTo ErrHandler

    ...


    ' некоторые процедуры и функции вызываем подобным способом:
    CallByName Me, Var7 Xor Var8, VbMethod, True
    ' где одна из переменных содержит закодированное имя вызываемой процедуры, а другая - "ключ", получаемый преобразованием из лиц. ключа и хэша данных из лиц. файла.
    ' если в лиц. файле ВСЕ данные верны, то выражение (Var7 Xor Var8) вернет правильное имя процедуры и произойдет ее вызов,
    ' если какие-то данные в лиц. файле изменены или повреждены - выражение вернет мусор, что вызовет ошибку и завершение программы.

    ...

    Exit Sub

ErrHandler:
    End
End Sub



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

[Название программы]
Owner=ЗАО АКБ "Рога и копыта"
BIC=044585...
SN=00010257
ExpiredDate=06/06/2015
Key=Q3WRV-TR5WQ-U7XUP-UTR2D-RQ7RW


P.S. чтобы продлить лиц., нужно установить новую дату окончания, вычислить новый хэш, закодировать им "ключ" (можно выполнить с ним еще какие-то преобразования) - это и будет новым лиц. ключом.
Изменено: sergeyrogov1981 - 25.05.2020 18:36:53
 
Спасибо - удачи всем.
 
Тихо сам с собою...
На будущее. Не стоит создавать очередищи сообщений, можно дополнять предыдущие. Не нужно писать все через строку
 
Чо-то мудрено все... я пас.
Неизлечимых болезней нет, есть неизлечимые люди.
Страницы: 1
Наверх