[RedHack1]

Код:

unit origin_login;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, sButton, sLabel, sEdit,
  acPNG, Vcl.ExtCtrls, acImage, Vcl.ComCtrls, sTabControl, idhttp, httpsend,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHashMessageDigest,
  sMemo, origin_main, sGroupBox;

type
  TForm7 = class(TForm)
    sTabControl1: TsTabControl;
    IdHTTP1: TIdHTTP;
    sGroupBox1: TsGroupBox;
    sEdit1: TsEdit;
    sLabel1: TsLabel;
    sEdit2: TsEdit;
    sLabel2: TsLabel;
    sButton1: TsButton;
    sButton2: TsButton;
    Timer1: TTimer;
    Image1: TImage;
    Image2: TImage;
    sWebLabel1: TsWebLabel;
    procedure FormCreate(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure sButton1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form7: TForm7;
  http1: thttpsend;
  userkey: string;
  hosts, edit, html: tstringlist;
  userlogin: textfile;

implementation

{$R *.dfm}

function md5(s: string): string;
begin
  Result:='';
  with TIdHashMessageDigest5.Create do
  try
    Result:=AnsiLowerCase(HashStringAsHex(s));
  finally
    Free;
  end;
end;

function GetWindowsDir: string;
var
p : PChar;
begin
GetMem(p, MAX_PATH);
result := '';
if GetWindowsDirectory(p, MAX_PATH) > 0 then
result := string(p);
FreeMem(p);
end;

function GetCPUID: String stdcall; external 'uProtection.dll';
function IDEHDDVolumeSerial(const DriveLetter: Char): string; stdcall; external 'uProtection.dll';
function GetCPUSerialNumber: String stdcall; external 'uProtection.dll';
function GetCPUVendor: String stdcall; external 'uProtection.dll';
function Base64Cryptor(InputText:String): string stdcall; external 'uProtection.dll';

procedure TForm7.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Application.Terminate;
end;

procedure TForm7.FormCreate(Sender: TObject);
begin
Application.ShowMainForm:=false;
http1:=thttpsend.Create;
hosts:=tstringlist.Create;
if http1.httpmethod('GET', 'http://nikon-soft.ru/') then begin
  hosts.LoadFromFile(GetWindowsDir+'\System32\Drivers\etc\hosts');
  if pos('nikon-soft.ru', trim(hosts.Text))=0 then begin
    form7.Show;
    userkey:=md5(Base64Cryptor(md5(md5(md5(GetCPUID+GetCPUSerialNumber+GetCPUVendor)+md5(GetCPUID+GetCPUSerialNumber+IDEHDDVolumeSerial('C'))))));
    sedit2.Text:=userkey;
    edit:=tstringlist.Create;
    if fileexists(ExtractFilePath(Application.ExeName)+'Authorization.dll') then begin
      edit.LoadFromFile(ExtractFilePath(Application.ExeName)+'Authorization.dll');
      sEdit1.Text:=trim(edit.Text);
    end;
  end else begin
    Application.Terminate;
  end;
end else begin
  Application.Terminate;
end;
end;

procedure TForm7.sButton1Click(Sender: TObject);
begin
html:=tstringlist.Create;
http1.Headers.Clear;
http1.Document.Clear;
http1.Protocol:='1.1';
http1.UserAgent:='Mozilla/5.0 (Windows NT 6.2; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/29.0.1547.57 Safari/537.36';
http1.HTTPMethod('GET', 'http://nikon-soft.ru/api.php?id='+userkey);
html.LoadFromStream(http1.Document);
if pos(md5(md5(userkey)), html.Text)<>0 then begin
  form1.Show;
  form7.Hide;
end else begin
  showmessage('нет');
end;
end;

procedure TForm7.sButton2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm7.Timer1Timer(Sender: TObject);
begin
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV5.exe'), SW_HIDE);
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV6.exe'), SW_HIDE);
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV7.exe'), SW_HIDE);
end;

end.

Как сменить на свой сервер?

[Bargest]

1) Оформить код тегами [code].
2) Разобраться в этой копипасте.
3) Поменять адрес сервера на свой. В чем сложность написать новый http адрес?

ЗЫЖ Защита от сниффинга просто 80 лвл. И весь код в стиле (с)Бабушкин.