delphi7 写的一个验证btcdice网站结果的程序

mark 下：

主要实现的功能有：

  Sha256算法 / hmac_sha512算法 (上网搜索了2天才搞定，资料太少)
 包含Listview 相关用法

1. Main window

2. 运行结果

 

unit Main_unit;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FlatUtils, FlatCtrls, StdCtrls, StrUtils, PerlRegEx,
  DCPrijndael, Dcpsha256, flchash, ComCtrls;
type
  TmainForm = class(TForm)
    informationGroup: TFlatGroupBox;
    informationMemo: TFlatMemo;
    serverSeedEdit: TFlatEdit;
    serverSeedHashEdit: TFlatEdit;
    clientSeedEdit: TFlatEdit;
    betIDEdit: TFlatEdit;
    betRangeEdit: TFlatEdit;
    queryButton: TFlatButton;
    calculateButton: TFlatButton;
    donateButton: TFlatButton;
    copyBTCButton: TFlatButton;
    copyLTCButton: TFlatButton;
    copyDOGEButton: TFlatButton;
    FlatListView1: TFlatListView;
    procedure donateButtonClick(Sender: TObject);
    procedure serverSeedEditClick(Sender: TObject);
    procedure serverSeedHashEditClick(Sender: TObject);
    procedure clientSeedEditClick(Sender: TObject);
    procedure queryButtonClick(Sender: TObject);
    procedure copyDOGEButtonClick(Sender: TObject);
    procedure copyLTCButtonClick(Sender: TObject);
    procedure copyBTCButtonClick(Sender: TObject);
    procedure calculateButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure betIDEditKeyPress(Sender: TObject; var Key: Char);
    procedure betRangeEditKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  mainForm: TmainForm;
  openCopyButton: String;
  readyToCalculate: String;
implementation
{
ChangeLog : 2016/7/4 1:11:37   v1.3.8
1. flatlistview 倒叙排列
2. 关闭 serverseed , serverSeedHash, clientSeed 设置为只读
3. 限制 betID , betRange 只能输入数字
4. 计算 按钮默认 disable, serverseed验证成功方可开启
5. 计算开始前 需要检测betID , betRange 大小关系 
}
// Function to get HashSha256
function getHashSha256Value(str:string):ansiString;
    var
        Hash  : TDCP_sha256;
        Digest: array[0..64] of byte;
        i: integer;
        s: ansiString;
    begin
        s:= '';
        hash  := TDCP_sha256.Create(nil);
        if hash<>nil then
        begin
            try
                Hash.Init;                 // initialize it
                Hash.UpdateStr(str);       // hash the stream contents
                Hash.Final(Digest);        // produce the digest
                for i:= 0 to length(Digest)-1 do
                    s:= s + IntToHex(Digest[i],2);
            finally
                hash.free;
        end;
    end;
        result  :=  LowerCase(MidStr(s, 1, 64));
end;
{$R *.dfm}
procedure TmainForm.donateButtonClick(Sender: TObject);
begin
    calculateButton.Enabled := False;
    serverSeedEdit.Left:=38;
    serverSeedEdit.Width:=300;
    serverSeedEdit.Ticket.Caption:='BTC:';
    serverSeedEdit.ticket.Font.Name:='微软雅黑';
    serverSeedHashEdit.Left:=38;
    serverSeedHashEdit.Width:=300;
    serverSeedHashEdit.Ticket.Caption:='LTC:';
    serverSeedHashEdit.ticket.Font.Name:='微软雅黑';
    clientSeedEdit.Left:=38;
    clientSeedEdit.Width:=300;
    clientSeedEdit.Ticket.Caption:='Doge:';
    clientSeedEdit.ticket.Font.Name:='微软雅黑';
    serverSeedEdit.Text:='166W2zr9WoUx2dPB9bXXLNVHEahYBCy5uq';
    serverSeedEdit.ReadOnly:=True;
    serverSeedHashEdit.Text:='LR4Qm8Cc2jKRdV4MZCpXtrAE8SZ2dXuj1o';
    serverSeedHashEdit.ReadOnly:=True;
    clientSeedEdit.Text:='DU5zf68E7x4YtMayUaX91z6dQDouS2u5ae';
    clientSeedEdit.ReadOnly:=True;
    openCopyButton:='Yes';
end;
procedure TmainForm.serverSeedEditClick(Sender: TObject);
begin
  if openCopyButton ='Yes' then
    begin
      copyBTCButton.Visible:=True;
      copyLTCButton.Visible:=False;
      copyDOGEButton.Visible:=False;
    end;
end;
procedure TmainForm.serverSeedHashEditClick(Sender: TObject);
begin
  if openCopyButton ='Yes' then
    begin
      copyBTCButton.Visible:=False;
      copyLTCButton.Visible:=True;
      copyDOGEButton.Visible:=False;
    end;
end;
procedure TmainForm.clientSeedEditClick(Sender: TObject);
begin
  if openCopyButton ='Yes' then
    begin
      copyBTCButton.Visible:=False;
      copyLTCButton.Visible:=False;
      copyDOGEButton.Visible:=True;
    end;
end;
procedure TmainForm.queryButtonClick(Sender: TObject);
var
    List: TStrings;
    reg: TPerlRegEx;
    num: Integer;
begin
    serverSeedEdit.Left:=8;
    serverSeedEdit.Width:=435;
    serverSeedEdit.Ticket.Caption:='';
    serverSeedHashEdit.Left:=8;
    serverSeedHashEdit.Width:=435;
    serverSeedHashEdit.Ticket.Caption:='';
    clientSeedEdit.Left:=8;
    clientSeedEdit.Width:=435;
    clientSeedEdit.Ticket.Caption:='';
    serverSeedEdit.Clear;
    serverSeedHashEdit.Clear;
    clientSeedEdit.Clear;
    betIDEdit.Clear;
    betRangeEdit.Clear;
  List := TStringList.Create;
  reg := TPerlRegEx.Create;
  reg.Subject := informationMemo.Text;
  reg.RegEx   := '" "';{分割}
  num:=0;
  while reg.MatchAgain do
    begin
      Inc(num);
    end;
  reg.Split(List,MaxInt);
  if num = 3 then
    begin
        if getHashSha256Value(MidStr(List.Strings[0],2,64)) = List.Strings[1] then
          begin
            ShowMessage('服务器种子验证成功');
            calculateButton.Enabled:= True;
            ReadyToCalculate := 'Yes';
            serverSeedEdit.Text := MidStr(List.Strings[0],2,64);
            serverSeedHashEdit.Text := List.Strings[1];
            clientSeedEdit.Text := List.Strings[2];
            betIDEdit.Text := LeftStr(List.Strings[3], (Length(List.Strings[3]) - 1));
            betRangeEdit.Text := InttoStr(StrToIntDef(betIDEdit.Text, 0) + 10);
            FreeAndNil(reg);
            List.Free;
          end
        else
          begin
            MessageBox(MainForm.Handle,'服务器种子验证失败,Hash不匹配','BD提醒您',MB_ICONWARNING+MB_OK);
            { Reset }
            serverSeedEdit.Clear;
            serverSeedHashEdit.Clear;
            clientSeedEdit.Clear;
            betIDEdit.Clear;
            betRangeEdit.Clear;
            informationMemo.Clear;
            informationMemo.SetFocus;
            calculateButton.Enabled := False;
          end;
    end
  else
    begin
        MessageBox(MainForm.Handle,'复制的信息有误,格式不正确','BD提醒您',MB_ICONWARNING+MB_OK);
        informationMemo.Clear;
        informationMemo.SetFocus;
        calculateButton.Enabled := False;
    end;
end;
procedure TmainForm.copyDOGEButtonClick(Sender: TObject);
begin
  clientSeedEdit.SelectAll;
  clientSeedEdit.CopyToClipboard;
  ShowMessage('已经成功复制Doge【狗狗】地址，谢谢支持');
  begin
    serverSeedEdit.Left:=8;
    serverSeedEdit.Width:=435;
    serverSeedEdit.Ticket.Caption:='';
    serverSeedHashEdit.Left:=8;
    serverSeedHashEdit.Width:=435;
    serverSeedHashEdit.Ticket.Caption:='';
    clientSeedEdit.Left:=8;
    clientSeedEdit.Width:=435;
    clientSeedEdit.Ticket.Caption:='';
    serverSeedEdit.Clear;
    serverSeedHashEdit.Clear;
    clientSeedEdit.Clear;
    betIDEdit.Clear;
    betRangeEdit.Clear;
    informationMemo.Clear;
    informationMemo.SetFocus;
    calculateButton.Enabled := False;
    openCopyButton:='No';
    copyDOGEButton.Visible:=False;
  end;
end;
procedure TmainForm.copyLTCButtonClick(Sender: TObject);
begin
  serverSeedHashEdit.SelectAll;
  serverSeedHashEdit.CopyToClipboard;
  ShowMessage('已经成功复制LTC【辣条】地址，谢谢支持');
  begin
    serverSeedEdit.Left:=8;
    serverSeedEdit.Width:=435;
    serverSeedEdit.Ticket.Caption:='';
    serverSeedHashEdit.Left:=8;
    serverSeedHashEdit.Width:=435;
    serverSeedHashEdit.Ticket.Caption:='';
    clientSeedEdit.Left:=8;
    clientSeedEdit.Width:=435;
    clientSeedEdit.Ticket.Caption:='';
    serverSeedEdit.Clear;
    serverSeedHashEdit.Clear;
    clientSeedEdit.Clear;
    betIDEdit.Clear;
    betRangeEdit.Clear;
    informationMemo.Clear;
    informationMemo.SetFocus;
    openCopyButton:='No';
    calculateButton.Enabled := False;
    copyLTCButton.Visible:=False;
  end;
end;
procedure TmainForm.copyBTCButtonClick(Sender: TObject);
begin
  serverSeedEdit.SelectAll;
  serverSeedEdit.CopyToClipboard;
  ShowMessage('已经成功复制BTC【比特币】地址，谢谢支持');
  begin
    serverSeedEdit.Left:=8;
    serverSeedEdit.Width:=435;
    serverSeedEdit.Ticket.Caption:='';
    serverSeedHashEdit.Left:=8;
    serverSeedHashEdit.Width:=435;
    serverSeedHashEdit.Ticket.Caption:='';
    clientSeedEdit.Left:=8;
    clientSeedEdit.Width:=435;
    clientSeedEdit.Ticket.Caption:='';
    serverSeedEdit.Clear;
    serverSeedHashEdit.Clear;
    clientSeedEdit.Clear;
    betIDEdit.Clear;
    betRangeEdit.Clear;
    informationMemo.Clear;
    informationMemo.SetFocus;
    openCopyButton:='No';
    calculateButton.Enabled := False;
    copyBTCButton.Visible:=False;
  end;
end;
procedure TmainForm.calculateButtonClick(Sender: TObject);
var
    hmacSha512Value: String;
    hmacHashKey: String;
    betStart : Integer;
    listitem: TlistItem;
    serverSeedI,rollStart : Integer;
    serverSeedRollDefault: String;
    serverSeedRoll : Double;
begin
if StrToInt(betIDEdit.Text) < StrToInt(betRangeEdit.Text) then
begin
  flatlistview1.Clear;
  flatlistview1.Items.Clear;
  flatlistview1.Columns.Clear;
  flatlistview1.Columns.add;
  flatlistview1.Columns.add;
  flatlistview1.Columns.Items[1].Width:=65;
  flatlistview1.Columns.Items[0].Caption:='BetID';
  flatlistview1.Columns.Items[1].Caption:='Result';
  flatlistview1.ViewStyle:=vsreport;
  flatlistview1.GridLines:=True;
for betStart:=StrToInt(betRangeEdit.Text) downto StrToInt(betIDEdit.Text) do
begin
    hmacHashKey := clientSeedEdit.Text + ':' + IntToStr(betStart);
    hmacSha512Value := SHA512DigestToHexA(CalcHMAC_SHA512(serverSeedEdit.Text,hmacHashKey));
    serverSeedI := 0;
    serverSeedRoll := -1;
    while (serverSeedRoll = -1) do
        if serverSeedI = 25 then
        begin
            serverSeedRollDefault := IntToStr( StrToInt('$'+copy(hmacSha512Value,126,3)));
            serverSeedRoll := StrToInt(serverSeedRollDefault) / 10000;
        end  // End for if
        else
        begin
            if serverSeedI >= 1 then
                rollStart := 5 * serverSeedI + 1
            else
                rollStart := 5 * serverSeedI;
            serverSeedRollDefault := IntToStr( StrToInt('$'+copy(hmacSha512Value,rollStart,5)));
            if StrToInt(serverSeedRollDefault) < 1000000 then
                serverSeedRoll :=  StrToInt(serverSeedRollDefault) / 10000;
            serverSeedI := serverSeedI + 1;
        end; //end if - else
    with flatListView1 do
    begin
        ListItem:=Items.Add;
        ListItem.Caption:= IntToStr(BetStart);
        ListItem.SubItems.Add(FloatToStr(serverSeedRoll));
    end; // End for with
end; // End for
    calculateButton.Enabled := False;
end
else
begin
  MessageBox(MainForm.Handle,'投注期数需大于初始值','BD提醒您',MB_ICONWARNING+MB_OK);
  betRangeEdit.Clear;
  betRangeEdit.SetFocus;
end;
end; // End procedure
procedure TmainForm.FormCreate(Sender: TObject);
begin
  MessageBox(MainForm.Handle,'此工具用于验证BD投注的公平性,点击账户-换手气,然后复制信息到主界面点击验证即可。注意如有出入请到网站公平下面的第三方验证加以佐证,若觉得好用请打赏一点,谢谢支持!祝旗开得胜,逢赌必赢','',MB_ICONINFORMATION+MB_OK);
  calculateButton.Enabled := False;
end;
procedure TmainForm.betIDEditKeyPress(Sender: TObject; var Key: Char);
begin
  If not (key in [#48..#57,#8]) then
    begin
      showmessage('只能输入数字!');
      key:= #0;
    end;
end;
procedure TmainForm.betRangeEditKeyPress(Sender: TObject; var Key: Char);
begin
  If not (key in [#48..#57,#8]) then
    begin
      showmessage('只能输入数字!');
      key:= #0;
    end;
end;
end.