... достигается декларированием IsDebuggerPresent (WinAPI) ...
... используем какой-нибудь пакер или протектор ...
Шурик писал(а):Можно сжать UPX без дальнейшего разжатия(там есть параметр такой).
Единственное НО!!! Прога после сжатия может не заработать!!!
Option Explicit
Private Const CRCPOLY = &HEDB88320
Private Const CRC_MASK = &HFFFFFFFF
Private CRCTable(255) As Long
Public Function GetCRC32(Text As String) As Long
Dim i As Long, LastCRC As Long
LastCRC = CRC_MASK
For i = 1 To Len(Text)
LastCRC = CRCTable((LastCRC And &HFF) Xor (Asc(Mid$(Text, i, 1)))) Xor (LastCRC \ 256)
Next
GetCRC32 = LastCRC
End Function
Public Function CountCRC32(FileName As String) As Long
Dim i As Long, r As Byte, LastCRC As Long, FileNumber As Integer
FileNumber = FreeFile
Open FileName For Binary As FileNumber
LastCRC = CRC_MASK
For i = 1 To LOF(FileNumber)
Get FileNumber, i, r
LastCRC = CRCTable((LastCRC And &HFF) Xor r) Xor (LastCRC \ 256)
Next
Close FileNumber
CountCRC32 = LastCRC
End Function
Private Sub Class_Initialize()
Dim i As Integer, j As Integer, r As Long
For i = 0 To 255
r = i
For j = 8 To 1 Step -1
If (r And 1) > 0 Then r = (r \ 2) Xor CRCPOLY Else r = r \ 2
Next
CRCTable(i) = r
Next
End Sub
marvan писал(а):Тут проанализировал 35 проектов VB, демонстрирующих приёмы, использующиеся при создании shareware программ.
tyomitch писал(а):Ну на:
- Код: Выделить всё
Private Const CRCPOLY = &HEDB88320
Private Const CRC_MASK = &HFFFFFFFF
Private CRCTable(255) As Long
Private Sub Class_Initialize()
Dim i As Integer, j As Integer, r As Long
For i = 0 To 255
r = i
For j = 8 To 1 Step -1
If (r And 1) > 0 Then r = (r \ 2) Xor CRCPOLY Else r = r \ 2
Next
CRCTable(i) = r
Next
End Sub
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 14