unit TSTCHK;

interface

uses
      Windows
   ,  Messages
     ,SysUtils
     ,Classes
     ,Graphics
     ,Controls
     ,Forms
     ,Dialogs
     ,StdCtrls
     ,SB      // Header file for Secure-Block (SB)
     ;
const
  TSTCHK_APP = 'DUMMY.SYS';
  TSTCHK_PIN = $F6762AB7;
type
  TForm1 = class(TForm)
    btnTest: TButton;
    procedure btnTestClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  sbPtr: SecureBlock;
  szText: Array [0..255] of Char;
  Form1: TForm1;

function DoEvchk(hInstance: LongInt): Integer;
implementation

{$R *.DFM}

procedure TForm1.btnTestClick(Sender: TObject);
begin
  DoEvchk(hInstance);
end;

function ToHex(nValue: Integer): string;
begin
  Result := IntToHex(nValue,4);
  Result := Copy(Result,Length(Result)-4,4);
end;

function DoEvchk(hInstance: LongInt): Integer;
type
  TSecureBlock = ^SecureBlock;
  TEVCHK32 = function (sbstruct: TSecureBlock): Integer; stdcall;
var
  hSaveCursor, hWaitCursor: TCursor;
  pEVCHK32: FARPROC;
  hEVCHK32: HMODULE;
  lastError: DWORD;
  funcName: String;

begin
    funcName := 'EVCHK32';
    SetLastError( 0 );
    hEVCHK32 := LoadLibrary( 'EVCK4W32.DLL' );   // failed

  if (hEVCHK32 < HINSTANCE_ERROR) then
  begin
     lastError := GetLastError;
     MessageDlg( 'EVCK4W32 was not loaded.' + #13 +
                 'LoadLibrary() failed with error '+IntToStr(lastError)+'.',
                 mtError, [mbOK], 0);
     Result := $7255; exit;
  end;

  SetLastError( 0 );
  pEVCHK32 := GetProcAddress( hEVCHK32, PChar(funcName) );
  if(not assigned(pEVCHK32)) then
  begin
     lastError := GetLastError;
     MessageDlg( 'GetProcAddress(hEVCHK32, ' + funcName + ') failed with error '
                + IntToStr(lastError) + '.', mtError, [mbOK], 0);

     result := $7255; exit;
  end;

  // get the handle of the hourglass (waiting) cursor
  hWaitCursor := LoadCursor( 0, IDC_WAIT );

  // turn on the waiting cursor
  hSaveCursor := SetCursor( hWaitCursor );

  // zero out the contents of the SB structure
  FillChar( sbPtr, SizeOf( SecureBlock ), 0);

  // initialize the contents of the SB buffer
  sbPtr.id[0] := 'A'; sbPtr.id[1] := 'Z'; sbPtr.id[2] := 'S'; sbPtr.id[3] := 'B';
  sbPtr.pin := TSTCHK_PIN;

  // get the module filename for this instance of the application
  GetModuleFileName( hInstance, sbPtr.source, 63 );

  // change from our application name to the dummy application name
  StrPCopy(sbPtr.source, ExtractFilePath( sbPtr.source ) + TSTCHK_APP);

  // perform the protection check
  sbPtr.func := 1;
  TEVCHK32(pEVCHK32)(@sbPtr);

  // restore the original cursor
  SetCursor( hSaveCursor );

  // unload the library
  FreeLibrary( hEVCHK32 );

  // display the results of the check
  if(sbPtr.stat1 <> 0 ) then
  begin
    // display the error message
    MessageDlg('Security Error ' + ToHex(sbPtr.stat1) + '-' + ToHex(sbPtr.stat2) +
      '-' + ToHex(sbPtr.stat3) + '.', mtError, [mbOK], 0);
    // return to the OS
    Result := sbPtr.stat1;
    exit;
  end;

  MessageDlg(funcName + ' Protection Check Successful!' + #13 +
             ' Serial Number = ' + IntToStr(sbPtr.snp), mtInformation, [mbOK], 0);
  Result := 0;
end;
end.
