Ürün Seri Numarası Oluşturmak

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Kullanıcı avatarı
pasa_yasar
Üye
Mesajlar: 570
Kayıt: 07 Haz 2004 12:35

Ürün Seri Numarası Oluşturmak

Mesaj gönderen pasa_yasar »

İyi çalışmalar,

Programı müşterilere verdiğim zaman bir seri numarası kullanmak istiyorum. Windows Seri numarası gibi. bunu exe dışarıdan nasıl gömebilirim. Programı CD ye yazıp müşteriye göndermeden önce bu seri numarasını compile etmeden hazırlayacağım program ile satacağım programın içine gömmek istiyorum. exeye txt gömmeyi falan siteden aradım ama başka exeye nasıl eklerim bunu bilmiyorum. her seferinde delphide derleyemem. sonuçta her yerde delphiyi bulamam.
Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4741
Kayıt: 09 Ara 2003 08:13
Konum: İstanbul
İletişim:

Mesaj gönderen mrmarman »

Selam.

- Şahsen de kullandığım, en yaygın yöntem aktivasyon metodu.

1. Kullanıcı programı çalıştırdığında, programın kayıtlı olup olmadığı kontol edilir.

2. Kayıtlı kullanıcı değilse mesaj ile uyarılır. Bilgisayarının teknik bilgileri programın tarafından otomatik okunarak makineye özel üretilen bir kod kullanıcıya sunulur. Programcı olan seninle temas kurarak cevap kodunun talep edilmesini ister.

3. Cevap kodu, Anahtar kod ile bütünlük arz eden bir türde olmalı. Yani Programın, aktivasyon koduna karşılık gelecek kodun içeriğini önceden bilebilmeli ve/veya iki kod birleştirilip bir fonksiyona konduğunda sonuç boolean olarak olumlu dönmeli.

4. Anahtar Kod / Cevap Kodu uyumlu ise veritabanı olabilir, bilgisayarın registry kısmı olabilir veya başka bir yer olabilir şerh düşülerek kaydın onanması ve bir daha asla veya peryodik olarak sorulması programın tarafından engellenir.

5. EK olarak şahsen kullandığım gibi WSDL ile bilgisayarları birbiriyle konuşturup bu alışverişin otomatik olarak kendiliğinden yapılmasını sağlarsan kod yanlış okundu vb. durumlarla karşılaşmazsın.

- Anahtar kod yazmak öyle zor bişey değildir. En basit metod HDD Volume sori nosunu alıp harflerini birer ASCII değeri yukarı alıp istersin. Cevap kod ise cebirsel olarak bunların tümünü belli bir rakama tamamlayan karşılığı olacaktır. Mesela 9'a olan farkları...

- Bunu anlamak ve aşmak şahsım adına çok kolaydır ama hedef kitlenin ve programı talep eden kişi sayısının genelliği, bu önlemin kompleks fonksiyonlarla desteklemesiyle şekillenecektir.

// Aktivasyon Anahtar ve Key üreten bölüm.

Kod: Tümünü seç

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

Function ASCIIbirUstHex( HDDVol:String ):String;
Var
  Sayac : Integer;
begin
  Result := '';
  For Sayac := 1 to Length(HddVol) do begin
    Result := Result + Format('%d', [ Ord(HddVol[Sayac])+1 ]);
  end;
end;

Function SifiraTamamlayan( Anahtar: String ):String;
Var
  Sayac : Integer;
begin
  Result := '';
  For Sayac := 1 to Length(Anahtar) do begin
    Result := Result + Format('%d', [ 9 - StrToInt(Anahtar[Sayac]) ]);
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
   Edit1.Text := HDDVolumeSeri   ( 'C' );
   Edit2.Text := ASCIIbirUstHex  ( Edit1.Text );
   Edit3.Text := SifiraTamamlayan( Edit2.Text );
end;
Resim

// Kullanıcı Bilgisayarındaki sorgulama

Kod: Tümünü seç

Function ProgramCalissin( Anahtar, Verilen:String):Boolean;
begin
   Result := Verilen = SifiraTamamlayan( Anahtar );
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  If ProgramCalissin( Edit2.Text, Edit4.Text )
  then ShowMessage('Program Çalışabilir..')
  else ShowMessage('HATA : Yanlış Kod..');
end;
- Dediğim gibi bu sadece mantığını kavraman için etüd projesi. Kendine göre mükemmeleştirebilirsin.

- Üçüncü şahıslar tarafından KEYGEN yazılmasını engellemek zordur ama zorlaştırmak için dinamik unsurlar ekleyebilirsin. System TickCount vb. eklenerek her an değişen kodlar üretebilirsin. Tabi bu rakamı da göndermen gerekir ki sen de çözebilip cevap verebilesin :wink:

- Alış veriş yapılan kodları öyle açık göndermeyip rastgele sayılarla süsleyebilirsin. vs.

- Başarılar... :idea:
Resim
Resim ....Resim
Kullanıcı avatarı
kadirkurtoglu
Üye
Mesajlar: 748
Kayıt: 22 May 2005 01:20
Konum: Uzakta Görünen Tepeden...

Mesaj gönderen kadirkurtoglu »

bu konu açılmışken sayın @mrmarman a sormak istediğim bir kaç soru olacak. yöntemlerin yani karşılık keylerin üretildiği keygen ler nasıl algortimayı çözebiliyor.

daha da özetlersek. programın ürettiği her hangi bir değerin karşılığı gelen değerler nasıl çözülüyor. tabi burda başkaca programların çözümlenmesi konusu ortaya çıksada, ben kendi programımda kullanacağım yöntemin dışarı çıkarılmasından endişeleniyorum.

şimdi arkadaşlardan endişe yapacak bişey yok, bak miki bile müsade ediyor. veya basite ingirgeyerek programlarının herkes tarafından kullanılmasını sağlıyor. doğru olabilir, ancak ben miki değilim. yazdığım projeleri satabilme olanağım düşük.

bir diğer eleştiri ise uğraşma ne yaparsan yap programını kırarlar. program kırılsada kullanacağım algortima ile zorlaşsın istiyorum. yine başa dönersek, kırılma noktası projenin kaynağından mı yoksa matematiksel dehalıktan mı çözülüyor...
Bir mum, yanındaki mumları tutuşturmakla,
ışığında hiç bir şey kaybetmez.

Mevlana

OS win.10, IDE Delphi 10.3, RDBMS Firebird and MSSQL, BROWSER Chrome
Kullanıcı avatarı
pasa_yasar
Üye
Mesajlar: 570
Kayıt: 07 Haz 2004 12:35

Mesaj gönderen pasa_yasar »

benim amacım kullanıcın aldığı ürünün seri numarasından alan kişileri ve kopyalama durumlarını takip edebilmek. onun için programa bir çeşit ürün seri numarası satışta gömem gerekiyor.bunu veritabanına yapmam sıkıntı yaratır. en uygunu şifreli bir şekilde programa gömmek
Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4741
Kayıt: 09 Ara 2003 08:13
Konum: İstanbul
İletişim:

Mesaj gönderen mrmarman »

- Zaten programın kontrolsüz kopyalanmasına engel olmanın çerçevesi, "her önüne gelen kolayca kopyalamasın" ile sınırlı.
@kadirkurtoglu yazdı:program kırılsada kullanacağım algortima ile zorlaşsın istiyorum. yine başa dönersek, kırılma noktası projenin kaynağından mı yoksa matematiksel dehalıktan mı çözülüyor...
- Kendi uyguladığım method'un deşifre etmek istemem. Başka ögelerle anlatmaya çalışayım.

- Sihir şurada. Bir kaç katman oluşturmak.

- Program önce sistem tarihi vb.unsurlarla bir kod üretecek. Sistem tarihi/saati her an değiştiğinden kod da her defasında değişik olacak. Bu kod MD5 gibi bir algoritma ile şifrelenirse 1 harf bile değişse tüm kod baştan aşağı değişecektir. :wink:

- Bu kod bize ulaşacak ama kullanıcıdaki kod ekranı açıkken olacak. Biz o tarih/saat için KEY göndericez. (aynı tarih saati nasıl bulucaz diye soracak olursanız o da kolay, tarih bugün ise basit bir döngü ile saat'i döndürüp aynı MD5 şifrelenmiş kodu bulmak yaklaşık 10 saniyedir. Yani tarih saati de kod sonuna eklemeye lüzum yok, açık verirriz. :wink: )

- Bizim göndereceğimiz cevap (KEY) kodu sadece tetikleyici olacak şekilde tasarlamak en güzeli. Diğer bir deyişle bu kod kullanıcı bilgisayarında yer almayacak.

- Program bu tetikleyici kodu görünce kendi kendine bilgisayara özel yeni bir kod üreterek çalışacağı bilgisayara kaydedecek. Yani kod ile bilgisayar konfigurasyonu eş olacak.

- Bundan sonra program her çalıştığında bu konfigurasyon ile kod'un eş olup olmadığına bakacak. Eğer fark varsa farklı bir kod üreyeceğinden program kopyalanmıştır deyip çalışmasına son vercek.

- Ben uygulamalarımda "Program Kopyalanmış, artık çalışamaz" gibi mesajlar verdirmiyorum. Lisanlı olup olmadığını form'un başlığında sadece lisanslı olduğunda lisans sahibinin adını yazarak ifade ediyorum. Aksi haldeki uygulamam, Program rastgele bir süre çalışıyor sonra sorgusuz sualsiz kendini kapatıyor. Bunu yapmaktaki gaye, EXE içerisinden bu yaptığımız KEY kontrol lokasyonlarının tespitini güçleştirmek.

- Anlayacağın kontrollerimizi ne kadar gizleyebiliyorsak program o kadar güvende demektir. Dikkat edilecek nokta TETİK mekanizmasının sağlam olması. Çünkü bu keşfedilirse program her zaman doğru kod üretecek ve kendi kendini lisanslayacaktır. :oops:
Resim
Resim ....Resim
Kullanıcı avatarı
pasa_yasar
Üye
Mesajlar: 570
Kayıt: 07 Haz 2004 12:35

Mesaj gönderen pasa_yasar »

sattığım programda verilen şifreleri kayıt altına alıyorum. böyle bir kodlamayı yalnızca kopyalamaya karşı engellemek için uygulanıyor. ben bunu aşağı yukarı dediğiniz şekilde yaptım. programda iki numara var.
1. seri numarası fatura numarası gibi takip için
2. kopyalanmaması için sizin söylediğiniz numara. bu herseferinde değişebilir. adam yeni bir hdd alır. yeniden bunu ister. bunu yaptım. bu sorunsuz çalışıyor. benim tek istediğim sabit olan seri numarasını nasıl gömebilirim.

Adam benden servis aldığı zaman ürün seri numarasını verecek. benim programımı aracı firmalarda satıyor.
Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4741
Kayıt: 09 Ara 2003 08:13
Konum: İstanbul
İletişim:

Mesaj gönderen mrmarman »

Onu da aynı şekilde yap derim...

- Göndereceğin aktvasyon kodunun sonuna Seri nosunu da eklersin. Yani bunu sen server'den vereceksin zaten. Bu serino kullanıcının veritabanına kaydedilir.

- Kullanıcı HDD'sini formatlarsa da sana gelecek kod içerisinde daha önceki seri nosu olacağından senin kayıtlarında bulmak da kolay olacaktır.
Resim
Resim ....Resim
Kullanıcı avatarı
pasa_yasar
Üye
Mesajlar: 570
Kayıt: 07 Haz 2004 12:35

Mesaj gönderen pasa_yasar »

soruyu şu şekilde değiştirelim. oluşturduğum seri numarasını exeye dışarıdan nasıl gömebilirim. başka bir programla
Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4741
Kayıt: 09 Ara 2003 08:13
Konum: İstanbul
İletişim:

Mesaj gönderen mrmarman »

- Aynı EXE ile de gömebilirsin. Bast bir BATCH file türüğüyle bu işi kolayca halledebilirsin.

- EXE dosyanın başlık kısmına HEX editörle bakarsan şu ifateyi TEXT olarak göreceksin.

This program must be run under Win32

- Bu ifade kadar uzunlukta bir seri numarası kullanmak istersen herhangi bir işlem yapmaksızın sorunsuz BlockRead BlockWrite ile halledersin.

- İşlem basit...

1. Çalışan haldeki kendi EXE'nin örneğin BAK uzantısıyla CopyFile yardımı ile bir kopyasını çıkaracaksın.

2. Kopyasını çıkardığın EXE'Nin başlığında bu textin olduğu offsete gidip seri numarasını yazacaksın. Offset No 80 decimal oluyor...

3. Sonra bir tane BAT dosya oluşturuacaksın. Bir StringList içerisinde oluşturup onu SaveToFile ile yazarsın.

4. BAT dosya çalıştıracaksın, programı kapatacaksın. BAT dosya sazı eline alacak, orjinal EXE'yi silecek yeni dosyayı EXE adıyla rename edecek ve çalıştıracak... Sonra da BAT dosya kendini imha edecek...

Kod: Tümünü seç

        Bat := TStringList.Create;
        Bat.Add('@Echo Off' );
        Bat.Add( Format('Copy %s %s', [ChangeFileExt(Application.ExeName,'.BAK'), Application.ExeName]) );
        Bat.Add('DEL '+ChangeFileExt(Application.ExeName,'.BAK'));
        Bat.Add('DEL BAT.BAT');
        Bat.SaveToFile( ExtractFilePath(Application.Exename)+'Bat.BAT' );
        Bat.Free;

Kod: Tümünü seç

      WinExec( PChar( ExtractFilePath(Application.Exename)+'Bat.BAT'), SW_Hide );
ile BAT dosyayı çalıştırabilirsin.
Resim
Resim ....Resim
Kullanıcı avatarı
kadirkurtoglu
Üye
Mesajlar: 748
Kayıt: 22 May 2005 01:20
Konum: Uzakta Görünen Tepeden...

Mesaj gönderen kadirkurtoglu »

sayın @mrmarman verdiğiniz cevap için teşekkürler...
Bir mum, yanındaki mumları tutuşturmakla,
ışığında hiç bir şey kaybetmez.

Mevlana

OS win.10, IDE Delphi 10.3, RDBMS Firebird and MSSQL, BROWSER Chrome
Kullanıcı avatarı
bluekid
Kıdemli Üye
Mesajlar: 541
Kayıt: 11 Haz 2004 10:45
İletişim:

Mesaj gönderen bluekid »

Bu konular daha önce de konululmuştu
bakınız
viewtopic.php?t=11290&highlight=decompiler
Kullanıcı avatarı
kadirkurtoglu
Üye
Mesajlar: 748
Kayıt: 22 May 2005 01:20
Konum: Uzakta Görünen Tepeden...

Mesaj gönderen kadirkurtoglu »

daha önce konuşulduğunu biliyorum. bu başlık ta sorulan soru farklı. linkini vermiş olduğunuz topic farklı.

önceki topic Compile etmesede aynı bence !!
bu topic Ürün Seri Numarası Oluşturmak

iki topic benzer gibi görünsede biri sohbet oratmında tartışılmış. bu konu ise daha önce tartışılan konu dışında seri no oluşturmak hakkında programlama kısmında açılmış bir topic...
Bir mum, yanındaki mumları tutuşturmakla,
ışığında hiç bir şey kaybetmez.

Mevlana

OS win.10, IDE Delphi 10.3, RDBMS Firebird and MSSQL, BROWSER Chrome
Kullanıcı avatarı
bluekid
Kıdemli Üye
Mesajlar: 541
Kayıt: 11 Haz 2004 10:45
İletişim:

Mesaj gönderen bluekid »

başlangıç olarak haklısınız.
fakat
@kadirkurtoglu demiş ki:
program kırılsada kullanacağım algortima ile zorlaşsın istiyorum. yine başa dönersek, kırılma noktası projenin kaynağından mı yoksa matematiksel dehalıktan mı çözülüyor...
...
aynı noktaya dönülmüş.
Pek tabii ki aynı konu da konuşulabilir. Ama herkes oturup tekrar cevap yazmaz. ve sizin sorunuza cevap niteliğinde pek çok ayrıntıyı kaçırabilirisiniz
Seçim sizin benimki bir hatırlatmaydı.
Kullanıcı avatarı
Z.D.
Üye
Mesajlar: 104
Kayıt: 01 Nis 2006 01:48
Konum: İstanbul

Mesaj gönderen Z.D. »

Belki konu dışı ama bende geçen hafta lisans algoritmamı yeniledim. Bundan önce sabit olarak ethernet mac adresini alıyordum ancak, bilgisayar internete bağlı olmadığında ve bilgisayar ilk açılırken bazı problemlerden dolayı bundan vazgeçtim.

Ürün seri numarası olarak bilgisayarda sabit belirlerken kullandığım anakart üretici, model, serial numarası... eğer bu sabiti alırken bir problem olması halinde de ikinci bir sabit olarakta harddisk fabrika serial numarasını alıyorum. Daha sonra bunları kendi belirlediğim basit bir algoritmadan geçirip, Ürün seri numarası gibi birşey oluşturuyorum.

Böylece o bilgisayar için verdiğim serial yıllarca geçerliliğini koruyor, istediği kadar format atsın, tepinsin dursun yine beni bu konuda rahatsız edemez.

Muharrem hocamın verdiği GetVolumeInformation fonksiyonundaki volume serial her formatta değişen bir sabit, dolayısıyla bilgisayarıma format attım, yeni serial gönderin gibi isteklerle sık karşılaşılabilir. Internet üzerinden kendi serverınızdaki bir lisans veritabanına bağlanılarakta lisans girişi gerçekleştirebilir. Bir sürü lisans tekniği var ancak bence bunlar fazla düşünülecek şeyler değil, yani yeni yetme lamerleri uzak tutsun yeter. Çünkü o programa vericek parası olmayan insan ya alternetif bir program bulucak yada crack kullanıcak. Varsın cracklide olsa sizinkini kullansın.

Kod: Tümünü seç

Function GetHddSerial: String;
Function CanGetHddSerial(Prepare: Boolean): Integer;
HardDisk unitin içinde genel 2 tane fonksiyon var ama ben GetHddSerial ilkini yeterli görüyorum. 2.cisi kontrol için, yani işletim sistemi win9x felansa Smartvsd.vxd dosyasını windows/system den alıp, \System\Iosubsys\Smartvsd.vxd klasöre kopyalıyor. Daha sonra reboot felan, oOoo uzun hikaye, o yüzden ben 98 tabanlı sistemleri gözden çıkardım zaten. Vista çıkmış, ne 9x'i !!!


***************************************
*** HARD DISK FABRIKA SERI NUMARASI ***
***************************************

Kod: Tümünü seç

Unit HDD_Serial;

Interface

Uses Windows, SysUtils;

Function GetHddSerial: String;
Function CanGetHddSerial(Prepare: Boolean): Integer;

Implementation

Function GetIdeDiskSerialNumber: String;
Type
  TSrbIoControl = Packed Record
    HeaderLength: ULONG;
    Signature: Array[0..7] Of Char;
    Timeout: ULONG;
    ControlCode: ULONG;
    ReturnCode: ULONG;
    Length: ULONG;
  End;
  SRB_IO_CONTROL = TSrbIoControl;
  PSrbIoControl = ^TSrbIoControl;

  TIDERegs = Packed Record
    bFeaturesReg: Byte; // Used for specifying SMART "commands".
    bSectorCountReg: Byte; // IDE sector count register
    bSectorNumberReg: Byte; // IDE sector number register
    bCylLowReg: Byte; // IDE low order cylinder value
    bCylHighReg: Byte; // IDE high order cylinder value
    bDriveHeadReg: Byte; // IDE drive/head register
    bCommandReg: Byte; // Actual IDE command.
    bReserved: Byte; // reserved for future use.  Must be zero.
  End;
  IDEREGS = TIDERegs;
  PIDERegs = ^TIDERegs;

  TSendCmdInParams = Packed Record
    cBufferSize: DWORD; // Buffer size in bytes
    irDriveRegs: TIDERegs; // Structure with drive register values.
    bDriveNumber: Byte; // Physical drive number to send command to (0,1,2,3).
    bReserved: Array[0..2] Of Byte; // Reserved for future expansion.
    dwReserved: Array[0..3] Of DWORD; // For future use.
    bBuffer: Array[0..0] Of Byte; // Input buffer.
  End;
  SENDCMDINPARAMS = TSendCmdInParams;
  PSendCmdInParams = ^TSendCmdInParams;

  TIdSector = Packed Record
    wGenConfig: Word;
    wNumCyls: Word;
    wReserved: Word;
    wNumHeads: Word;
    wBytesPerTrack: Word;
    wBytesPerSector: Word;
    wSectorsPerTrack: Word;
    wVendorUnique: Array[0..2] Of Word;
    sSerialNumber: Array[0..19] Of Char;
    wBufferType: Word;
    wBufferSize: Word;
    wECCSize: Word;
    sFirmwareRev: Array[0..7] Of Char;
    sModelNumber: Array[0..39] Of Char;
    wMoreVendorUnique: Word;
    wDoubleWordIO: Word;
    wCapabilities: Word;
    wReserved1: Word;
    wPIOTiming: Word;
    wDMATiming: Word;
    wBS: Word;
    wNumCurrentCyls: Word;
    wNumCurrentHeads: Word;
    wNumCurrentSectorsPerTrack: Word;
    ulCurrentSectorCapacity: ULONG;
    wMultSectorStuff: Word;
    ulTotalAddressableSectors: ULONG;
    wSingleWordDMA: Word;
    wMultiWordDMA: Word;
    bReserved: Array[0..127] Of Byte;
  End;
  PIdSector = ^TIdSector;
Const
  IDE_ID_FUNCTION = $EC;
  IDENTIFY_BUFFER_SIZE = 512;
  DFP_RECEIVE_DRIVE_DATA = $0007C088;
  IOCTL_SCSI_MINIPORT = $0004D008;
  IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;
  DataSize = sizeof(TSendCmdInParams) - 1 + IDENTIFY_BUFFER_SIZE;
  BufferSize = SizeOf(SRB_IO_CONTROL) + DataSize;
  W9xBufferSize = IDENTIFY_BUFFER_SIZE + 16;
Var
  hDevice: THandle;
  cbBytesReturned: DWORD;
  pInData: PSendCmdInParams;
  pOutData: Pointer; // PSendCmdInParams;
  Buffer: Array[0..BufferSize - 1] Of Byte;
  srbControl: TSrbIoControl Absolute Buffer;

  Procedure ChangeByteOrder(Var Data; Size: Integer);
  Var ptr: PChar;
    i: Integer;
    c: Char;
  Begin
    ptr := @Data;
    For i := 0 To (Size Shr 1) - 1 Do
    Begin
      c := ptr^;
      ptr^ := (ptr + 1)^;
      (ptr + 1)^ := c;
      Inc(ptr, 2);
    End;
  End;
Begin
  Result := '';
  FillChar(Buffer, BufferSize, #0);
  If Win32Platform = VER_PLATFORM_WIN32_NT Then
  Begin // Windows NT, Windows 2000
     // Get SCSI port handle
    hDevice := CreateFile('\\.\Scsi0:', GENERIC_READ Or GENERIC_WRITE,
      FILE_SHARE_READ Or FILE_SHARE_WRITE, Nil, OPEN_EXISTING, 0, 0);
    If hDevice = INVALID_HANDLE_VALUE Then Exit;
    Try
      srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
      System.Move('SCSIDISK', srbControl.Signature, 8);
      srbControl.Timeout := 2;
      srbControl.Length := DataSize;
      srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
      pInData := PSendCmdInParams(PChar(@Buffer) + SizeOf(SRB_IO_CONTROL));
      pOutData := pInData;
      With pInData^ Do
      Begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        With irDriveRegs Do
        Begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        End;
      End;
      If Not DeviceIoControl(hDevice, IOCTL_SCSI_MINIPORT, @Buffer, BufferSize, @Buffer, BufferSize, cbBytesReturned, Nil) Then Exit;
    Finally
      CloseHandle(hDevice);
    End;
  End
  Else
  Begin // Windows 95 OSR2, Windows 98
    hDevice := CreateFile('\\.\SMARTVSD', 0, 0, Nil, CREATE_NEW, 0, 0);
    If hDevice = INVALID_HANDLE_VALUE Then Exit;
    Try
      pInData := PSendCmdInParams(@Buffer);
      pOutData := PChar(@pInData^.bBuffer);
      With pInData^ Do Begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        With irDriveRegs Do Begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        End;
      End;
      If Not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA, pInData, SizeOf(TSendCmdInParams) - 1, pOutData, W9xBufferSize, cbBytesReturned, Nil) Then Exit;
    Finally
      CloseHandle(hDevice);
    End;
  End;
  With PIdSector(PChar(pOutData) + 16)^ Do Begin
    ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
    SetString(Result, sSerialNumber, SizeOf(sSerialNumber));
    Result := Trim(Result);
  End;
End;

Function GetDeviceHandle(sDeviceName: String): THandle;
Begin
  Result := CreateFile(PChar('\\.\' + sDeviceName), GENERIC_READ Or GENERIC_WRITE,
    FILE_SHARE_READ Or FILE_SHARE_WRITE, Nil, OPEN_EXISTING, 0, 0);
End;

Function ScsiHddSerialNumber: String;
{$ALIGN ON}
Type
  TScsiPassThrough = Record
    Length: Word;
    ScsiStatus: Byte;
    PathId: Byte;
    TargetId: Byte;
    Lun: Byte;
    CdbLength: Byte;
    SenseInfoLength: Byte;
    DataIn: Byte;
    DataTransferLength: ULONG;
    TimeOutValue: ULONG;
    DataBufferOffset: DWORD;
    SenseInfoOffset: ULONG;
    Cdb: Array[0..15] Of Byte;
  End;
  TScsiPassThroughWithBuffers = Record
    spt: TScsiPassThrough;
    bSenseBuf: Array[0..31] Of Byte;
    bDataBuf: Array[0..191] Of Byte;
  End;
{ALIGN OFF}
Var
  DeviceHandle: THandle;
  dwReturned: DWORD;
  len: DWORD;
  Buffer: Array[0..SizeOf(TScsiPassThroughWithBuffers) + SizeOf(TScsiPassThrough) - 1] Of Byte;
  sptwb: TScsiPassThroughWithBuffers Absolute Buffer;
Begin
  DeviceHandle := GetDeviceHandle('C:');
  If DeviceHandle <> INVALID_HANDLE_VALUE Then Begin
    Try
      Result := '';
      FillChar(Buffer, SizeOf(Buffer), #0);
      With sptwb.spt Do Begin
        Length := SizeOf(TScsiPassThrough);
        CdbLength := 6; // CDB6GENERIC_LENGTH
        SenseInfoLength := 24;
        DataIn := 1; // SCSI_IOCTL_DATA_IN
        DataTransferLength := 192;
        TimeOutValue := 2;
        DataBufferOffset := PChar(@sptwb.bDataBuf) - PChar(@sptwb);
        SenseInfoOffset := PChar(@sptwb.bSenseBuf) - PChar(@sptwb);
        Cdb[0] := $12; // OperationCode := SCSIOP_INQUIRY;
        Cdb[1] := $01; // Flags := CDB_INQUIRY_EVPD;  Vital product data
        Cdb[2] := $80; // PageCode            Unit serial number
        Cdb[4] := 192; // AllocationLength
      End;
      len := sptwb.spt.DataBufferOffset + sptwb.spt.DataTransferLength;
      If DeviceIoControl(DeviceHandle, $0004D004, @sptwb, SizeOf(TScsiPassThrough), @sptwb, len, dwReturned, Nil) And ((PChar(@sptwb.bDataBuf) + 1)^ = #$80) Then
        SetString(Result, PChar(@sptwb.bDataBuf) + 4, Ord((PChar(@sptwb.bDataBuf) + 3)^));
      Result := Trim(Result);
    Finally
      CloseHandle(DeviceHandle);
    End;
  End;
End;

Function GetLogicalSerial: String;
Var
  D_Id, Tmp1, Tmp2: DWord;
Begin
  GetVolumeInformation(PChar('c:\'), Nil, 0, @D_Id, Tmp1, Tmp2, Nil, 0);
  Result := Format('%8.8x', [D_Id]);
End;

Function GetHddSerial: String;
Var
  NumTry: Byte;
  FinalStr: String;
Begin
  NumTry := 1;
  Repeat
    Case NumTry Of
      1: FinalStr := GetIdeDiskSerialNumber;
      2: FinalStr := ScsiHddSerialNumber;
      3: FinalStr := 'OEM';
    End;
    Inc(NumTry);
  Until (FinalStr <> '') Or (NumTry > 3);

  Result := FinalStr;
End;

Function CanGetHddSerial(Prepare: Boolean): Integer;
Var
  WinPath: Array[0..44] Of Char;
  CopyFrom: String;
  CopyTo: String;
Begin
  // Results:
  //    1 - Can get HDD Serial
  //    0 - Can get HDD Serial after reboot
  //   -1 - Can NOT get HDD Serial

  If Win32Platform = VER_PLATFORM_WIN32_NT Then
    Result := 1
  Else
  Begin
    If ScsiHddSerialNumber <> '' Then
      Result := 1
    Else
    Begin
      GetWindowsDirectory(WinPath, SizeOf(WinPath));
      CopyTo := WinPath + '\System\Iosubsys\Smartvsd.vxd';
      If FileExists(CopyTo) Then
        Result := 1
      Else
      Begin
        CopyFrom := WinPath + '\System\Smartvsd.vxd';
        If Not FileExists(CopyFrom) Then
          Result := -1
        Else
        Begin
          If Prepare Then
          Begin
            If CopyFile(PChar(CopyFrom), PChar(CopyTo), False) Then
              Result := 0
            Else
              Result := -1;
          End
          Else
            Result := -1;
        End;
      End;
    End;
  End;
End;

End.

bu kodlar zaten bana ait değil, sadece olanı paylaşıyorum. Google'da girdiğinizde istediğiniz koda ait örnek bulabilirsiniz.
=========================

Anakart model, seri no gibi sabitleri almak içinde mitec component paketindeki MSI_SMBIOS dosyasını kullandım.

************************************************
*** ANAKART URETICI, MODEL, SERI NO VS... ***
************************************************

Kod: Tümünü seç

Var
  MiTeC_SMBIOS1: TMiTeC_SMBIOS;
Begin
  {**********************************
  ***** MAINBOARD SERIAL NUMBER *****
  **********************************}
  Try
    MiTeC_SMBIOS1 := TMiTeC_SMBIOS.Create(Nil);
    MiTeC_SMBIOS1.RefreshData;
    Edit1.Text := MiTeC_SMBIOS1.MainBoardManufacturer;
    Edit2.Text := MiTeC_SMBIOS1.MainBoardModel;
    Edit3.Text := MiTeC_SMBIOS1.MainBoardVersion;
    Edit4.Text := MiTeC_SMBIOS1.MainBoardSerial;
  Except
    MiTeC_SMBIOS1.Free;
  End;
End;
eğer bu componenti bulamıyorsanız Google da MiTeC.System.Information yazıp yanına da +rapidshare gibi bir ek eklerseniz eminim bulursunuz.(özellikle geç açılan veya hiç açılmayan sayfalar için google cacheler çok işe yarar) veya aradığınızı bulmanın bir diğer yolu emule
=======================

******************
*** ÖRNEK KOD ***
******************

Kod: Tümünü seç

{************************************************
*********** DELPHI TURKIYE **********************
***** http://www.delphiturkiye.com/forum/  ******
************************************************}

Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MSI_SMBIOS;

Type
  TForm1 = Class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Button1: TButton;
    Procedure Button1Click(Sender: TObject);
  Private
    { Private declarations }
  Public
    { Public declarations }
  End;

Var
  Form1: TForm1;

Implementation

uses HDD_Serial;

{$R *.dfm}

Procedure TForm1.Button1Click(Sender: TObject);
Var
  MiTeC_SMBIOS1: TMiTeC_SMBIOS;
Begin
  {**********************************
  ***** MAINBOARD SERIAL NUMBER *****
  **********************************}
  Try
    MiTeC_SMBIOS1 := TMiTeC_SMBIOS.Create(Nil);
    MiTeC_SMBIOS1.RefreshData;
    Edit1.Text := MiTeC_SMBIOS1.MainBoardManufacturer;
    Edit2.Text := MiTeC_SMBIOS1.MainBoardModel;
    Edit3.Text := MiTeC_SMBIOS1.MainBoardVersion;
    Edit4.Text := MiTeC_SMBIOS1.MainBoardSerial;
  Except
    MiTeC_SMBIOS1.Free;
  End;

  {**********************************
  ***** HARD-DISK SERIAL NUMBER *****
  **********************************}
  Try
    Edit5.Text := GetHddSerial;
  Except
  End;

End;

End.


En son Z.D. tarafından 29 Nis 2007 05:22 tarihinde düzenlendi, toplamda 1 kere düzenlendi.
Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4741
Kayıt: 09 Ara 2003 08:13
Konum: İstanbul
İletişim:

Mesaj gönderen mrmarman »

@Z.D.'nin bahsettiği bileşen paketinin lisansı 110 euro imiş ama o da geçmiş.
Download için Sayfa Linki yazdı:MiTeC System Information Component Suite 10.2.0
Complex system information component suite for Delphi applications
- Mitec'in sitesinde şu ibare eklenmiş ve resmi sitesindeki download linki kapatılmış.
[url=http://www.mitec.cz/msi.htm]System Information Component Suite The most complex system probe in the Delphi world version 10.6.0 [/url] yazdı:MSICS is used for developing a commercial product and due to market ability of this product selling of MSICS has been stopped.
However it will be still developed and all current customers will receive updates for free in the future.
- Yani Türkçe'si Ticari bir proje geliştirildiğinden MSICS bilşene paketinin satışı durdurulmuş. Daha önce satın alanlara desteklerini sürdüklerini de eklemişler.

- Windows Vista ile birlikte eklenen UAC nedeniyle bazı sıkıntılar yaşayabilirsin, Vista'da denemeden adım atma ki başın ağrımasın.
Resim
Resim ....Resim
Cevapla