xqfilerw.pas

象棋演播室1.6的dephi源码 作者 董世伟

          '读取这个文件。请在Internet站点下载XQStudio的最新版本。',
          dCVersionInfo,
          MB_OK + MB_ICONWARNING + MB_DEFBUTTON1);
        iRet:=-3;
        Exit;
      end;

      dCalculateSecurityKeys;   // 将文件头中的密码因子计算为密码；

      with XQPlayTree do
      begin
        StepNo      := XQFHead.PlayStepNo;
        StrRec      := '==========';
        XYf         := 0;
        XYt         := 0;

        // 棋子位置循环移动
        for i:=1 to 32 do
        begin
          if (XQFHead.Version >= 12) then
          begin
            QiziXY[((i + KeyXY) mod 32) + 1] := XQFHead.QiziXY[i];
          end
          else
          begin
            QiziXY[i] := XQFHead.QiziXY[i];
          end;
        end;

        // 棋子位置解密
        for i:=1 to 32 do
        begin
          QiziXY[i]:= QiziXY[i] - KeyXY;
          if (QiziXY[i] > 89) then  QiziXY[i] := $FF;  // For 1.2 or higher
        end;

        LastStepNode:= nil;
        LParent     := nil;
        RParent     := nil;
        LChild      := nil;
        RChild      := nil;
      end;

      if (not OnlyHead) then
      begin
        fs.SetKeyBytes(
            (XQFHead.KeysSum and XQFHead.KeyMask) or XQFHead.KeyOrA,
            (XQFHead.KeyXY   and XQFHead.KeyMask) or XQFHead.KeyOrB,
            (XQFHead.KeyXYf  and XQFHead.KeyMask) or XQFHead.KeyOrC,
            (XQFHead.KeyXYt  and XQFHead.KeyMask) or XQFHead.KeyOrD);
        dInsertPNintoPlayTree(XQPlayTree);
      end;

      iRet := 0;
    except
    else
      iRet := -1;
    end;
   finally
     if (fs <> nil) then fs.Free;
     iLoadXQFile := iRet;
   end;
end;

//-------------------------------------------------------------------------
// 设置随机的加密因子
//.........................................................................
var
  isRandomize : Boolean = False;
procedure dTXQFile.dSetRandomSecurityKeys;
var
  b: dTByte;
begin
  b := 0;
  if (not isRandomize) then
  begin
    randomize;
    isRandomize := True;
  end;
  XQFHead.KeyXY   := Random(254) + 1;  b:= b + XQFHead.KeyXY;
  XQFHead.KeyXYf  := Random(254) + 1;  b:= b + XQFHead.KeyXYf;
  XQFHead.KeyXYt  := Random(254) + 1;  b:= b + XQFHead.KeyXYt;
  XQFHead.KeysSum := 256 - b;
end;

//-------------------------------------------------------------------------
// 计算真正的加密密码
//.........................................................................
procedure dTXQFile.dCalculateSecurityKeys;
var
  bKey : Byte;
  wKey : Word;
begin
  if XQFHead.Version <= 10 then         // 兼容1.0以前的版本
  begin
    KeyXY      := 0; 
    KeyXYf     := 0;
    KeyXYt     := 0;
    KeyRMKSize := 0;
    Exit;
  end;

  // 以下是密码计算公式
  bKey       := XQFHead.KeyXY;
  KeyXY      := (((((bKey*bKey)*3+9)*3+8)*2+1)*3+8) * bKey;
  bKey       := XQFHead.KeyXYf;
  KeyXYf     := (((((bKey*bKey)*3+9)*3+8)*2+1)*3+8) * KeyXY;
  bKey       := XQFHead.KeyXYt;
  KeyXYt     := (((((bKey*bKey)*3+9)*3+8)*2+1)*3+8) * KeyXYf;
  wKey       := (XQFHead.KeysSum) * 256 + XQFHead.KeyXY;
  KeyRMKSize := (wKey mod 32000) + 767;
end;

//-------------------------------------------------------------------------
// 检查密码的校验和为零否?
//.........................................................................
function  dTXQFile.isKeysSumZero: dTBoolean;
var
  b: dTByte;
begin
  with XQFHead do
  begin
    b := KeysSum + KeyXY + KeyXYf + KeyXYt;
  end;
  Result := (b=0);
end;


//-------------------------------------------------------------------------
// 保存象棋文件，请注意版本号
//.........................................................................
function dTXQFile.iSaveXQFile: dTINT32;
var
  fs        : dTXqfStream;                      // 文件流
  i, iRet   : dTInt32;
function bGetSaveXY(bXY: Byte): Byte;
var
  X, Y: Byte;
begin
  if Self.isReverseH then
  begin
    X := bXY div 10;
    Y := bXY mod 10;
    Result := (8 - X) * 10 + Y;
  end
  else
  begin
    Result := bXY;
  end;
end;
// 子程序：保存对弈树到XQF文件
procedure dSavePlayNodeIntoXQFile(fs:dTXqfStream; pt:dTXQPlayNode);
var
  pn     : dTXQFPlayNode;
  iBytes : dTInt32;
  b      : dTByte;
begin
  if (pt=nil) then Exit;                        // 没有棋局记录
  pn.RemarkSize := 0;

  // 加密棋谱
  pn.XYf        := bGetSaveXY(pt.XYf) + $18 + KeyXYf;
  pn.XYt        := bGetSaveXY(pt.XYt) + $20 + KeyXYt;

  if (pt.LastStepNode = nil) then               // 如果是第一步节点
  begin
    pn.XYf := Ord('X');
    pn.XYt := Ord('Q');
  end;

  pn.ChildTag   := 0;

  b := Random(256);  b := (b and $1F);          // 只有前三位有定义

  pn.ChildTag   := pn.ChildTag or b;

  pn.Reserved   := Random(256);

  // 设置左孩子
  if pt.LChild <> nil then pn.ChildTag := (pn.ChildTag or $80);

  // 设置右兄弟
  if pt.RChild <> nil then pn.ChildTag := (pn.ChildTag or $40);

  iBytes := 0;
  if (pt.Remark <> nil) then
  begin
    pn.RemarkSize := Length(pt.Remark.Text);
    iBytes := pn.RemarkSize;
  end;

  if isDisableRmk then iBytes := 0;

  if (iBytes > 0) then
  begin
    pn.ChildTag := (pn.ChildTag or $20);
    pn.RemarkSize := pn.RemarkSize + KeyRMKSize;
    fs.Write(pn, SizeOf(pn));
    fs.Write(PChar(pt.Remark.Text)^, iBytes);
  end
  else
  begin
    fs.Write(pn, (SizeOf(pn) - SizeOf(pn.RemarkSize)));
  end;

  dSavePlayNodeIntoXQFile(fs, pt.LChild);
  dSavePlayNodeIntoXQFile(fs, pt.RChild);
end;

begin
  iSaveXQFile := -1;
  iRet := -1;  fs := nil;
  if XQPlayTree = nil then Exit;
  try
    try
      XQFHead.Signature := $5158;               // 文件标记 'XQ' = $5158;
      XQFHead.Version   := dCFileVersion;       // 版本号
      Randomize;
      XQFHead.KeyMask   := Random(256) or $AA;
      XQFHead.KeyOrA    := Random(256);
      XQFHead.KeyOrB    := Random(256);
      XQFHead.KeyOrC    := Random(256);
      XQFHead.KeyOrD    := XQFHead.KeyOrA + XQFHead.KeyOrB + XQFHead.KeyOrC;
      XQFHead.KeyOrD    := 256 - XQFHead.KeyOrD;

      dSetRandomSecurityKeys;                   // 设置随机的加密因子
      dCalculateSecurityKeys;                   // 根据加密因子计算密码

      // 棋子位置循环偏移
      for i:=1 to 32 do
      begin
        XQFHead.QiziXY[i]:=XQPlayTree.QiziXY[((i + KeyXY) mod 32) + 1];
      end;

      // 棋子位置加密
      for i:=1 to 32 do
      begin
        // 死子位置随机产生
        if (XQFHead.QiziXY[i]=$FF) then XQFHead.QiziXY[i]:=90+Random(155);

        // 棋子位置加密
        XQFHead.QiziXY[i]:=bGetSaveXY(XQFHead.QiziXY[i]) + KeyXY;
      end;

      fs := dTXqfStream.Create(Name, fmCreate);
      fs.SetKeyBytes(0,0,0,0);
      fs.Write(XQFHead,sizeof(XQFHead));// 写入文件头
      fs.SetKeyBytes(
            (XQFHead.KeysSum and XQFHead.KeyMask) or XQFHead.KeyOrA,
            (XQFHead.KeyXY   and XQFHead.KeyMask) or XQFHead.KeyOrB,
            (XQFHead.KeyXYf  and XQFHead.KeyMask) or XQFHead.KeyOrC,
            (XQFHead.KeyXYt  and XQFHead.KeyMask) or XQFHead.KeyOrD);
      dSavePlayNodeIntoXQFile(fs, XQPlayTree);
      iRet := 0;
    except
    else
      iRet := -1;
    end;
   finally
     if (fs <> nil) then fs.Free;
     iSaveXQFile := iRet;
   end;
end;

{
function GetRParent(ATree, APNode: dTXQPlayNode): dTXQPlayNode;
begin
  Result := nil;
  if ATree  = nil then Exit;
  if APNode = nil then Exit;
  if IsQzXYSame(ATree.QiziXY, APNode.QiziXY, False, False) then
  begin
    Result := ATree;
    Exit;
  end;
  Result := GetRParent(ATree.LChild, APNode);
  if Result <> nil then Exit;
  Result := GetRParent(ATree.RChild, APNode);
end;

procedure dAddPlayNodeToTree(ATree, APNode: dTXQPlayNode);
var
  p: dTXQPlayNode;
begin
  if ATree  = nil then Exit;
  if APNode = nil then Exit;
  if APNode.RParent <> nil then
  begin
    p := GetRParent(ATree, APNode);

  end;

  dAddPlayNodeToTree(ATree, APNode.LChild);
  dAddPlayNodeToTree(ATree, APNode.RChild);
end;
}

procedure dMergePlayTree(t1, t2: dTXQPlayNode);
var
   pNext, qHead, p, q: dTXQPlayNode;
begin
  if t1 = nil then Exit;
  if t2 = nil then Exit;
  if not IsQzXYSame(t1.QiziXY, t2.QiziXY, False, False) then Exit;

  // 如果左子树为空，则直接将t2的左子树copy过来。
  if (t1.LChild = nil) then
  begin
    t1.LChild := t2.LChild;
    t2.LChild := nil;
    if t1.LChild <> nil then
    begin
      t1.LChild.LParent      := nil;
      t1.LChild.RParent      := t1;
      t1.LChild.LastStepNode := t1;
    end;
    Exit;
  end;

  qHead  := t1.LChild;
  p      := t2.LChild;
  t2.LChild := nil;

  while (p <> nil) do
  begin
    q        := qHead;
    pNext    := p.RChild;

    p.LParent := nil;
    p.RParent := nil;
    p.RChild  := nil;

    while (q<>nil) do
    begin
      if (q.XYf = p.XYf) and (q.XYt = p.XYt) then
      begin
        dMergePlayTree(q, p);
        p.Free;
        break;
      end
      else
      begin
        if (q.RChild = nil) then
        begin
          q.RChild  := p;
          p.LParent := q;
          p.RParent := nil;
          p.LastStepNode := q.LastStepNode;
          p.RChild  := nil;
          break;
        end
        else
        begin
          q := q.RChild;
        end;
      end;
    end;
    p := pNext;
  end;
end;

procedure dAddXqfToPlayTree(ATree: dTXQPlayNode; AXqf: string);
var
  AXqFile     : dTXQFile;
  AXqTree     : dTXQPlayNode;
  AXqfQzXY    : dTXQZXY;
begin
  AXqTree       := dTXQPlayNode.Create(0,'========= ',0,0,AXqfQzXY,
                                     nil,nil,nil,nil);
  if (AXqTree = nil) then Exit;

  AXqFile := dTXQFILE.Create(AXqf, AXqTree);
  if (AXqFile = nil) then
  begin
    AXqTree.Free;
    Exit;
  end;

  if (AXqFile.iLoadXQFile <> 0) then
  begin
    AXqFile.Free;
    AXqTree.Free;
    Exit;
  end;

  dMergePlayTree(ATree, AXqTree);
  AXqFile.Free;
  AXqTree.Free;
end;


end.