unit mR1Encrypt;

interface

uses
  Windows, SysUtils, Forms, Classes;

type
  ER1Error = class(Exception);

function SimpleR1Check: Integer;
function CheckR1Times(AIsOnOpen: Boolean = False): Integer;
function CheckR1Hours: Integer;
function CheckR1AdditionEdition: Integer;
function CheckR1Edition(AOpening: Boolean = False): Integer;
function CheckR1Data: Integer;
function CheckR1LimitDate: Integer;

function GetR1ReportOprNum(AOpr: string): Integer;

function GetR1ReportFuncNum(AOpr: string): Integer;

function OpenR1Dog: Integer;

procedure SaveR1Dog;

function R1UserAuthorize(AAuthorize: array of Byte): Boolean;

function R1UserUpdateLock(AUpdateData: array of Byte): Boolean;

implementation

uses
  Math, CommonMessages, ScUtils, mEncryptPWD, CryptUtils, ScConfig,
  mEncryptUnit, mEncryptTypes, mEncryptEditions, Rockey1,
  PHPWebDm;

const
  _R1_Key: array [0..16] of Byte = ($00, $00, $00, $0D, $CE, $CE, $CD, $CF, $8C, $8B, $BC, $90, $8D, $8B, $92, $9E, $AC);
  _R1_PID: array [0..11] of Byte = ($00, $00, $00, $08, $06, $71, $23, $3D, $53, $05, $0A, $78);
  _R1_UserPin: array [0..19] of Byte = ($00, $00, $00, $10, $39, $EF, $50, $6B, $41, $0D, $CC, $52, $39, $EF, $50, $6B, $41, $0D, $CC, $52);

var
  _R1DogHandle: THandle = 0;
  _R1DogOpened: Boolean = False;
  _R1_HID: array [0..15] of Byte;

function DecryptKey: string;
var
  arrResult: array of Byte;
  iOutputLength: Integer;
begin
  iOutputLength := GetOutputLength(_R1_Key);
  SetLength(arrResult, iOutputLength);
  Decrypt_Simple(_R1_Key, Length(_R1_Key), arrResult, iOutputLength);
  SetString(Result, PChar(@arrResult[0]), iOutputLength);
end;

function DecryptValues(AInput: array of Byte; ALength: Integer; var AOutput: array of Byte): Integer;
var
  pKey: Pointer;
begin
  pKey := nil;
  Decrypt_BlowFish(DecryptKey, @AInput[0], ALength, pKey, Result);
  CopyMemory(@AOutput[0], pKey, Result);
end;

function DecryptPID(var AOutput: array of Byte): Integer;
begin
  Result := DecryptValues(_R1_PID, Length(_R1_PID), AOutput);
end;

function DecryptUserPin(var AOutput: array of Byte): Integer;
begin
  Result := DecryptValues(_R1_UserPin, Length(_R1_UserPin), AOutput);
end;

procedure InnerCloseR1Dog;
begin
  if _R1DogOpened then
  begin
    R1_Close(_R1DogHandle);
  end;
end;

procedure InnerOpenR1Dog;
var
  I: Integer;
  iResult: Cardinal;
  iCount: DWORD;
  aPID: array [0..7] of Byte;
  aUserPin: array [0..16] of Byte;
  iTryCount: Byte;
begin
  if _R1DogOpened then Exit;
  // 如果是插的彩虹锁，飞天锁驱动函数R1_Find没对iCount初始化，搞得循环2亿多次。现在先初始化iCount就可以了。
  iCount := 0;
  // 查找狗
  iResult := R1_Find(nil, @iCount);
  if iResult <> 0 then
    Exit;
  if iCount = 0 then
    Exit;
  // 解出PID
  if DecryptPID(aPID) = 0 then
    Exit;
  // 解出用户密码
  if DecryptUserPin(aUserPin) = 0 then
    Exit;
  // 不知为什么在win7 32位下，必须加一个0字符才能正确执行。可能跟C要求字符串以0字符结尾有关
  aUserPin[16] := 0;
  for I := 0 to iCount - 1 do
  begin
    // 获取句柄
    iResult := R1_Open(@_R1DogHandle, @aPID[0], I);
    if iResult <> 0 then
      Continue;
    // 验证
    iResult := R1_VerifyUserPin(_R1DogHandle, @aUserPin[0], @iTryCount);
    if iResult <> 0 then
      Continue;
    // 判断一下版本才决定是否正确的锁
    if CheckR1Edition(True) = CS_Success then
    begin
      _R1DogOpened := True;
      Break;
    end
    else
      InnerCloseR1Dog;
  end;
end;

const R1EncryptVer = 1;

function SimpleR1Check: Integer;
var
  iResult: Cardinal;
  aData: array [0..15] of Byte;
  iLength: WORD;
begin
  Result := -1;
  InnerOpenR1Dog;
  if not _R1DogOpened then Exit;
  iResult := R1_Read(_R1DogHandle, 0, 3, @aData[0], @iLength, MEM_PRI);
  if (iResult = 0) and (aData[2] = R1EncryptVer) then
    Result := DT_FT_R1;
end;

function CheckR1Times(AIsOnOpen: Boolean): Integer;
var
  iResult: Cardinal;
  aData: array [0..11] of Byte;
  iTimes, iRunTimes, iLength: Word;
begin
  Result := CS_Error;
  if SimpleR1Check < 0 then
    Exit;
  // 允许次数
  iTimes := 0;
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$07-$08，为迷惑，取$03-$0E
  iResult := R1_Read(_R1DogHandle, $03, Length(aData), @aData[0], @iLength, MEM_PRI);
  if iResult = 0 then
    iTimes := aData[4] shl 8 + aData[5];

  if iTimes = 0 then
    Exit;

  if iTimes = $FFFF then
  begin
    Result := CS_Success;
    Exit;
  end;

  bAuthorized := False;

  // 实际次数
  iRunTimes := 0;
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$04-$05，为迷惑，取$02-$0D
  iResult := R1_Read(_R1DogHandle, $02, Length(aData), @aData[0], @iLength, MEM_PUB);
  if iResult = 0 then
    iRunTimes := aData[2] shl 8 + aData[3];
  
  Activations := iRunTimes;

  if AIsOnOpen then
  begin
    if iRunTimes >= iTimes then
      Result := CS_NeedAuthorize
    else
      Result := CS_WantAuthorize;
  end
  else
  begin
    if iRunTimes > iTimes then
      Result := CS_NeedAuthorize
    else
      Result := CS_WantAuthorize;
  end;
end;

function CheckR1Hours: Integer;
var
  iResult: Cardinal;
  aData: array [0..11] of Byte;
  iSeconds, iRunSeconds: Cardinal;
  iLength: Word;
begin

  Result := CS_Error;
  if SimpleR1Check < 0 then
    Exit;

  // 允许时间
  iSeconds := 0;
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$03-$06，为迷惑，取$02-$0D
  iResult := R1_Read(_R1DogHandle, $02, Length(aData), @aData[0], @iLength, MEM_PRI);
  if iResult = 0 then
    iSeconds := ((aData[1] shl 8 + aData[2]) shl 8 + aData[3]) shl 8 + aData[4];


  //  iRunSeconds := ((aData[5] shl 8 + aData[6]) shl 8 + aData[7]) shl 8 + aData[8];

  if iSeconds = 0 then
    Exit;

  if iSeconds = $FFFFFFFF then
  begin
    Result := CS_Success;
    Exit;
  end;

  bAuthorized := False;

  // 实际运行时间
  iRunSeconds := 0;
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$00-$03，为迷惑，取$00-$0C
  iResult := R1_Read(_R1DogHandle, $00, Length(aData), @aData[0], @iLength, MEM_PUB);
  if iResult = 0 then
    iRunSeconds := ((aData[0] shl 8 + aData[1]) shl 8 + aData[2]) shl 8 + aData[3];

  LastTime := iRunSeconds;

  if iRunSeconds > iSeconds then
    Result := CS_NeedAuthorize
  else
    Result := CS_WantAuthorize;
end;

function CheckR1LimitDate: Integer;
var
  iResult: Cardinal;
  aData: array [0..11] of Byte;
  iType: Byte;
  iUserDate, iLimitDate: Cardinal;
  fDate, fCompileDate: TDateTime;
  iLength: Word;
begin
  Result := CS_Error;
  if SimpleR1Check < 0 then
    Exit;

  // 加密类型是否时间限制狗
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$63，为迷惑，取$5B-$66
  iResult := R1_Read(_R1DogHandle, $5B, Length(aData), @aData[0], @iLength, MEM_PRI);
  if iResult <> 0 then Exit;
  if aData[8] <> Ord(etDate) then
  begin
    Result := CS_Ignore;
    Exit;
  end;

  bAuthorized := False;

  // 允许日期
  iLimitDate := 0;
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$09-$0C，为迷惑，取$05-$10
  iResult := R1_Read(_R1DogHandle, $05, Length(aData), @aData[0], @iLength, MEM_PRI);
  if iResult = 0 then
    iLimitDate := ((aData[4] shl 8 + aData[5]) shl 8 + aData[6]) shl 8 + aData[7];

  // 运行日期
  iUserDate := 0;
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$06-$09，为迷惑，取$05-$10
  iResult := R1_Read(_R1DogHandle, $05, Length(aData), @aData[0], @iLength, MEM_PUB);
  if iResult = 0 then
    iUserDate := ((aData[1] shl 8 + aData[2]) shl 8 + aData[3]) shl 8 + aData[4];

  fDate := PHPWeb.SystemDateTime;
  fCompileDate := CompileDateTime;
  if fCompileDate > iLimitDate then
  begin
    Result := CS_EndDate;
    Exit;
  end;

  if fDate > iLimitDate then
    Result := CS_EndDate
  else if iLimitDate - fDate < 7 then
    Result := CS_CloseToLimitDate
  else
    Result := CS_Success;
end;

function CheckR1AdditionEdition: Integer;
var
  iResult: Cardinal;
  aData: array [0..15] of Byte;
  iLength: Word;
begin
  Result := CS_NoDog;
  if SimpleR1Check < 0 then
    Exit;

  // 附加版本限制
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$70-$72，为迷惑，取$70-$7F
  iResult := R1_Read(_R1DogHandle, $70, Length(aData), @aData[0], @iLength, MEM_PRI);
  if iResult = 0 then
  begin
    if aData[1] = $16 then
      Result := CS_Success
    else
      Result := CS_NeedUpdate;
  end;
end;

function CheckR1Edition(AOpening: Boolean): Integer;
var
  iResult: Cardinal;
  aData: array [0..255] of Byte;
  iEdition: Byte;
  iLength: Word;
  I: Integer;
begin
  Result := CS_NoDog;
  if (not AOpening) and (SimpleR1Check < 0) then
    Exit;

  // 附加版本限制
  iEdition := 0;
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$01，为迷惑，取$00-$FE
  iResult := R1_Read(_R1DogHandle, $00, Length(aData), @aData[0], @iLength, MEM_PRI);
  if iResult = 0 then
    iEdition := aData[1]
  else
    Exit;

  if iEdition = 0 then
    Exit;

  DogEdition := iEdition;
  if CheckEncryptEdition(iEdition) then
    Result := CS_Success
  else
    Result := CS_DogTypeError;

  if Result = CS_Success then
  begin
    _DogEdition := iEdition;
    // 如果是固话清单限制版，则不退出，继续后面的检查
    {$IFNDEF _mEncrypt}
    if not iEdition in [eidLimitedFixBills] then
      Exit;
    {$ENDIF}
  end;
  // 读取附加版本ID
  ZeroMemory(@aData[0], Length(aData));
  // 实际是$80-$92，为迷惑，取$77-$175
  iResult := R1_Read(_R1DogHandle, $77, Length(aData), @aData[0], @iLength, MEM_PRI);
  if iResult <> 0 then Exit;
  for I := Low(aData) + 9 to High(aData) do
  begin
    iEdition := aData[I];
    if iEdition = 0 then Break;
    if CheckEncryptEdition(iEdition) then
    begin
      Result := CS_Success;
      _DogEdition := iEdition;
      // 如果附加版本是固化清单限制版，则不跳出循环，以便检查是否还有固化清单完整版
      if iEdition = eidLimitedFixBills then
        Continue;
      // 如果是计量支付需要检测所有的功能模块，则在检测到所有功能模块可用前，不可跳出循环
      {$IFDEF _mEncrypt}
      if not (_bHasCompileEdition and _bHasMeasureEdition and _bHasPlanEdition) then
        Continue;
      {$ENDIF}
      Break;
    end;
  end;
end;

function CheckR1Data: Integer;
var
  iResult: Cardinal;
  iCheckData, iOutputLength: Integer;
  pKey: Pointer;
  arrKey: array [0..15] of Byte;
  arrData: array [0..19] of Byte;
  I: Integer;
  bIsZero: Boolean;
  iLength: Word;
begin
  Result := CS_NoDog;

  if SimpleR1Check < 0 then
    Exit;

  // HID
  ZeroMemory(@_R1_HID[0], Length(_R1_HID));
  iResult := R1_GetHID(_R1DogHandle, @_R1_HID[0]);
  if iResult <> 0 then Exit;
  strHaspID := '';
  // 注意此处与其他狗不同
  for I := 0 to Length(_R1_HID) - 1 do
    strHaspID := strHaspID + Char(_R1_HID[I]);
    
  Randomize;
  iCheckData := RandomRange(11000, 11050);
  case iCheckData of
    11011..11020:
    begin
      Result := CS_Ignore;
      Exit;
    end;
  end;

  // 校验码
  ZeroMemory(@arrKey[0], Length(arrKey));
  ZeroMemory(@arrData[0], Length(arrData));
  // $10-$23
  iResult := R1_Read(_R1DogHandle, $10, Length(arrData), @arrData[0], @iLength, MEM_PRI);
  if iResult = 0 then
  begin
    pKey := nil;
    try
      Decrypt_BlowFish(EncryptKey, @arrData[0], 20, pKey, iOutputLength);
      CopyMemory(@arrKey[0], pKey, iOutputLength);
    finally
      if Assigned(pKey) then
        FreeMem(pKey);
    end;
  end;
  for I := 0 to Length(_R1_HID) - 1 do
  begin
    if _R1_HID[I] <> arrKey[I] then
    begin
      Result := CS_VerifyError;
      Exit;
      Break;
    end;
  end;
  Result := CS_Success;
end;

function GetR1ReportOprNum(AOpr: string): Integer;
const
  OprStr = '[,-,*,^,:=,/,p,<,<=,>=,>,+,<>,=,or,!=,and,f';
var
  iResult: Cardinal;
  OprStrs: TStringList;
  StrIndex: Integer;
  OprNum: Byte;
  aData: array [0..19] of Byte;
  iLength: Word;
begin
  Result := -1;
  StrIndex := GetReportOprList.IndexOf(AOpr);
  if StrIndex > -1 then
  begin
    Result := Integer(GetReportOprList.Objects[StrIndex]);
  end
  else
  begin
    OprStrs := TStringList.Create;
    try
      OprStrs.CommaText := OprStr;
      iResult := R1_Read(_R1DogHandle, $30, Length(aData), @aData[0], @iLength, MEM_PRI);
      if iResult = 0 then
      begin
        StrIndex := OprStrs.IndexOf(AOpr);
        if StrIndex >= 0 then
        begin
          OprNum := aData[StrIndex];
          GetReportOprList.AddObject(AOpr, Pointer(OprNum));
          Result := OprNum;
        end;
      end;
    finally
      OprStrs.Free;
    end;
  end;
end;

function GetR1ReportFuncNum(AOpr: string): Integer;
const
  FuncStr = 'sql,treechapterinsert,getindex,addnull,shrink,copy,'+
            'sorttreechapter,joindata,chapterinsert,'+
            'refcopy,count,refcopyex1';
var
  iResult: Cardinal;
  FuncStrs: TStringList;
  StrIndex: Integer;
  OprNum: Byte;
  aData: array [0..19] of Byte;
  iLength: Word;
begin
  Result := -1;
  StrIndex := GetReportFuncList.IndexOf(AOpr);
  if StrIndex > -1 then
  begin
    Result := Integer(GetReportFuncList.Objects[StrIndex]);
  end
  else
  begin
    FuncStrs := TStringList.Create;
    try
      FuncStrs.CommaText := FuncStr;
      iResult := R1_Read(_R1DogHandle, $50, Length(aData), @aData[0], @iLength, MEM_PRI);
      if iResult = 0 then
      begin
        StrIndex := FuncStrs.IndexOf(AOpr);
        if StrIndex >= 0 then
        begin
          OprNum := aData[StrIndex];
          GetReportFuncList.AddObject(AOpr, Pointer(900 + OprNum));
          Result := 900 + OprNum;
        end;
      end;
    finally
      FuncStrs.Free;
    end;
  end;
end;

function OpenR1Dog: Integer;
var
  iResult: Cardinal;
  aData: array [0..11] of Byte;
  iTimes, iLength: Word;
begin
  Result := CS_Error;
  // 打开狗则运行次数立刻+1
  // 实际是$04-$05为迷惑，取$02-$0D
  iResult := R1_Read(_R1DogHandle, $02, Length(aData), @aData[0], @iLength, MEM_PUB);
  if iResult = 0 then
  begin
    iTimes := aData[2] shl 8 + aData[3];
  end
  else
    Exit;

  iTimes := iTimes + 1;
  ZeroMemory(@aData[0], Length(aData));
  aData[0] := iTimes shr 8;
  aData[1] := iTimes and $00FF;
  iResult := R1_Write(_R1DogHandle, $04, 2, @aData[0], @iLength, MEM_PUB);
  if iResult <> 0 then
    Exit;
  Result := CS_Success;
end;

procedure SaveR1Dog;
var
  iResult: Cardinal;
  aData: array [0..11] of Byte;
  aSecData: array [0..3] of Byte;
  iLastTime, iRunSeconds: LongWord;
  iBytesReturned: Cardinal;
  iLength: Word;
begin
  RunTime := GetTickCount div 1000;
  if RunTime < StartTime then
  begin
    iLastTime := High(LongWord) div 1000 + RunTime - StartTime;
  end
  else
    iLastTime := RunTime - StartTime;

  // 实际是$00-$03，为迷惑，取$00-$0B
  iResult := R1_Read(_R1DogHandle, $00, Length(aData), @aData[0], @iLength, MEM_PUB);
  if iResult = 0 then
  begin
    iRunSeconds := ((aData[$08] shl 8 + aData[$09]) shl 8 + aData[$0A]) shl 8 + aData[$0B];
    iLastTime := iLastTime + iRunSeconds;

    aSecData[$00] := iLastTime shr 24;
    aSecData[$01] := (iLastTime shr 16) and $00FF;
    aSecData[$02] := (iLastTime and $0000FFFF) shr 8;
    aSecData[$03] := iLastTime and $000000FF;

    iResult := R1_Write(_R1DogHandle, $00, 4, @aSecData[0], @iLength, MEM_PUB);
  end;
end;

function _R1UserAuthorize30(AAuthorize: array of Byte; ALength: Word): Boolean;
var
  iResult: DWORD;
  arrUpdateFile: array [0..9999] of Byte;
begin
  Result := False;
  if _R1DogOpened then
  begin
    CopyMemory(@arrUpdateFile[0], @AAuthorize[0], ALength); 
    iResult := R1_Update(_R1DogHandle, @arrUpdateFile[0], ALength);
    if iResult <> 0 then
      raise Exception.Create(Format('Can not update, error = %d', [iResult]));
    Result := True;
    bAuthorized := True;
  end;
end;

function R1UserAuthorize(AAuthorize: array of Byte): Boolean;
var
  pHead: PAuthFileHead;
  Key: array [0..9999] of Byte;
  iPos: Integer;
begin
  Result := False;
  iPos := SizeOf(TAuthFileHead);
  New(pHead);
  try
    CopyMemory(pHead, @AAuthorize[0], iPos);
    if SameText(pHead^.FileInfo, SAuthFileInfo) and (pHead^.Version = SAuthFileVer) then
    begin
      CopyMemory(@Key[0], @AAuthorize[iPos], pHead^.Length);
      Result := _R1UserAuthorize30(Key, pHead^.Length);
    end;
  finally
    Dispose(pHead);
  end;
end;

function R1UserUpdateLock(AUpdateData: array of Byte): Boolean;
var
  pHead: PAuthFileHead;
  Key: array [0..9999] of Byte;
  iPos: Integer;
begin
  Result := False;
  iPos := SizeOf(TAuthFileHead);
  New(pHead);
  try
    CopyMemory(pHead, @AUpdateData[0], iPos);
    if SameText(pHead^.FileInfo, SUpdateFileInfo) and (pHead^.Version = SUpdateFileVer) then
    begin
      CopyMemory(@Key[0], @AUpdateData[iPos], pHead^.Length);
      Result := _R1UserAuthorize30(Key, pHead^.Length);
    end;
  finally
    Dispose(pHead);
  end;
end;

initialization

finalization
  InnerCloseR1Dog;

end.