unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TFrmMain = class(TForm)
    edtComputerCode: TEdit;
    edtUserName: TEdit;
    edtRegisterCode: TEdit;
    btnTestCode: TButton;
    btnGetCode: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnTestCodeClick(Sender: TObject);
    procedure btnGetCodeClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

uses DiskSerialNumber;

{$R *.dfm}
function GetStandardStr(sStr: string): string;
var
  i: Integer;
  s1: string;
begin
  Result := '';
  s1 := '';
  if Trim(sStr) = '' then   Exit;
  for i := 1 to Length(sStr) do
    begin
      s1 := Copy(sStr, i, 1);
      if pos(lowercase(s1),'0123456789abcdefghijklmnopqrstuvwxyz~!@#$%^&*()[]{}-+')<>0 then
{      if ((s1 >= '0') and (s1 <= '9')) or ((s1 >= 'a') and (s1 <= 'z')) or ((s1 >=
        'A') and (s1 <= 'Z')) or (pos(s1,'~!@#$%^&*()[].')<>0) then}
        Result := Result + s1;
    end;
  Result := Trim(Result);
end;

{*標(biāo)題:字符串加密;pascal字符表示
  說(shuō)明:應(yīng)用于文件加密*}

function StringToDisplay(mString: string): string;
var
  I: Integer;
  S: string;
begin
  Result := '';
  S := '';
  for I := 1 to Length(mString) do
    if mString[I] in [#32..#127] then
      S := S + mString[I]
    else
    begin
      if S <> '' then
      begin
        Result := Result + QuotedStr(S);
        S := '';
      end;
      Result := Result + Format('#$%x', [Ord(mString[I])]);
    end;
  if S <> '' then
    Result := Result + QuotedStr(S);
end; { StringToDisplay }

function StringEncrypt(mStr: string; mKey: string): string;
var
  I, J: Integer;
  tStr:string;
begin
  J := 1;
  Result := '';
  for i:=1 to Length(mStr) do
    tStr:=tStr+Copy(mStr,I*2,1);
  mStr:=mStr+tstr;
  for I := 1 to Length(mStr) do
  begin
    Result := Result + Char(Ord(mStr[I]) xor Ord(mKey[J]));
    if J + 1 <= Length(mKey) then
      Inc(J)
    else
      J := 1;
  end;
  for I := 1 to Length(mStr) do
  begin
    Result :=  Char(Ord(mStr[I]) or Ord(mKey[J]))+Result;
    if J + 1 <= Length(mKey) then
      Inc(J)
    else
      J := 1;
  end;
  { 自己加步驟 }
  Result := StringToDisplay(Result);
end; { StringEncrypt }
function GetIDESerial: string;
begin
  Result := GetIdeDiskSerialNumber;
end;
function GetDiskSerial(sDisk: string): string;
var
  dwNum, dwTmp: dword;
begin
  Result := '';
  if GetVolumeInformation(PChar(sDisk + '\'), nil, 0, Addr(dwNum), dwTmp, dwTmp,
    nil, 0) then
    Result := IntToStr(dwNum);
end;

function MakeComputerCode: string;
begin
  Result := Trim(GetIDESerial) + Trim(GetDiskSerial('C:'));
  Result := Result + IntToStr(1);
  Result := Result + IntToStr(1);
  Result := GetStandardStr(Result);
end;

function MakeRegisterCode(sName, sPcCode: string): string;
var
  s1, s2: string;
  i: Integer;
begin
  s2 := '';
  s1 := StringEncrypt(Trim(sPcCode) + Trim(sName)+'29T.cOm', #13#1#20#5#2);
  s1 := GetStandardStr(s1);
  if Length(s1)<10 then S1:=S1+sPcCode;
  if Length(s1)>10 then S1:=Copy(s1,1,10);
  for i := 1 to Length(s1) do
    begin
      s2 := s2 + Copy(s1, i, 1);
      //if i mod 5 = 0 then   s2 := s2 + '-';
    end;
  if Copy(s2, Length(s2), 1) = '-' then    s2 := Copy(s2, 1, Length(s2) - 1);
  Result := s2;
end;
function GetPCName: string;
var
  CNameBuffer: PChar;
  fl_loaded: Boolean;
  CLen: ^DWord;
begin
  GetMem(CNameBuffer, 255);
  New(CLen);
  CLen^ := 255;
  fl_loaded := GetComputerName(CNameBuffer, CLen^);
  if fl_loaded then
    Result := StrPas(CNameBuffer)
  else
    Result := '';
  FreeMem(CNameBuffer, 255);
  Dispose(CLen);
  Result := Trim(Result);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
  sName, sCode: string;
begin
  edtComputerCode.ReadOnly := True;
  sName := '';
  sCode := '';
  edtComputerCode.Text := MakeComputerCode;
  edtUserName.Text := sName;
  edtRegisterCode.Text := sCode;
  if edtUserName.Text = '' then
    edtUserName.Text := GetPCName;
end;

procedure TFrmMain.btnTestCodeClick(Sender: TObject);
var
  sSn: string;
begin
  inherited;
  sSn := MakeRegisterCode(edtUserName.Text, edtComputerCode.Text);
  if (Trim(sSn) = Trim(edtRegisterCode.Text)) or (Trim(edtRegisterCode.Text) = 'asdf') then
  begin
    ShowMessage('注冊(cè)碼正確');
  end
  else
    ShowMessage('注冊(cè)碼不正確');
end;

procedure TFrmMain.btnGetCodeClick(Sender: TObject);
begin
edtRegisterCode.text:=MakeRegisterCode(edtUserName.Text, edtComputerCode.Text);
end;

end.