regware2.~pas

某计算机系本科学生做的加密设计及实现

unit Regware2;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
  Forms, Graphics, Registry, ComObj, Dialogs;

type
  TRegInfo = record
    License, Organization, RegCode, Exp1: string[100];
    RegVersion: string[10];
    LastCountDown, Exp2, Exp3: integer;
    ExpireTime, Exp4: TDateTime;
  end;

  TRegwareII = class(TComponent)
  private
      { 注册类TRegwareII 的私有字段}
    FCheckTamper: boolean;
    FDays: Integer;
    FLastCountDown: integer;
    FExpireTime: TDateTime;
    FLicense: string;
    FMaxChars: integer;
    FMinChars: integer;
    FOrganization: string;
    FProgGUID: string;
    FRegCode: string;
    FRegCodeSize: integer;
    FSeed: Int64;
    FTimebomb: Boolean;
    FOnClockChange: TNotifyEvent;
    FOnExpire: TNotifyEvent;
    FOnNagScreen: TNotifyEvent;
    FRegVersion: string;
    FAuthCode: string;

      { 私有事件 TRegwareII }
      {创建事件及属性值 }
    procedure AutoInitialize;
        {释放由AutoInitialize创建的事件及属性 }
    procedure AutoDestroy;
    function GetDaysLeft: Integer;
    function GetRegistered: Boolean;
        { Checks if user set clock backwards }
    function CheckClockTampered: boolean;
    function GetExpired: boolean;
    procedure CheckVariablesSet;
    procedure LoadRegistryValues;
    procedure SaveRegistryValues;
    procedure SetMaxChars(MaxChars: integer);
    procedure SetMinChars(MinChars: integer);
    procedure SetSeed(Seed: Int64);


  protected
    procedure Expire; virtual;
    procedure ShowNag; virtual;
    procedure Loaded; override;
    procedure ClockChange; virtual;

  public
    { 由注册名称来计算注册码. }
    function CalculateCode(LicenseName: string): string;
    //用来计算注册码的，注册机使用！！！
    function CalculateCodeEx(LicenseName: string; sAuthCode: string): string;
    function CheckExpired: boolean;
    function CheckRegistered: boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function DoRegistration(LicenseName, Organization, RegCode: string): boolean;
    function GetIdeDiskSerialNumber: string; //获取硬盘序列号
    function GetIdeDiskSerialNumberEx: string; //获取硬盘序列号的运算后代码
    procedure SetUnregistered;
    property DaysLeft: Integer read GetDaysLeft;
    property Expired: boolean read GetExpired;
    property License: string read FLicense;
    property Organization: string read FOrganization;
    property RegCode: string read FRegCode;
    property Registered: Boolean read GetRegistered;

  published
    property OnClockChange: TNotifyEvent read FOnClockChange write FOnClockChange;
    property OnExpire: TNotifyEvent read FOnExpire write FOnExpire;
    property OnNagScreen: TNotifyEvent read FOnNagScreen write FOnNagScreen;
    property CheckTamper: boolean read FCheckTamper write FCheckTamper default true;
    property Days: Integer read FDays write FDays default 30;
    property MaxChars: integer read FMaxChars write SetMaxChars default 25;
    property MinChars: integer read FMinChars write SetMinChars default 3;
    property ProgGUID: string read FProgGUID write FProgGUID;
    property Seed: Int64 read FSeed write SetSeed default 0;
    property RegCodeSize: integer read FRegCodeSize write FRegCodeSize default 12;
    property Timebomb: Boolean read FTimebomb write FTimebomb default True;
    //如果硬盘序列号为空，则AuthCode为一固定值
    property AuthCode: string read FAuthCode write FAuthCode;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('SoftReg控件', [TRegwareII]);
end;

{ 检查是否为一个 GUID 字符串 }

function ValidateGUID(GUIDStr: string): boolean;
  { 检查是否为16进制字符}
  function IsHex(AlphaNumChar: char): boolean;
  begin
    if ((Ord(AlphaNumChar) >= 48) and (Ord(AlphaNumChar) <= 57)) or
      ((Ord(AlphaNumChar) >= 65) and (Ord(AlphaNumChar) <= 70)) then
      Result := true
    else
      Result := false;
  end;

var
  i: integer;
begin
  Result := false;
  if Length(GUIDStr) <> 38 then Exit; // 非合法长度
  for i := 1 to Length(GUIDStr) do
  begin
    if (i <> 1) and (i <> 10) and (i <> 15) and (i <> 20) and (i <> 25) and (i <> 38) then
    begin
      if not IsHex(GUIDStr[i]) then Exit;
    end else
      if (i = 1) and (GUIDStr[i] <> '{') then Exit
      else if (i = 38) and (GUIDStr[i] <> '}') then Exit
      else if (i = 10) or (i = 15) or (i = 20) or (i = 25) then
        if (GUIDStr[i] <> '-') then Exit;
  end;
  Result := true;
end;

{------------------ TRegwareII 事件 ------------------}


procedure TRegwareII.AutoInitialize;
begin
  FCheckTamper := true;
  FDays := 30;
  FMaxChars := 25;
  FMinChars := 3;
  FTimebomb := True;
end;


procedure TRegwareII.AutoDestroy;
begin
end;

function TRegwareII.GetDaysLeft: Integer;
begin
  if CheckClockTampered then // User tampered with clock
    Result := 0
  else if (not Registered) and (Timebomb = true) then
  begin
    Result := Trunc(FExpireTime - Date);
    if Result < 0 then Result := 0;
  end
  else
    Result := -1;
end;

function TRegwareII.GetRegistered: Boolean;
begin
  Result := CheckRegistered;
end;

function TRegwareII.CalculateCode(LicenseName: string): string;
var
  i: integer;
  SumChar: Int64;
  HDSN, HDSN1, HDSN2: string;
  LocalLicenseName: string;
begin
////////////////////
//将获取的硬盘序列号代码加入到注册码中
  HDSN := Trim(GetIdeDiskSerialNumberEx);
  if HDSN = '' then
    LocalLicenseName := LicenseName
  else
  begin //HDSN分为２部分，一部分加到前面，剩下的加到后面
    i := Length(HDSN);
    HDSN1 := Copy(HDSN, 1, (i div 2));
    HDSN2 := Copy(HDSN, (i div 2) + 1, i - (i div 2));
    LocalLicenseName := HDSN1 + LicenseName + HDSN2;
  end;
  SumChar := 0;
  if (Length(LicenseName) > FMaxChars) or (Length(LicenseName) < FMinChars) then
  begin
    Result := ''; // LicenseName did not fit length requirements
    Exit;
  end;
  i := Length(LocalLicenseName);
  //取所有的字符
  while (i <= Length(LocalLicenseName)) and (i > 0) do
  begin
    SumChar := SumChar + FSeed - 1113 mod Ord(LocalLicenseName[i]);
    Dec(i);
  end;
  if FRegCodeSize <= 0 then
    Result := IntToHex(SumChar, 0)
  else
  begin
    Result := IntToHex(SumChar, FRegCodeSize);
    Delete(Result, FRegCodeSize + 1, Length(Result) - FRegCodeSize); //将多余FRegCodeSize后面的部分去掉
  end;
end;


function TRegwareII.CheckExpired: boolean;
begin
  if GetDaysLeft = 0 then Result := true else Result := false;
end;


function TRegwareII.CheckRegistered: boolean;
begin
  if (FRegCode <> '') and (FLicense <> '') then
  begin
    if CompareStr(FRegCode, CalculateCode(FLicense)) = 0 then
    begin
      Result := true;
    end else
    begin
      Result := false;
      FRegCode := '';
      FLicense := '';
      FOrganization := '';
    end;
  end else Result := false; // Values not there... program not registered
end;

procedure TRegwareII.SetMaxChars(MaxChars: integer);
begin
  if (MaxChars > 100) or (MaxChars < MinChars) then
    raise Exception.Create('Please enter a number between ' +
      IntToStr(FMinChars) + ' and 100')
  else
    FMaxChars := MaxChars;
end;

constructor TRegwareII.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if Trim(GetIdeDiskSerialNumber) = '' then
    FAuthCode := 'IHZPGLY99'
  else
    FAuthCode := Trim(GetIdeDiskSerialNumber);
  AutoInitialize;
  FRegCodeSize := 12;
end;

destructor TRegwareII.Destroy;
begin
  SaveRegistryValues;
  AutoDestroy;
  inherited Destroy;
end;

function TRegwareII.DoRegistration(LicenseName, Organization, RegCode: string): boolean;
begin
  if (Length(LicenseName) > FMaxChars) or (Length(LicenseName) < FMinChars) or (Length(RegCode) = 0) then
  begin
    Result := false;
    Exit;
  end;
  RegCode := UpperCase(RegCode);
  if CompareStr(CalculateCode(LicenseName), RegCode) <> 0 then Result := false
  else begin
    FLicense := LicenseName;
    FOrganization := Organization;
    FRegCode := RegCode;
    SaveRegistryValues;
    Result := true;
  end;
end;

procedure TRegwareII.SetUnregistered;
begin
  FLicense := '';
  FOrganization := '';
  FRegCode := '';
  if Timebomb then
  begin
    FExpireTime := Now + FDays;
    FLastCountDown := FDays;
  end else
  begin
    FExpireTime := 0;
    FLastCountDown := FDays;
  end;
  SaveRegistryValues;
end;

procedure TRegwareII.Expire;
begin
  if Assigned(FOnExpire) then FOnExpire(Self);
end;

procedure TRegwareII.ShowNag;
begin
  if Assigned(FOnNagScreen) then FOnNagScreen(Self);
end;

procedure TRegwareII.Loaded;
begin
  inherited;
  if Trim(GetIdeDiskSerialNumber) = '' then
    FAuthCode := 'IHZPGLY99'
  else
    FAuthCode := Trim(GetIdeDiskSerialNumber);

  CheckVariablesSet;
  LoadRegistryValues;
  if (not Registered) and (FExpireTime = 0) then
    SetUnregistered
  else if CheckClockTampered then
    ClockChange
  else if not Registered then
  begin
    ShowNag;
    if CheckExpired = true then
      Expire;
  end;
end;

procedure TRegwareII.ClockChange;
begin
  if Assigned(FOnClockChange) then FOnClockChange(Self);
end;

function TRegwareII.CheckClockTampered: boolean;
var
  DateDifference: integer;
begin
  Result := false;
  if FCheckTamper = true then
  begin
    DateDifference := Trunc(FExpireTime - Date);
    if DateDifference > FLastCountDown then