STELLA

Top  Previous  Next

unit Stella;

 

interface

 

Uses SysUtils, WinProcs;

 

Type Tregistry = (rgOk,     {= Rendben}

                rgNo,     {= Nincs rendben, nem jó reg. szám}

                rgNoReg,  {= Nincs reg. file}

                rgMiss    {= Beleírtak a reg. file-ba}

               );

 

   TregisterRecord = record

     CheckSum      : word;        {Ellenőrző 0sszeg}

     Registered    : boolean;     {Regisztált=True}

     Regszam       : longint;     {Reg.szám}

     UserCount     : byte;        {Felhasználók max. száma}

     User          : string[30];  {Felhasználó neve}

     Company       : string[30];  {Cég neve}

     Address       : string[40];  {Cím}

     Password      : string[10];  {jelszó}

   end;

 

 

{ Regisztáció , Titkosítás , Demó }

Function GetSysDir: string; export;

function GetWinDir: String; export;

Function SetRegistry(regfile:string;regszam:longint):boolean; export;

Function GetRegistry(regfile:string):longint; export;

Function CompareRegistry(regfile:string;regszam:longint):Tregistry; export;

{Komplex regisztráció: reg rekorddal}

Function GetRegCheckSum(reg:TregisterRecord):word; export;

Function SetReg(regfile:string;reg:TregisterRecord):boolean; export;

Function GetReg(regfile:string;var reg:TregisterRecord):boolean; export;

Function TestRegCheckSum(regfile:string):Tregistry; export;

Function CompareReg(reg1,reg2:TregisterRecord):boolean; export;

 

Function Registralt(regfile1,regfile2:string):Tregistry; export;

{Reg.rekord titkosítása ill. dekódolása}

Function Regkodol(reg:TregisterRecord):TregisterRecord; export;

Function RegDekodol(reg:TregisterRecord):TregisterRecord; export;

 

{ DÁTUM }

Function Isdate(d:TDateTime):boolean; export;

Function Year(d:TDateTime):Word; export;

Function Month(d:TDateTime):Word; export;

Function Day(d:TDateTime):Word; export;

Function Szokoev(d:TDateTime):boolean; export;

Function HonapUtolsoNapja(ev,honap:word):word; export;

 

{ FILE }

Function FileMeret(fn:string):Longint; export;

Function FileCopy(src,dst: string): boolean; export;

 

Function SzokodolID(szo:string;id:byte):string; export;

Function SzodekodolID(jelszo:string;id:byte):string; export;

 

const utolsonap : array[1..12] of word = (31,28,31,30,31,30,31,31,30,31,30,31);

 

implementation

 

{Windows system directory}

Function GetSysDir: string;

var Sdir: Array[0..80] of Char;

begin

 If GetSystemDirectory(sdir,80)<>0 then

 Result := StrPas(sdir) else Result := '';

end;

 

function GetWinDir: String;

var Temp: array[0..255] of Char;

begin

GetWindowsDirectory(Temp, 256);

Result := StrPas(Temp);

end;

 

{Program regisztráció

---------------------

a 'regszam' alapján a W system dir-ben létrehoz egy 'regfile'-t

és abba írja a reg.számot. A 'regfile' csak filenév Path nélkül!

}

Function SetRegistry(regfile:string;regszam:longint):boolean;

var Sdir: string;

  f: file of Longint;

begin

sdir := GetSysDir;

If sdir = '' then result:=False

else begin

     regfile := sDir + '\' + regfile;

     Try

     Try

        {$I-}

        AssignFile(f,regfile);

        Rewrite(f);

        Write(f,regszam);

        Result:=True;

     except

        Result:=False

     end;

     finally

        CloseFile(f);

        {$I+}

     end

end;

end;

 

{Reg.számot olvas be a 'regfile'-ból

Result:= reg.szám, ha 0 akkor hibás beoilvasás}

Function GetRegistry(regfile:string):longint;

var Sdir: string;

  f: file of Longint;

begin

sdir := GetSysDir;

If sdir = '' then result:=0

else begin

     regfile := sDir + '\' + regfile;

     If FileExists(regfile) then begin

     Try

     Try

        {$I-}

        AssignFile(f,regfile);

        Reset(f);

        Read(f,result);

     except

        Result:=0

     end;

     finally

        CloseFile(f);

        {$I+}

     end

     end else Result:=0;

end;

end;

 

Function CompareRegistry(regfile:string;regszam:longint):Tregistry;

var Sdir: string; fregszam:longint;

  f: file of Longint;

begin

sdir := GetSysDir;

If sdir = '' then result:=rgNo

else begin

     regfile := sDir + '\' + regfile;

     If FileExists(regfile) then begin

     Try

        {$I-}

        AssignFile(f,regfile);

        Reset(f);

        Read(f,fregszam);

        If (regszam=fregszam) then Result:=rgOk

        else Result:=rgNo;

     finally

        CloseFile(f);

        {$I+}

     end

     end else Result:=rgNoReg;

end;

end;

 

{Komplex regisztráció: reg rekorddal}

Function GetRegCheckSum(reg:TregisterRecord):word;

var p: ^byte;

  i: integer;

  a: byte;

begin

p:= @reg; Inc(p,2);

result:=0;

For i:=2 to SizeOf(reg)-2 do begin

    a := p^;

    Result := Result + a;

    Inc(p);

end;

end;

 

Function SetReg(regfile:string;reg:TregisterRecord):boolean;

var f: file of TregisterRecord;

begin

     Try

     Try

        {$I-}

        AssignFile(f,regfile);

        Rewrite(f);

        reg.CheckSum:=GetRegCheckSum(reg);

        Write(f,reg);

        Result:=True;

     except

        Result:=False

     end;

     finally

        CloseFile(f);

        {$I+}

     end

end;

 

Function GetReg(regfile:string;var reg:TregisterRecord):boolean;

var f: file of TregisterRecord;

  van:boolean;

begin

   van:=FileExists(regfile);

     If van then

     begin

        {$I-}

        AssignFile(f,regfile);

        Reset(f);

        Read(f,reg);

        Result:=IOResult=0;

        CloseFile(f);

        {$I+}

     end

     else Result:=False;

end;

 

Function TestRegCheckSum(regfile:string):Tregistry;

var Sdir: string; freg:TregisterRecord;

  f: file of TregisterRecord;

  chks: word;

begin

     If FileExists(regfile) then begin

     Try

        {$I-}

        AssignFile(f,regfile);

        Reset(f);

        Read(f,freg);

        chks:=GetRegCheckSum(freg);

        If (chks=freg.checksum) then Result:=rgOk

        else Result:=rgMiss;

     finally

        CloseFile(f);

        {$I+}

     end

     end else Result:=rgNoReg;

end;

 

{Összehasonlítja a 'reg1,reg2' regisztrációs rekordot:

Ha megegyezik = True}

Function CompareReg(reg1,reg2:TregisterRecord):boolean;

var  chks: word;

begin

result:=False;

Try

        If (reg1.checksum  = reg2.checksum) and

           (reg1.registered= reg2.registered) and

           (reg1.usercount = reg2.usercount) and

           (reg1.regszam   = reg2.regszam) and

           (reg1.user      = reg2.user) and

           (reg1.company   = reg2.company) and

           (reg1.address   = reg2.address) and

           (reg1.password  = reg2.password) then Result:=True

        else Result:=False;

except

        Result:=False

end;

end;

 

Function Registralt(regfile1,regfile2:string):Tregistry;

var reg1,reg2: TregisterRecord;

  van1,van2: boolean;

begin

van1:=Getreg(regfile1,reg1);

van2:=Getreg(regfile2,reg2);

If reg1.registered and reg2.registered then begin

Case TestRegChecksum(regfile1) of

rgOk  :

  Case TestRegChecksum(regfile2) of

  rgOk : If CompareReg(reg1,reg2) then Result:=rgOk else Result:=rgNo;

  rgNoReg : Result:=rgNo;

  rgMiss  : Result:=rgMiss;

  end;

rgNoReg : Result:=rgNoReg;

rgMiss  : Result:=rgMiss;

end;

end else Result:=rgNo;

end;

 

Function RegKodol(reg:TregisterRecord):TregisterRecord;

begin

        With reg do begin

           Result.registered:= registered;

           Result.usercount := usercount;

           Result.regszam   := regszam;

           Result.user      := SzokodolID(user,regszam);

           Result.company   := SzokodolID(company,regszam);

           Result.address   := SzokodolID(address,regszam);

           Result.password  := SzokodolID(password,regszam);

        end;

end;

 

Function RegDekodol(reg:TregisterRecord):TregisterRecord;

begin

        With reg do begin

           Result.registered:= registered;

           Result.usercount := usercount;

           Result.regszam   := regszam;

           Result.user      := SzoDekodolID(user,regszam);

           Result.company   := SzoDekodolID(company,regszam);

           Result.address   := SzoDekodolID(address,regszam);

           Result.password  := SzoDekodolID(password,regszam);

        end;

end;

 

{

FileMeret(filenév):méret

------------------------

Visszadja a file méretét bytokban.

Ha nem létezik a file, akkor 0-t

}

Function FileMeret(fn:string):Longint;

var f: file of byte;

begin

If FileExists(fn) then begin

Try

   {$I-}

   AssignFile(f,fn);

   Reset(f);

   Result:=FileSize(f);

finally

   CloseFile(f);

   {$I+}

end;

end else Result:=0;

end;

 

 

Function Isdate(d:TDateTime):boolean;

begin

Try

  DateTimeToStr(d);

  Result:=True;

except

  Result:=False;

end;

end;

 

Function Szokoev(d:TDateTime):boolean;

var E,H,N: Word;

begin

 DecodeDate(d,E,H,N);

 Result:=(E mod 4)=0

end;

 

Function HonapUtolsoNapja(ev,honap:word):word;

begin

Result:=utolsonap[honap];

If honap=2 then

  If Szokoev(ev) then Result:=29;

end;

 

Function Year(d:TDateTime):Word;

var E,H,N: Word;

begin

 DecodeDate(d,E,H,N);

 Result:=E;

end;

 

Function Month(d:TDateTime):Word;

var E,H,N: Word;

begin

 DecodeDate(d,E,H,N);

 Result:=H;

end;

 

Function Day(d:TDateTime):Word;

var E,H,N: Word;

begin

 DecodeDate(d,E,H,N);

 Result:=N;

end;

 

Function FileCopy(src,dst: string): boolean;

var hiba1,hiba2,buffsize: word;

  f1,f2: file;

  a: array[1..10240] of Char;

  meret: longint;

begin

Try

If FileExists(src) then begin

AssignFile( f1, src );

AssignFile( f2, dst );

Filemode := 2;

{$I-}

Reset(f1,1);

Rewrite(f2,1);

meret:=FileSize(f1);

If meret<10240 then buffsize:=meret else buffsize:=10240;

If IOresult = 0 then begin

   repeat

     BlockRead( f1, a, SizeOf(a), hiba1 );

     BlockWrite( f2, a, hiba1, hiba2 );

   Until (Hiba1 = 0) or (Hiba1<>SizeOf(a));

Result := True;

end;

  System.CloseFile(f1);

  System.CloseFile(f2);

end;

Except

Result := False;

end;

end;

 

Function  SzokodolID(szo:string;id:byte):string;

var i: integer;

begin

Result := '';

For i:=1 to Length(szo) do Result:=Result+

    Chr(Ord(szo[i])+ID);

end;

 

Function  SzodekodolID(jelszo:string;id:byte):string;

var i: integer;

begin

Result := '';

For i:=1 to Length(jelszo) do Result:=Result+

    Chr(Ord(jelszo[i])-ID);

end;

 

end.