{
  Warning: This sample is still under developing...
}
program DelphiTest;

{$APPTYPE CONSOLE}

uses
  SysUtils,Windows{, sense4dev};

{$include sense4dev.inc}

var
  dwRet:DWORD;
  dwSize:DWORD;
  dwReturned:DWORD;
  dwBytesWritten:DWORD;
  dwFileSize:DWORD;
  DeviceType:BYTE;
  pstS4Ctx:PSENSE4_CONTEXT;
  CreateDir_Info:S4CREATEDIRINFO;
  OpenDir_Info:S4OPENINFO;
  InBuffer:PChar;
  OutBuffer:PChar;
  InParam:array[0..127] of BYTE;
  OutResult:array[0..127] of BYTE;

function ReadFile(filename: string; var pbBuffer: pbyte; var dwLen: DWORD): boolean;
var
  File1: file;
  filein: integer;
  num: DWORD;
begin
 { if (pbbuffer = nil) then
  begin
    Result := False;
    exit;
  end;
 } try
    dwLen := 0;
    AssignFile(file1, filename);
    FileMode :=fmOpenRead; 
    Reset(file1, 1);
    dwLen := FileSize(file1);
    if (dwLen <> 0) then
    begin
      pbBuffer := AllocMem(dwLen);
      blockread(file1, pbbuffer^, dwlen, num);
      if (num) <= 0 then
      begin
        Result := False;
        exit;
      end;
    end
    else
    begin
      Result:= false;
      exit;
    end;
  finally
    closefile(file1);
  end;
  Result := True;
end;

label Err;
begin
  { TODO -oUser -cConsole Main : Insert code here }
  dwRet := S4_ERROR_UNKNOWN;
  dwSize := 0;
  pstS4Ctx := nil;

  //enumerate devices
  WriteLn('Enumerate device...');
  S4Enum(nil, dwSize);
  pstS4Ctx := PSENSE4_CONTEXT(allocmem(dwSize));

  dwRet := S4Enum(pstS4Ctx, dwSize);
  if (S4_SUCCESS <> dwRet) then
    goto Err;

  //open device with exclusive mode
  OpenDir_Info.dwS4OpenInfoSize := sizeof(S4OPENINFO);
  OpenDir_Info.dwShareMode := S4_EXCLUSIZE_MODE;
  WriteLn('Open device...');
  dwRet := S4OpenEx(pstS4Ctx, @OpenDir_Info);
  if (S4_SUCCESS <> dwRet) then
    goto Err;

  //change current directory to root directory
  WriteLn('Change to root dir(if exist)...');
  dwRet := S4ChangeDir(pstS4Ctx, '\');

  //verify dev PIN
  WriteLn('Verify root dir developer PIN(if exist)...');
  dwRet := S4VerifyPin(pstS4Ctx, PChar('123456781234567812345678'), 24, S4_DEV_PIN);

  //erase current directory
  WriteLn('Delete root dir(if exist)...');
  dwRet := S4EraseDir(pstS4Ctx, nil);

  //create root directory and ATR file whose content is FFFFFFFFFFFFFFFF
  WriteLn('Create new root dir, and set user define serial number to $ffffffffffffffff...');
  CreateDir_Info.dwS4CreateDirInfoSize := sizeof(S4CREATEDIRINFO);
  CreateDir_Info.szAtr[0] := $ff;
  CreateDir_Info.szAtr[1] := $ff;
  CreateDir_Info.szAtr[2] := $ff;
  CreateDir_Info.szAtr[3] := $ff;
  CreateDir_Info.szAtr[4] := $ff;
  CreateDir_Info.szAtr[5] := $ff;
  CreateDir_Info.szAtr[6] := $ff;
  CreateDir_Info.szAtr[7] := $ff;
  dwRet := S4CreateDirEx(pstS4Ctx, '\', 0, S4_CREATE_ROOT_DIR, @CreateDir_Info);

  //invoke S4Control to get device type
  dwRet := S4Control(pstS4Ctx, S4_GET_DEVICE_TYPE, nil, 0, @DeviceType, 1, dwReturned);
  ASSERT(dwRet = S4_SUCCESS);

  //verify dev PIN
  WriteLn('Verify root dir developer PIN...');
  dwRet := S4VerifyPin(pstS4Ctx, PChar('123456781234567812345678'), 24, S4_DEV_PIN);

  //invoke S4WriteFile to download VM executable file
  WriteLn('Write demo_v20.bin to \0001, as vm exe file...');
  InBuffer := nil;
  if (not ReadFile('demo_v20.bin', pbyte(InBuffer), dwFileSize)) then
  begin
     writeln('Read VM Bin File Error!\n');
     goto Err;
  end;
  dwRet := S4WriteFile(pstS4Ctx, '0001', 0,  InBuffer, dwFileSize, dwFileSize,
      dwBytesWritten, S4_CREATE_NEW, S4_EXE_FILE);
  FreeMem(InBuffer);
  InBuffer := nil;

  //invoke S4WriteFile to download XA executable file
  WriteLn('Write demo_v30.bin to \0002, as XA exe file...');
  InBuffer := nil;
  if (not ReadFile('demo_v30.bin', pbyte(InBuffer), dwFileSize)) then
  begin
     writeln('Read XA Bin File Error!\n');
     goto Err;
  end;
  //when creating XA executable file, the FileSize specified should be 126 bytes larger than the actual Bin size at least.
  dwRet := S4WriteFile(pstS4Ctx, '0002', 0,  InBuffer, dwFileSize, dwFileSize + 126,
      dwBytesWritten, S4_CREATE_NEW, S4_XA_EXE_FILE);

  //invoke S4WriteFile to update XA
  dwRet := S4WriteFile(pstS4Ctx, '0002', 0, InBuffer, dwFileSize, 0, dwBytesWritten,
    S4_UPDATE_FILE, S4_XA_EXE_FILE);
  FreeMem(InBuffer);
  InBuffer := nil;

  //verify user PIN
  WriteLn('Verify user PIN...');
  dwRet := S4VerifyPin(pstS4Ctx, PChar('12345678'), 8, S4_USER_PIN);

  //execute VM file 0001
  WriteLn('Execute \0001...');
  InParam[0] := $31;
  InParam[1] := $32;
  InParam[2] := $33;
  InParam[3] := $34;
  dwRet := S4ExecuteEx(pstS4Ctx, '0001', S4_VM_EXE, @InParam, 4, @OutResult, 128, dwReturned);
  { This is equivalent to:
  dwRet := S4Execute(pstS4Ctx, '0001', @InParam, 4, @OutResult, 128, dwReturned);
  }
  ASSERT(dwRet = 0);
  ASSERT(OutResult[1] = $63);
  ASSERT(OutResult[3] = $67);


  //execute XA file 0002
  WriteLn('Execute \0002...');
  dwRet := S4ExecuteEx(pstS4Ctx, '0002', S4_XA_EXE, @InParam, 4, @OutResult, 128, dwReturned);
  ASSERT(dwRet = 0);
  ASSERT(OutResult[0] = $63);
  ASSERT(OutResult[2] = $67);


  dwRet := S4Close(pstS4Ctx);
  if (S4_SUCCESS <> dwRet) then
    goto Err;


Err:
    if (pstS4Ctx <> nil) then
    begin
      freemem(pstS4Ctx);
      pstS4Ctx := nil;
    end;

    if (InBuffer <> nil) then
    begin
      freemem(InBuffer);
      InBuffer := nil;
    end;
end.
