unit1.~pas

用Delphi编写的算号器的生成程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzButton, RzBorder, StdCtrls, RzLabel, Mask, RzEdit;

const letter = 'AKFGCDHIWZ';
const AllLetter = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';

type
  TForm1 = class(TForm)
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzBorder1: TRzBorder;
    RzLabel2: TRzLabel;
    RzEdit2: TRzEdit;
    RzLabel1: TRzLabel;
    RzEdit1: TRzEdit;
    procedure RzBitBtn2Click(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    function GetSerialNumber:Int64;
    function Encrypt(s :Int64):string;

    function buildSerialNumber(SerialNumber :Int64):String;
    function FormatSN(SN :string):string;
    function buildRegNumber(SerialNumber :Int64):String;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function TForm1.FormatSN(SN :string):string;
var
  i,l :integer;
  sub :string;
  FormatSN :string;
begin
  l := length(SN);
  FormatSN := '';
  for i :=1 to 25 do
  begin
    if (i mod 2 = 0) and (i <= 2 * l) then
      sub := copy(SN,i div 2,1)
    else
      sub := copy(AllLetter,Random(25),1);
    if (i mod 5 = 0) and (i <> 25) then
      sub := sub + '-';
    FormatSN := FormatSN + sub;
  end;

  Result := FormatSN;
end;

function TForm1.buildRegNumber(SerialNumber :Int64):String;
var
  i :integer;
begin

end;

function TForm1.buildSerialNumber(SerialNumber :Int64):String;
var
  i :integer;
  oldSN :String;
  newSN :String;
  c :string;
begin
  oldSN := IntToStr(SerialNumber);
  newSN := '';
  for i := 1 to length(oldSN) do
  begin
    c := Copy(oldSN,i,1);
    newSN := newSN + Encrypt(StrToInt(c)+1);
  end;

  newSN := FormatSN(newSN);
  Result := newSN;
end;

function TForm1.Encrypt(s :Int64):string; //inttostr
begin
  Result := copy(letter,s,1);
end;

function TForm1.GetSerialNumber:Int64;
var
  VolumeSerialNumber : DWORD;
  MaximumComponentLength : DWORD;
  FileSystemFlags : DWORD;
  SerialNumber : string;
begin
  GetVolumeInformation('C:\',
  nil,
  0,
  @VolumeSerialNumber,
  MaximumComponentLength,
  FileSystemFlags,
  nil,
  0);
  Result := VolumeSerialNumber;
end;

procedure TForm1.RzBitBtn2Click(Sender: TObject);
begin
  Self.Close;
end;

procedure TForm1.RzBitBtn1Click(Sender: TObject);
var
  HDSN :Int64;
  SN :String;
begin
  HDSN := GetSerialNumber;
  SN := buildSerialNumber(HDSN);
  RzEdit2.Text := SN;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RzEdit1.Text := floattostr(GetSerialNumber);
end;

end.