Lisanslama

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Cevapla
ozcank
Üye
Mesajlar: 937
Kayıt: 28 Nis 2005 05:29

Re: Lisanslama

Mesaj gönderen ozcank »

Abim kaydet dedikten sona hatalar kayboldu normal mi ? Gerçi kodlardan sonuç alamadım. eğer zamanınız varsa bakma şansın olur mu?
amyy 18 494 552
Başa dön
Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4741
Kayıt: 09 Ara 2003 08:13
Konum: İstanbul
İletişim:
İletişim mrmarman

Re: Lisanslama

Mesaj gönderen mrmarman »

Daha düzenli olsalardı birşey diyebilirdim ama inceledim karışık geldi. Zamanım olursa yazdığın kodları bir düzene sokup proje haline dönüştürüp öyle incelerim.
Şimdi meşgulüm, sadece molalarda foruma takılıp sorulara cevap yazıyorum.
Resim
Resim ....Resim
Başa dön
ozcank
Üye
Mesajlar: 937
Kayıt: 28 Nis 2005 05:29

Re: Lisanslama

Mesaj gönderen ozcank »

Abi tşk. ederim. Aslında şöyle
Edit1.Text de = bir kod üretiyor
Edit2.Text de = Firma bilgileri
Edit3.Text de de = Bende bir exe var bu Edit1.Text de gelen koda karşılık kodu verip lisanslamayı bitiriyoruz.
Başa dön
Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4741
Kayıt: 09 Ara 2003 08:13
Konum: İstanbul
İletişim:
İletişim mrmarman

Re: Lisanslama

Mesaj gönderen mrmarman »

Bir UNIT altında sadeleştirdim...
(1) Normal şartlarda

Kod: Tümünü seç

  RegKayit( False );
şeklinde sorgulamanızı yapıyorsunuz. Sonuç size bir RECORD grubu halinde dönecektir. Dilersen buradan işlem yapabilirsin.
- İlk defa ise Registry'e yeni kayır açar 30 günlük süre başlar.
- daha önce açılmış ise her çalışmada süre geri sayar.
- sistem tarihi geri alınırsa bu algılanır hemen kullanım dışı kalır.


(2) Karşılaştırma yaptınız ve olumlu diyelim,

Kod: Tümünü seç

RegKayit( True );
dediğinizde sistem lisanslı hale geçer.

Kullanım Şekli.
Forma bir tane Button bir tane de Memo koyup deneyebilirsin.

Kod: Tümünü seç

procedure TForm1.BitBtn1Click(Sender: TObject);
Var
  Sonuc : TSonuc;
begin
  Sonuc := RegKayit(False);
  Memo1.Lines.Add( 'Tarih   : ' + DateToStr( Sonuc.Tarih ) );
  Memo1.Lines.Add( 'Saat    : ' + TimeToStr( Sonuc.Saat ) );
  Memo1.Lines.Add( 'Anahtar : ' + Sonuc.Anahtar );
  Memo1.Lines.Add( 'Sahip   : ' + Sonuc.Sahip );
  Memo1.Lines.Add( 'Kalan   : ' + IntToStr( Sonuc.Kalan ) );
  Memo1.Lines.Add( 'Expired : ' + IntToStr( Sonuc.Expired ) );
  Memo1.Lines.Add( 'MachineID : ' + IntToStr(Sonuc.MachineID) );
  case Sonuc.Lisansli of
    True : Memo1.Lines.Add( 'Lisans Sahibi :' + Sonuc.Sahip );
    False: Memo1.Lines.Add( 'Deneme Hesabı Kullanıcısı :' + Sonuc.Sahip );
  end;
end;

Kod: Tümünü seç

unit LisansKontrol;

interface

Uses Controls, Registry, Windows, Forms, SysUtils, Dialogs;

Type TSonuc = Record
      Tarih     : TDate;  // 'ActivationDate'
      Saat      : TTime;  // 'ActivationTime'
      Anahtar   : String; // 'UnLockKey'
      Sahip     : String; // 'RegisteredOwner'
      MachineID : Integer;
      sTarih    : TDate;  // 'sdate'
      Kalan     : Integer;
      Expired   : Integer;// 'expired'
      Lisansli  : Boolean;
end;

Function RegKayit(Lisansla:Boolean) : TSonuc;

implementation

const
  C1 = 52845;
  C2 = 22719;

function Decode(const S: AnsiString): AnsiString;
const
  Map: array[Char] of Byte = (  00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 62, 00, 00, 00, 63, 52, 53,
    54, 55, 56, 57, 58, 59, 60, 61, 00, 00, 00, 00, 00, 00, 00, 00, 01, 02, 03,
    04, 05, 06, 07, 08, 09, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22,
    23, 24, 25, 00, 00, 00, 00, 00, 00, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,
    36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
    00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00);
var
  I: LongInt;
begin
  case Length(S) of
    2:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6);
        SetLength(Result, 1);
        Move(I, Result[1], Length(Result))
      end;
    3:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
        SetLength(Result, 2);
        Move(I, Result[1], Length(Result))
      end;
    4:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
          (Map[S[4]] shl 18);
        SetLength(Result, 3);
        Move(I, Result[1], Length(Result))
      end
  end
end;

function Decrypt(const S: AnsiString; Key: Word): AnsiString;
  function InternalDecrypt(const S: AnsiString; Key: Word): AnsiString;
  var
    I: Word;
    Seed: Word;
  begin
    Result := S;
    Seed := Key;
    for I := 1 to Length(Result) do
    begin
      Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
      Seed := (Byte(S[I]) + Seed) * Word(C1) + Word(C2)
    end
  end;

  function PreProcess(const S: AnsiString): AnsiString;
  var
    SS: AnsiString;
  begin
    SS := S;
    Result := '';
    while SS <> '' do
    begin
      Result := Result + Decode(Copy(SS, 1, 4));
      Delete(SS, 1, 4)
    end
  end;
begin
  Result := InternalDecrypt(PreProcess(S), Key)
end;

function Encode(const S: AnsiString): AnsiString;
const
  Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
                            + 'abcdefghijklmnopqrstuvwxyz'
                            + '0123456789+/';
var
  I: LongInt;
begin
  I := 0;
  Move(S[1], I, Length(S));
  case Length(S) of
    1:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64];
    2:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
        Map[(I shr 12) mod 64];
    3:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
        Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
  end;
end;

function Encrypt(const S: AnsiString; Key: Word): AnsiString;
  function InternalEncrypt(const S: AnsiString; Key: Word): AnsiString;
  var
    I: Word;
    Seed: Word;
  begin
    Result := S;
    Seed := Key;
    for I := 1 to Length(Result) do
    begin
      Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
      Seed := (Byte(Result[I]) + Seed) * Word(C1) + Word(C2)
    end
  end;

  function PostProcess(const S: AnsiString): AnsiString;
  var
    SS: AnsiString;
  begin
    SS := S;
    Result := '';
    while SS <> '' do
    begin
      Result := Result + Encode(Copy(SS, 1, 3));
      Delete(SS, 1, 3)
    end
  end;
begin
  Result := PostProcess(InternalEncrypt(S, Key))
end;

function VolumeSeri(const cSurucu: char): string;
var
  Gecici: dWord;
  VolumeFlags: dWord;
  VolumeInfo: array[0..MAX_PATH] of char;
  VolumeSerialNumber: dWord;
begin
  GetVolumeInformation(PChar(cSurucu + ':\'),
    VolumeInfo, SizeOf(VolumeInfo),
    @VolumeSerialNumber, Gecici,
    VolumeFlags, nil, 0);
    Result := Format('%8x', [VolumeSerialNumber]);
end;

Function RegKayit(Lisansla:Boolean) : TSonuc;
var
  Reg      : TRegistry;
  Karakter,
  Bilgi    : String;
  i,
  HDD,
  Sayi     : Integer;
  Tek      : Char;
begin
  ZeroMemory( @Result, SizeOf(Result) );
  Reg := TRegistry.create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
// ==== Aşama (1) ====
// Registry verisini oku, Yoksa yeni veri oluştur
// ---------------------------------------------------------------------------//
    if Reg.KeyExists('software\Emanet') then
    begin // En az (1) kullanım kaydı var demektir, ilgili kaydı değerlendiriyoruz.
      Reg.OpenKey('software\Emanet', False);
      // Kaydedileni Okuyalım...
      Result.Tarih     := Reg.ReadDate   ('ActivationDate' );
      Result.Saat      := Reg.ReadTime   ('ActivationTime' );
      Result.Anahtar   := Reg.ReadString ('UnLockKey'      );
      Result.Sahip     := Reg.ReadString ('RegisteredOwner');
      Result.MachineID := Reg.ReadInteger('MachineID'      );
      Result.sTarih    := Reg.ReadDate   ('sdate'          );
      Result.Kalan     := round(Result.sTarih-date);
      Result.Expired   := Reg.ReadInteger('expired'        );
    end else
    begin // Hiçbir kullanım kaydı YOK demektir, Yeni Kayıt açıyoruz.
      if Reg.OpenKey ( 'software\Emanet', True ) then
      begin
        Reg.WriteDate   ('sdate', date+30            );
        Reg.WriteInteger('expired', 30               );
        Reg.WriteInteger('MachineID', 12291238       );
        Reg.WriteDate   ('ActivationDate', date      );
        Reg.WriteTime   ('ActivationTime', time      );
        Reg.WriteString ('UnlockKey', 'NONEDEFAULT'  );
        Reg.WriteString ('RegisteredOwner', 'UNKNOWN');

        // Kaydedileni Okuyalım...
        Result.Tarih     := Reg.ReadDate   ('ActivationDate' );
        Result.Saat      := Reg.ReadTime   ('ActivationTime' );
        Result.Anahtar   := Reg.ReadString ('UnLockKey'      );
        Result.Sahip     := Reg.ReadString ('RegisteredOwner');
        Result.MachineID := Reg.ReadInteger('MachineID'      );
        Result.sTarih    := Reg.ReadDate   ('sdate'          );
        Result.Kalan     := round(Result.sTarih-date);
        Result.Expired   := Reg.ReadInteger('expired'        );
        Reg.CloseKey;
      end else
      begin
        MessageDlg('Sistem kaynaklarına erişim engeli nedeniyle işlem yapılamadı...', mtError, [mbOk], 0);
          Reg.CloseKey;
          Reg.Free;
        Exit; // !!!
      end;
      Reg.CloseKey;
    end;

// ==== Aşama (2) ====
// Nihai Registry verisini oku, Anahtar karşılaştır
// ---------------------------------------------------------------------------//
    Karakter := VolumeSeri( 'C' );
    for i := 1 to Length( Karakter ) do
    begin
      Tek := copy(Karakter, i, 1)[1];
      if (Tek < 'A') and (Tek > '0') then Bilgi := Bilgi + Tek;
    end;

    Hdd  := StrToInt(Bilgi);
    Sayi := Round( (Hdd * Result.Tarih / 5431) * Result.Tarih );
    
    if Lisansla then
    begin // Lisansla parametresi TRUE ise direkt lisanslar...
      Result.Anahtar := Encrypt( CurrToStr(sayi), 1238 );      
      Reg.OpenKey ( 'software\Emanet', False );
      Reg.WriteString('UnLockKey', Encrypt( CurrToStr(sayi), 1238 ) );
      Reg.CloseKey;
    end;

    if Result.Anahtar <> Encrypt( CurrToStr(sayi), 1238 ) then
    begin
       if Result.Kalan > Result.Expired then
       begin
         Application.MessageBox('Kaçak Kullanım..!','HATA',mb_ok+MB_ICONERROR);
         Application.Terminate;
       end else
       begin
         Reg.OpenKey ( 'software\Emanet', False );
         Reg.WriteInteger('expired', Result.Kalan );
         Reg.CloseKey;
         if Result.Kalan < 0 then
         begin
           Application.MessageBox('DEMO için Kullanım süresi doldu..!', 'DEMO',mb_ok+MB_ICONWARNING);
           Application.Terminate;
         end;
       end;
    end else
    begin
      Result.Lisansli := True;
    end;
  finally
    Reg.free;
  end;
end;

end.
Dosya ekleri
LisansKontrol.rar
Kaynak Kodlu Proje Örneği
(208.09 KiB) 41 kere indirildi
Resim
Resim ....Resim
Başa dön
ozcank
Üye
Mesajlar: 937
Kayıt: 28 Nis 2005 05:29

Re: Lisanslama

Mesaj gönderen ozcank »

Allah senden Razı Olsun Üstadım dediklerini yaptım ve şu an çalışıyor hakkın ödenmez bu günde çok duamı aldın.
Başa dön
Cevapla

“Programlama” sayfasına dön