首页 > > 程序设计 > delphi >

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

2018-06-17 18:58:18来源：未知 阅读 ()

新老客户大回馈,云服务器低至5折

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.

 

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有

上一篇：根据一个分类id 获取这个分类底下所有子分类的商品信息，根据下

下一篇：Inno Setup 检测已安装的.NET Framework 版本

相关文章

IDC资讯： 主机资讯 注册资讯 托管资讯 vps资讯 网站建设

网站运营： 建站经验 策划盈利 搜索优化 网站推广 免费资源

网站联盟： 联盟新闻 联盟介绍 联盟点评 网赚技巧

行业资讯： 搜索引擎 网络游戏 电子商务 广告传媒

网络编程： Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它

服务器技术： Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护

软件技巧： 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷

网页制作： FrontPages Dreamweaver Javascript css photoshop fireworks Flash

程序设计： Java技术 C/C++ VB delphi

网络知识： 网络协议 网络安全 网络管理 组网方案 Cisco技术

操作系统： Win2000 WinXP Win2003 Mac OS Linux FreeBSD

热门词条
最新资讯
热门关注
热门标签