Delphi [руководство] Привязка К Железу С Проверкой Через Сервер

Lomanu4 · 10 Окт 2015

В данной статье вы узнаете, как защищать свой софт от взлома, путем привязки программы к железу. Проверка данных будет осуществляться через PHP-скрипт. Все исходные коды вы найдете в приложенном архиве, в теме описаны только основные моменты.

Если вам лень разбираться во всем этом коде, в архиве лежит полностью рабочий вариант. Открываете, проставляете свои ключи, секретный ответ, данные от БД и можно спокойно пускать в ход.

Для начала подключаем в uses следующее:

Код:

IniFiles, EncdDecd, Wcrypt2

Wcrypt2.pas можно найти в архиве с исходниками

Главная форма будет у нас отвечать за привязку и активацию программы. Выглядеть она будет у нас вот так:

Теперь я покажу четыре простые функций, которые позволяют вытянуть информацию о ПК конечного пользователя:

Код:

function DiskID: String;
var
  VolumeName, FileSystemName: array [0 .. MAX_PATH - 1] of char;
  VolumeSerialNo: Dword;
  MaxComponentLength, FileSystemFlags: cardinal;
begin
  GetVolumeInformation('C:\', VolumeName, MAX_PATH, @VolumeSerialNo,
    MaxComponentLength, FileSystemFlags, FileSystemName, MAX_PATH);
  Result := IntToHex(VolumeSerialNo, 8);
end;

Код:

function MemorySize: string;
var
  lpMemoryStatus: TMemoryStatus;
begin
  lpMemoryStatus.dwLength := SizeOf(lpMemoryStatus);
  GlobalMemoryStatus(lpMemoryStatus);
  with lpMemoryStatus do
  begin
    Result := Format('%0.0f', [dwTotalPhys div 1024 / 1024]) + ' Mb';
  end;
end;

Код:

function ProcType: string;
var
  lpSystemInfo: TSystemInfo;
begin
  GetSystemInfo(lpSystemInfo);
  Result := IntToStr(lpSystemInfo.dwProcessorType);
end;

Код:

function GetMem: String;
var
  MyMem: TMemoryStatus;
begin
  MyMem.dwLength := SizeOf(MyMem);
  GlobalMemoryStatus(MyMem);
  with MyMem do
  begin
    Result := IntToStr(dwTotalPhys);
  end;
end;

Далее нам понадобится функция шифрации, которая позволит закодировать эти данные, дабы мы могли их безопасно передать на сервер.

Код:

function encrypt(input, key: AnsiString): AnsiString;
var
  hProv: HCRYPTPROV;
  hKey: HCRYPTKEY;
  keyBlob: record keyHeader: BLOBHEADER;
  keySize: Dword;
  keyData: array [0 .. 15] of Byte;
end;
keyLen, dataLen: Integer;
cryptMode, padMode: Dword;

function AlignUp(dwValue, dwAlignment: Dword): Dword; register;
asm
  dec edx
  add eax,edx
  not edx
  and eax,edx
end;

begin
  if (Length(input) = 0) then
    raise Exception.Create('[INPUT] parameter not specified.');

  if (Length(key) = 0) then
    raise Exception.Create('[KEY] parameter not specified.');

  if not CryptAcquireContext(@hProv, nil, nil, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)
  then
    RaiseLastOSError();

  try
    FillChar(keyBlob, SizeOf(keyBlob), 0);
    with keyBlob do
    begin
      keyHeader.bType := PLAINTEXTKEYBLOB;
      keyHeader.bVersion := CUR_BLOB_VERSION;
      keyHeader.aiKeyAlg := CALG_AES_128;
      keySize := 16;

      if (Length(key) < 16) then
        keyLen := Length(key)
      else
        keyLen := 16;

      Move(key[1], keyData[0], keyLen);
    end;

    if not CryptImportKey(hProv, @keyBlob, SizeOf(keyBlob), 0, 0, @hKey) then
      RaiseLastOSError();

    try
      cryptMode := CRYPT_MODE_CBC;
      if not CryptSetKeyParam(hKey, KP_MODE, @cryptMode, 0) then
        RaiseLastOSError();

      padMode := PKCS5_PADDING;
      if not CryptSetKeyParam(hKey, KP_PADDING, @padMode, 0) then
        RaiseLastOSError();

      Result := input;
      dataLen := Length(Result);
      SetLength(Result, AlignUp(Length(Result) + 1, 16));

      if not CryptEncrypt(hKey, 0, True, 0, @Result[1], @dataLen, Length(Result))
      then
        RaiseLastOSError();

    finally
      CryptDestroyKey(hKey);
    end;

  finally
    CryptReleaseContext(hProv, 0);
  end;
end;

Теперь подробно опишу функцию проверки лицензии, которую мы тоже должны запихать в unit1.pas

Код:

function check_lic: boolean;
var
  s: string;
  HTTP: TIdHTTP;
  data: tstringlist;
  rsp: TStringStream;
begin
  data := tstringlist.Create;
  HTTP := TIdHTTP.Create;
  rsp := TStringStream.Create('');
  site_url := 'http://site.ru/check_lic.php';
  // Здесь указываете ссылку на PHP скрипт

  s := DiskID + ':' + MemorySize + ':' + ProcType + ':' + GetMem;

  s := encrypt(s, key_encode);

  data.add('key=' + EncdDecd.EncodeString(s));
  data.add('email=' + Form1.Edit2.Text);
  HTTP.Post(site_url, data, rsp);

  // Отправили мыло и ключ на сервер

  if decrypt(EncdDecd.DecodeString(rsp.DataString), key_decode)
    = (DiskID + ':' + MemorySize + ':' + ProcType + ':' + GetMem + secret_answer)
  then
  begin
    Result := True;
    IniFile.WriteString('license', 'email', Form1.Edit2.Text);
  end
  else
    showmessage('Лицензия на ваш ПК отсутствует');
  // Декодируем ответ сервера, если secret_answer сошелся, сохраняем мыло
  // в файл, подтверждаем активацию

end;

Теперь разберем процедуру TForm1.FormCreate.

Код:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Position := poScreenCenter; // Выравниваем окно по центру

  key_encode := 'NulNullOnePoint';
  key_decode := 'NullNullTwoOpen';
  secret_answer := 'its_good';

  IniFile := TIniFile.Create(ChangeFileExt(GetCurrentDir, '\options.ini'));
  // Подключаем ini файл

  Form1.Edit2.Text := IniFile.ReadString('license', 'email', '');
  // Считываем емейл из ini (если сохранили его ранее)

  // Проверяем лицензию, если есть, скрываем форму активации, открываем другую
  if check_lic = True then
  begin
    Application.ShowMainForm := false;
    Application.CreateForm(TForm2, Form2);
    Form2.Show;
  end;

  // Если лицензии нет, в форме активации пользователь увидит свой ключ

  Edit1.Text := EncdDecd.EncodeString
    (encrypt(DiskID + ':' + MemorySize + ':' + ProcType + ':' + GetMem,
    key_encode));

  // Функция EncdDecd.EncodeString перекодирует кракозябры в
  // нормальный текст, чтобы мы могли без проблем передать его на сервер

end;

Все, клиентская часть готова. Теперь надо подготовить сервер. Создайте базу данных. В ней сделайте таблицу accounts c двумя столбцами - email и key.

PHP скрипт работает у нас абсолютно аналогично. Вот его код:

PHP:

<?php

error_reporting(0);

function PKCS5RemovePadding($input) {
return rtrim($input, substr($input, strlen($input) - 1, 1));
}

function PKCS5AddPadding($input) {
$pad = strlen($input) % 16;
for ($i = $pad; $i < 16; $i++) {
$input .= chr(16 - $pad);
}
return $input;
}

$email = $_REQUEST['email'];
$key = base64_decode($_REQUEST['key']);

$key_encode = 'NulNullOnePoint'; // Первый ключ
$key_decode = 'NullNullTwoOpen'; // Второй ключ
$secret_answer = 'its_good'; // Секретный ответ

$bd_name = 'bdname'; // Здесь введите название БД
$bd_pass = 'bdpass'; // Здесь введите пароль от БД

$key = PKCS5RemovePadding(mcrypt_decrypt(MCRYPT_RIJNDAEL_128, $key_encode, $key, MCRYPT_MODE_CBC));

$link = mysql_connect('localhost', $bd_name, $bd_pass);
mysql_select_db($bd_name);

//выбор записей
$profiles = mysql_query("SELECT * FROM `accounts` WHERE (`email`= '$email') AND (`key`= '$key') ");

if (!$profiles) {
echo "Could not successfully run query from DB: " . mysql_error();
exit;
}

if (mysql_num_rows($profiles) == 0) {
$key = mcrypt_encrypt(MCRYPT_RIJNDAEL_128, $key_decode, PKCS5AddPadding($key. "its_bad"), MCRYPT_MODE_CBC);
echo base64_encode($key);
exit;
}

$key = mcrypt_encrypt(MCRYPT_RIJNDAEL_128, $key_decode, PKCS5AddPadding($key. $secret_answer), MCRYPT_MODE_CBC);
echo base64_encode($key);

?>

Ну и скрипт добавления новых лицензий:

PHP:

<form method="POST">
<p>Email юзера:</p>
<input name="email" value="<?=@$_POST['email'];?>">
<p>Ключ:</p>
<input name="key" value="<?=@$_POST['key'];?>">
<p><input type="submit" value=" Отправить "></p>
</form>

<?php
error_reporting(0);

function PKCS5RemovePadding($input) {
return rtrim($input, substr($input, strlen($input) - 1, 1));
}

function PKCS5AddPadding($input) {
$pad = strlen($input) % 16;
for ($i = $pad; $i < 16; $i++) {
$input .= chr(16 - $pad);
}
return $input;
}

$email = $_POST['email'];

$key_encode = 'NulNullOnePoint'; // Первый ключ
$key_decode = 'NullNullTwoOpen'; // Второй ключ
$secret_answer = 'its_good'; // Секретный ответ

$bd_name = 'bdname'; // Здесь введите название БД
$bd_pass = 'bdpass'; // Здесь введите пароль от БД

$key = base64_decode($_POST['key']); // Декодим из base64
$key = PKCS5RemovePadding(mcrypt_decrypt(MCRYPT_RIJNDAEL_128, $key_encode, $key, MCRYPT_MODE_CBC)); // Декодируем из шифра

if (strripos($key, 'Mb:') === false) {
echo ('<p style="color: red">Ошибка! Неверный код<br/>'. $key. '</p>');
exit;
}


if (! $email or ! $key) echo ('<p style="color: red">Необходимо заполнить все поля</p>');
else {
$link = mysql_connect('localhost', $bd_name, $bd_pass);
mysql_select_db($bd_name);

//выбор записей
$profiles = mysql_query("SELECT * FROM `accounts` WHERE (`email`= '$email') AND (`key`= '$key') ");
if (mysql_num_rows($profiles) > 0) {
echo ('<p style="color: green">Уже есть в базе!<br/>'. $key .'</p>');
exit;
}

mysql_query("INSERT INTO `$bd_name`.`accounts` (`email`, `key`, `ip`) VALUES ('$email', '$key', '')");
echo ('<p style="color: green">Лицензия добавлена в базу!<br/>'. $key .'</p>');
}
?>

Не забудьте проставить точно такие же ключи, а также секретный ответ!
http://filez.pro/files/fQSyC1394991728.html

Sascha · 11 Окт 2015

чтото у меня неполучается вот сылки http://chatrandom.890m.com/activate.php http://chatrandom.890m.com/check_lic.php а програма всёравно выдает что Лицензия на ваш ПК отсутствует ,и как генерироавать лицензию

Lomanu4 · 14 Окт 2015

Sascha сказал(а):
чтото у меня неполучается вот сылки http://chatrandom.890m.com/activate.php http://chatrandom.890m.com/check_lic.php а програма всёравно выдает что Лицензия на ваш ПК отсутствует ,и как генерироавать лицензию

Не забудьте проставить точно такие же ключи, а также секретный ответ!

Sascha · 14 Окт 2015

Какие ключи и где ? я при регистрации вбиваю ключ диска и получаю ответ что всё прошло нормально но прога выдает всеравно ошибку что нету лицензииBh!!

Mazahaka_lab · 1 Янв 2018

Ваша функция определяет количество оперативной памяти одной планки , а если у людей по 2 , а то и по 3 ? Это функция уже устарела . Плюс удобнее выводить не в МБ, а в ГБ.
Вообщем написал свою

Код:

function GlobalMemoryStatusEx(lpBuffer: PMEMORYSTATUSEX): Boolean; stdcall; external kernel32;
function MemorySizeX: string;
var
MemoryStatus: MEMORYSTATUSEX;
begin
MemoryStatus.dwLength := SizeOf(MEMORYSTATUSEX) ;
GlobalMemoryStatusEx(@MemoryStatus) ;
with MemoryStatus do begin
begin
Result := Format('%0.0f', [ullTotalPhys div 1024 / 1024 / 1024]) + ' GB';
end;
end;
end;

Delphi [руководство] Привязка К Железу С Проверкой Через Сервер

Lomanu4

Sascha

Заместитель Администратора

Lomanu4

Sascha

Заместитель Администратора

Mazahaka_lab