ucrypt.pas

1. 发卡服务端：Server 项目文件：autojet.prj 2. 计费客户端：Client 项目文件：internet.prj Explorer.prj 先启动Exp

unit UCRYPT;

interface

USES WINDOWS,lzexpand,Sysutils,WINCRYPT,CLASSES,db,DBTABLES,forms,CONTROLS,dialogs;

CONST YEAR2000=36526;

type TSNDESC=CLASS(TBITS)
     PUBLIC
       GUESTID:integer;
       LASTDATE:TDATETIME;
       SID:STRING;
END;


function begincrypt(const KEY:STRING):boolean;
procedure endcrypt;

FUNCTION crypt(const source:string;Final:boolean=false):string;
FUNCTION decrypt(const SOURCE:string;Final:boolean=false):string;

function cryptstring(const source,key:string):string;
function decryptstring(const source,key:string):string;
function cryptstrasc(const source,key:string):string;
function decryptstrasc(const source,key:string):string;

function cryptxtcs(const source:string):string;
function decryptxtcs(const source:string):string;

FUNCTION cryptpassword(const key:string):string;
FUNCTION decryptpassword(const SOURCE,INPUT:string):BOOLEAN;

FUNCTION MAKEsn(PRONUM,GUESTID:INTEGER;NKEY:BYTE;LASTDATE:TDATETIME):string;
FUNCTION decryptsn(const SOURCE:string;sndesc:tsndesc):boolean;

FUNCTION cryptLIMIT(const SOURCE:TDATETIME;CONST GUESTID:LONGWORD;key:string;var DEST:STRING):boolean;
FUNCTION cryptLIMIT0(const SOURCE:TDATETIME;CONST GUESTID:LONGWORD;var DEST:STRING):boolean;
FUNCTION cryptLIMIT1(const SOURCE:TDATETIME;CONST GUESTID:LONGWORD;var DEST:STRING):boolean;
FUNCTION cryptLIMIT2(const SOURCE:TDATETIME;CONST GUESTID:LONGWORD;var DEST:STRING):boolean;
FUNCTION decryptLIMIT(const SOURCE,sid:string;key:string;var DEST:TDATETIME):boolean;
FUNCTION decryptLIMIT0(const SOURCE,sid:string;var DEST:TDATETIME):boolean;
FUNCTION decryptLIMIT1(const SOURCE,sid:string;var DEST:TDATETIME):boolean;
FUNCTION decryptLIMIT2(const SOURCE,sid:string;var DEST:TDATETIME):boolean;

function checklimit:BOOLEAN;

FUNCTION MAKEID(const GUESTID:LONGWORD;THISDATE:TDATETIME;const key:string;VAR SERVICEID:STRING):BOOLEAN;
FUNCTION DECRYPTID(const SOURCE,key:STRING;VAR GUESTID:LONGWORD;VAR LASTDATE:TDATETIME):BOOLEAN;

FUNCTION MAKESID(const GUESTID:LONGWORD;VAR SERVICEID:STRING):BOOLEAN;
FUNCTION DECRYPTSID(const SOURCE:STRING;VAR GUESTID:LONGWORD;VAR LASTDATE:TDATETIME):BOOLEAN;

var
   hProv:HCRYPTPROV;
   hKey:HCRYPTKEY;
   hHash:HCRYPTHASH;
   MYSNDESC:TSNDESC;
implementation

uses finput,SYS_DM,main;

function begincrypt(const KEY:STRING):boolean;
var
   THISKEY:STRING;
   pkey:array of char;
   LEN:DWORD;
   i:integer;
   //ms:array[0..1024] of char;
begin
     result:=false;
     if key='' then
        exit;
     thiskey:=key;
     endcrypt;
     if not CryptAcquireContext(@hProv,nil,nil,PROV_RSA_FULL,0) and
        not CryptAcquireContext(@hProv,nil,nil,PROV_RSA_FULL,CRYPT_NEWKEYSET) then
        exit;
     if not CryptCreateHash( hProv,CALG_MD5,0,0,@hHash) then begin
        endcrypt;
        exit;
     end;
     LEN:=LENGTH(KEY);
     setlength(pkey,len);
     for i:=0 to len-1 do
        pkey[i]:=key[i+1];
     if not CryptHashData(hHash,@pkey[0],LEN,0) then begin
        endcrypt;
        exit;
     end;
     if not CryptDeriveKey(hProv,CALG_RC4,hHash,0{CRYPT_EXPORTABLE},@hKey) then begin
        endcrypt;
        {FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,NIL,GetLastError(),GetSystemDefaultLangID(),
           @MS[0],512,NIL);
        SHOWMESSAGE(TRIM(MS)); }
        exit;
     end;
     result:=true;
end;

procedure endcrypt;
begin
     if hHash <> 0 then
        if CryptDestroyHash(hHash) then
           hHash:=0;
     if hKey <> 0 then
        if CryptDestroyKey(hKey) then
           hKey:=0;
     if hProv <> 0 then
        if CryptReleaseContext(hProv,0) then
           hProv:=0;
end;

FUNCTION crypt(const SOURCE:string;Final:boolean=false):string;
var
   PSOURCE:ARRAY OF CHAR;
   datalen:dword;
   I:INTEGER;
BEGIN
     RESULT:='';
     if source='' then
        exit;
     datalen:=lenGTH(source);
     SETLENGTH(PSOURCE,DATALEN);
     FOR I:=0 TO DATALEN-1 DO
         PSOURCE[I]:=SOURCE[I+1];
     if CryptEncrypt(hKey,0,final,0,@psource[0],@datalen,datalen) then
        result:=copy(STRING(psource),1,datalen);
     if final then
        endcrypt;
END;

FUNCTION decrypt(const SOURCE:string;Final:boolean=false):string;
var
   psource:ARRAY OF CHAR;
   datalen:dword;
   I:INTEGER;
BEGIN
     RESULT:='';
     if source='' then
        exit;
     datalen:=lenGTH(source);
     SETLENGTH(PSOURCE,DATALEN);
     FOR I:=0 TO DATALEN-1 DO
         PSOURCE[I]:=SOURCE[I+1];
     if CryptDecrypt(hKey,0,Final,0,@psource[0],@datalen) then
        result:=copy(STRING(psource),1,datalen);
     if final then
        endcrypt;
END;
FUNCTION cryptpassword(const key:string):string;
VAR
   S1,S2:STRING;
   I:BYTE;
begin
      S1:=cryptstring('DWSAP',key);
      S2:='';
      FOR I:=1 TO LENGTH(S1) DO
          S2:=S2+INTTOHEX(ORD(S1[I]),2);
      RESULT:=S2;
end;
FUNCTION decryptpassword(const SOURCE,INPUT:string):BOOLEAN;
VAR
   S1:STRING;
   I:BYTE;
begin
      result:=false;
      if length(source)<10 then
         exit;
      SETLENGTH(S1,5);
      FOR I:=1 TO 5 DO BEGIN
          TRY
             S1[I]:=CHR(STRTOINT('$'+SOURCE[I*2-1]+SOURCE[I*2]));
          EXCEPT
             RESULT:=FALSE;
             EXIT;
          END;
      END;
      result:=decryptstring(S1,input)='DWSAP';
end;
FUNCTION decryptsn(const SOURCE:string;sndesc:tsndesc):boolean;
var
   tmpstr:string;
   I,nkey:BYTE;
   tmpkey:smallint;
   KEYCHECK,TMPNUM:LONGWORD;
   snkey,sn:string;
begin
     result:=false;
     if length(source)<>28 then
        exit;

     snkey:=copy(source,1,20);
     SETLENGTH(TMPSTR,4);
     for i:=10 to 13 do BEGIN
         TRY
            TmPSTR[i-9]:=chr(strtoint('$'+source[i*2+1]+source[i*2+2]));
         EXCEPT
            EXIT;
         END;
     END;
     TMPSTR:=DECRYPTstring(TMPSTR,snkey);
     IF TMPSTR='' THEN
        EXIT;
     if tmpstr<>'Adel' then
        exit;

     TRY
        nkey:=strtoint('$'+source[15]+source[16]);
     EXCEPT
        EXIT;
     END;
     SETLENGTH(SNKEY,10);
     SETLENGTH(SN,10);
     for i:=0 to 9 do begin
         tmpkey:=nkey+i;
         if tmpkey>255 then
            tmpkey:=tmpkey-255;
         snkey[i+1]:=chr(tmpkey);
         TRY
            sn[i+1]:=chr(strtoint('$'+source[i*2+1]+source[i*2+2]));
         EXCEPT
            EXIT;
         END;
     end;
     sn:=copy(sn,1,7)+copy(sn,9,2);
     TMPSTR:=DECRYPTstring(SN,snkey);
     IF TMPSTR='' THEN
        EXIT;

     SN:=COPY(TMPSTR,1,7)+CHR(NKEY)+COPY(TMPSTR,8,2);
     TMPSTR:=DECRYPTstring(SN,'This is legal software. Thank you!');
     IF TMPSTR='' THEN
        EXIT;
     SN:=TMPSTR;

     sndesc.GUESTID:=strtoint('$'+inttohex(ord(sn[5]),2)+inttohex(ord(sn[6]),2)+inttohex(ord(sn[7]),2));
     //日期
     tmpnum:=strtoint('$'+inttohex(ord(sn[9]),2)+inttohex(ord(sn[10]),2));
     if tmpnum=0 then
        tmpnum:=65535;
     if tmpnum<=180 then
        sndesc.lastdate:=date+tmpnum
     else
        sndesc.lastdate:=YEAR2000+tmpnum;
     sndesc.Size:=32;
     KEYCHECK:=strtoint('$'+inttohex(ord(sn[1]),2)+inttohex(ord(sn[2]),2)
             +inttohex(ord(sn[3]),2)+inttohex(ord(sn[4]),2));
     TMPNUM:=2147483648;
     FOR I:=31 DOWNTO 0 DO BEGIN
         IF I<31 THEN
            TMPNUM:=TMPNUM DIV 2;
         IF KEYCHECK>=TMPNUM THEN BEGIN
            KEYCHECK:=KEYCHECK-TMPNUM;
            SNDESC.Bits[I]:=TRUE;
         END ELSE
            SNDESC.Bits[I]:=FALSE;
     END;
     result:=true;
end;
FUNCTION MAKEID(const GUESTID:LONGWORD;THISDATE:TDATETIME;const key:string;VAR SERVICEID:STRING):BOOLEAN;
VAR
   TMPSTR,TMPID:STRING;
   TMPDATE:INTEGER;
   I:BYTE;
BEGIN
     RESULT:=FALSE;
     SERVICEID:='';
     TMPSTR:=INTTOHEX(GUESTID,6);
     TMPDATE:=ROUND(THISDATE-YEAR2000);
     IF TMPDATE<0 THEN
        TMPDATE:=0;
     TMPSTR:=TMPSTR+INTTOHEX(TMPDATE,4);
     SETLENGTH(TMPID,6);
     TMPDATE:=0;
     FOR I:=1 TO 5 DO BEGIN
         TMPID[I]:=CHR(STRTOINT('$'+TMPSTR[I*2-1]+TMPSTR[I*2]));
         TMPDATE:=TMPDATE+ORD(TMPID[I]);
     END;
     TMPDATE:=tmpdate mod 255;
     TMPID[6]:=CHR(TMPDATE);
     tmpstr:=cryptSTRING(tmpID,KEY);
     IF TMPSTR='' THEN
        EXIT;
     TMPDATE:=ORD(TMPSTR[6]);
     TMPSTR:=COPY(TMPSTR,1,5);
     SETLENGTH(TMPID,10);
     FOR I:=0 TO 9 DO
         TMPID[I+1]:=CHR((TMPDATE+I) MOD 255);
     TMPSTR:=CRYPTSTRING(TMPSTR,TMPID);
     IF TMPSTR='' THEN
        EXIT;
     TMPSTR:=TMPSTR+CHR(TMPDATE);
     FOR I:=1 TO 6 DO
         SERVICEID:=SERVICEID+INTTOHEX(ORD(TMPSTR[I]),2);
     RESULT:=TRUE;
END;

FUNCTION MAKESID(const GUESTID:LONGWORD;VAR SERVICEID:STRING):BOOLEAN;
BEGIN
     result:=makeid(guestid,date,'This is Adel Service ID(ASID)',serviceid);
END;

FUNCTION DECRYPTID(const SOURCE,key:STRING;VAR GUESTID:LONGWORD;VAR LASTDATE:TDATETIME):BOOLEAN;
VAR
   S1,S2:STRING;
   I,DATE1,TMPNUM:LONGINT;
BEGIN
     RESULT:=FALSE;
     IF LENGTH(SOURCE)<>12 THEN
        EXIT;