home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sheriffa / csheriff.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-07-26  |  6.8 KB  |  264 lines
  1. unit CSheriff;
  2.  
  3. interface
  4.  
  5. uses Windows, SysUtils, SlsApi;
  6.  
  7. type
  8.   TSecrets = array[0..3,0..17] of byte;
  9.  
  10.   TSheriff = class(TObject)
  11.   private
  12.     { Private declarations }
  13.     m_hLicence: SLS_HANDLE;
  14.     m_lLastError: HRESULT;
  15.     m_szProductID: array[0..32] of Char;
  16.     m_szUserName: array[0..256] of Char;
  17.     m_arySecrets: array[0..3] of SLS_SECRET;
  18.     m_bSecretsSet:Boolean;
  19.  
  20.   public
  21.     { Public declarations }
  22.     constructor Create(pszProductID:PChar;pszUserName:PChar);
  23.     destructor  Destroy; virtual;
  24.     {attributes}
  25.     {inteface}
  26.     function  Succeeded:Boolean;
  27.     procedure SetSecrets(arySecrets:TSecrets);
  28.     function  GetLastError:HRESULT;
  29.     procedure GetLastErrorMessage(var strError:string);
  30.  
  31.     {API interface}
  32.     function  QueryLicenceInfo(var licInfo:SLS_LICENCE_INFO):Boolean;
  33.     function  GetReference(var strReference:string):Boolean;
  34.     function  SetLicence(pszReference:PChar;lpszLicenceKey:PChar):Boolean;
  35.  
  36.     function Register(pszProductName:PChar;
  37.                       pszLicencePath:PChar):Boolean;
  38.     function License(vLicence:SLS_LICENCE):Boolean;
  39.     function Request(vRequest:SLS_REQUEST;var vPermit:SLS_PERMIT):Boolean;
  40.     function Update(vUpdate:SLS_UPDATE;var vPermit:SLS_PERMIT):Boolean;
  41.     function Release(vRelease:SLS_RELEASE):Boolean;
  42.  
  43.     //Attribute
  44.     function IsProductInstalled:Boolean;
  45.     function IsProductRegistered:Boolean;
  46.     function IsLicenceDefined:Boolean;
  47.     function IsLicenceValid:Boolean;
  48.  
  49.   end;
  50.  
  51. implementation
  52.  
  53. constructor TSheriff.Create(pszProductID:PChar;pszUserName:PChar);
  54. begin
  55.     inherited Create;
  56.     StrCopy(m_szProductID,pszProductID);
  57.     StrCopy(m_szUserName,pszUserName);
  58.     m_hLicence:=0;
  59.     m_lLastError:=SLS_SUCCESS;
  60.        m_bSecretsSet:=false;
  61. end;
  62.  
  63. destructor  TSheriff.Destroy;
  64. begin
  65.    Inherited Destroy;
  66. end;
  67.  
  68. function TSheriff.Succeeded:Boolean;
  69. begin
  70.     Succeeded:=m_lLastError=0;
  71. end;
  72.  
  73. procedure TSheriff.SetSecrets(arySecrets:TSecrets);
  74. var i,j:Integer;
  75. begin
  76.     for i:=0 to 3 do
  77.     begin
  78.        for j:=0 to 17 do
  79.            m_arySecrets[i].Secret[j]:=char(arySecrets[i,j]);
  80.        for j:=18 to 31 do
  81.            m_arySecrets[i].Secret[j]:=char(0);
  82.     end;
  83.  
  84.     m_bSecretsSet:=TRUE;
  85. end;
  86.  
  87. function  TSheriff.GetLastError:HRESULT;
  88. begin
  89.     GetLastError:=m_lLastError;
  90. end;
  91.  
  92. procedure TSheriff.GetLastErrorMessage(var strError:string);
  93. var    szErrorMessage:array[0..255] of char;
  94. begin
  95.     SLS_GetErrorMessage(m_lLastError,szErrorMessage);
  96.     strError:=szErrorMessage;
  97. end;
  98.  
  99. {API interface}
  100. function  TSheriff.QueryLicenceInfo(var licInfo:SLS_LICENCE_INFO):Boolean;
  101. begin
  102.     m_lLastError:=SLS_QueryLicenceInfo(m_szProductID,licInfo);
  103.     QueryLicenceInfo:=SUCCEEDED;
  104. end;
  105.  
  106. function  TSheriff.GetReference(var strReference:string):Boolean;
  107. var szReference:array[0..127] of char;
  108. begin
  109.     m_lLastError:=SLS_GetReference(m_szProductID,szReference);
  110.     strReference:=szReference;
  111.     GetReference:=SUCCEEDED;
  112. end;
  113.  
  114. function  TSheriff.SetLicence(pszReference:PChar;lpszLicenceKey:PChar):Boolean;
  115. begin
  116.     m_lLastError:=SLS_SetLicence(m_szProductID,pszReference,lpszLicenceKey);
  117.     SetLicence:=SUCCEEDED;
  118. end;
  119.  
  120. function TSheriff.Register(pszProductName:PChar;
  121.                            pszLicencePath:PChar):Boolean;
  122. begin
  123.     m_lLastError:=SLS_Register(m_szProductID,pszProductName,pszLicencePath);
  124.     Register:=Succeeded;
  125. end;
  126.  
  127. function TSheriff.License(vLicence:SLS_LICENCE):Boolean;
  128. var    Challenge:SLS_CHALLENGE;
  129. begin
  130.     if(m_bSecretsSet=false)then
  131.     begin
  132.         {Secrets Undefined}
  133.         m_lLastError:=SLS_E_BAD_SECRET;
  134.         License:=false;
  135.         exit;
  136.     end;
  137.  
  138.     {Create Challenge}
  139.     m_lLastError:=SLS_CreateChallenge(@m_arySecrets,4,@vLicence,SizeOf(SLS_LICENCE),Challenge);
  140.     if(SUCCEEDED) then
  141.         m_lLastError:=SLS_Licenses(m_szProductID,vLicence,Challenge);
  142.  
  143.     License:=SUCCEEDED;
  144. end;
  145.  
  146. function TSheriff.Request(vRequest:SLS_REQUEST;var vPermit:SLS_PERMIT):Boolean;
  147. var Challenge:SLS_CHALLENGE;
  148. begin
  149.     vPermit.UnitsGranted:=0;
  150.     vPermit.AccessKey:=0;
  151.  
  152.     if(m_bSecretsSet) then
  153.     begin
  154.         {Create Challenge}
  155.         m_lLastError:=SLS_CreateChallenge(@m_arySecrets,4,@vRequest,sizeof(SLS_REQUEST),Challenge);
  156.         if(SUCCEEDED) then
  157.         begin
  158.             m_lLastError:=SLS_Requests(m_szProductID,m_szUserName,vRequest,vPermit,m_hLicence,Challenge);
  159.             if(SUCCEEDED) then
  160.             begin
  161.                 {Verify Challenge}
  162.                 m_lLastError:=SLS_VerifyChallenge(@m_arySecrets,4,@vPermit,sizeof(SLS_PERMIT),Challenge);
  163.             end;
  164.         end;
  165.     end    else
  166.     begin
  167.         {No Challenge}
  168.         Challenge.Protocol:=SLS_NO_PROTOCOL;
  169.         m_lLastError:=SLS_Requests(m_szProductID,m_szUserName,vRequest,vPermit,m_hLicence,Challenge);
  170.     end;
  171.  
  172.     Request:=SUCCEEDED;
  173. end;
  174.  
  175. function TSheriff.Update(vUpdate:SLS_UPDATE;var vPermit:SLS_PERMIT):Boolean;
  176. var Challenge:SLS_CHALLENGE;
  177. begin
  178.     vPermit.UnitsGranted:=0;
  179.     vPermit.AccessKey:=0;
  180.  
  181.     if(m_bSecretsSet) then
  182.     begin
  183.         {Create Challenge}
  184.         m_lLastError:=SLS_CreateChallenge(@m_arySecrets,4,@vUpdate,sizeof(SLS_UPDATE),Challenge);
  185.         if(SUCCEEDED) then
  186.         begin
  187.             m_lLastError:=SLS_Updates(m_szProductID,m_hLicence,vUpdate,vPermit,Challenge);
  188.             if(SUCCEEDED) then
  189.             begin
  190.                 {Verify Challenge}
  191.                 m_lLastError:=SLS_VerifyChallenge(@m_arySecrets,4,@vPermit,sizeof(SLS_PERMIT),Challenge);
  192.             end;
  193.         end;
  194.     end    else
  195.     begin
  196.         {No Challenge}
  197.         Challenge.Protocol:=SLS_NO_PROTOCOL;
  198.         m_lLastError:=SLS_Updates(m_szProductID,m_hLicence,vUpdate,vPermit,Challenge);
  199.     end;
  200.  
  201.     Update:=SUCCEEDED;
  202. end;
  203.  
  204. function TSheriff.Release(vRelease:SLS_RELEASE):Boolean;
  205. var    Challenge:SLS_CHALLENGE;
  206. begin
  207.     if(m_bSecretsSet) then
  208.     begin
  209.         {Create Challenge}
  210.         SLS_CreateChallenge(@m_arySecrets,4,@vRelease,sizeof(SLS_RELEASE),Challenge);
  211.     end else
  212.     begin
  213.         //No Challenge
  214.         Challenge.Protocol:=SLS_NO_PROTOCOL;
  215.     end;
  216.  
  217.     m_lLastError:=SLS_Releases(m_szProductID,m_hLicence,vRelease,Challenge);
  218.  
  219.     Release:=SUCCEEDED;
  220. end;
  221.  
  222. //Attribute
  223. function TSheriff.IsProductInstalled:Boolean;
  224. begin
  225.     m_lLastError:=SLS_IsProductInstalled(m_szProductID);
  226.     IsProductInstalled:=SUCCEEDED;
  227. end;
  228.  
  229. function TSheriff.IsProductRegistered:Boolean;
  230. var    licInfo:SLS_LICENCE_INFO;
  231. begin
  232.     m_lLastError:=SLS_QueryLicenceInfo(m_szProductID,licInfo);
  233.     IsProductRegistered:=SUCCEEDED;
  234. end;
  235.  
  236. function TSheriff.IsLicenceDefined:Boolean;
  237. var    licInfo:SLS_LICENCE_INFO;
  238. begin
  239.     m_lLastError:=SLS_QueryLicenceInfo(m_szProductID,licInfo);
  240.     if(SUCCEEDED=false)then
  241.         IsLicenceDefined:=FALSE
  242.     else
  243.     if(licInfo.State=SLS_STATE_UNDEFINED) or (licInfo.State=SLS_STATE_BAD) then
  244.         IsLicenceDefined:=FALSE
  245.     else
  246.         IsLicenceDefined:=TRUE;
  247. end;
  248.  
  249. function TSheriff.IsLicenceValid:Boolean;
  250. var    licInfo:SLS_LICENCE_INFO;
  251. begin
  252.     m_lLastError:=SLS_QueryLicenceInfo(m_szProductID,licInfo);
  253.     if(SUCCEEDED=false)then
  254.         IsLicenceValid:=FALSE
  255.     else
  256.     if(licInfo.State=SLS_STATE_OK) then
  257.         IsLicenceValid:=TRUE
  258.     else
  259.         IsLicenceValid:=FALSE;
  260. end;
  261.  
  262. end.
  263.  
  264.