usb dongle gibi usb seri numarasını kullanarak şifreleme yap

[forumsad]

arkadaşlar

O-KEY SILVER diye dongle usb yazılım kilitleri satılıyor..

benzer şekilde usb flah-belleklerin seri no larını kullanarak şifreleme yapabilirmiyiz ...


saygılarımla

[forumsad]

function GetDiskVolSerialID(ADriveName: Char): Cardinal;
var
DiskDrive: string;
FileSystemFlags: DWORD;
VolumeSerialNumber: DWORD;
MaximumComponentLength: DWORD;
begin
DiskDrive := ADriveName + ':\';
GetVolumeInformation(PChar(DiskDrive),
nil,
0,
@VolumeSerialNumber,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
Result := VolumeSerialNumber;
Form1.Label1.Caption:=IntToStr( VolumeSerialNumber);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
GetDiskVolSerialID('F');
end;

böyle bir şey buldum ama ...

[greenegitim]

viewtopic.php?f=2&t=29069

[White Rose]

function GetDiskVolSerialID(ADriveName: Char): Cardinal;
var
DiskDrive: string;
FileSystemFlags: DWORD;
VolumeSerialNumber: DWORD;
MaximumComponentLength: DWORD;
begin
DiskDrive := ADriveName + ':\';
GetVolumeInformation(PChar(DiskDrive),
nil,
0,
@VolumeSerialNumber,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
Result := VolumeSerialNumber;
Form1.Label1.Caption:=IntToStr( VolumeSerialNumber);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
GetDiskVolSerialID('F');
end;

böyle bir şey buldum ama ...

Yukardaki kod formatla değişen HDD seri numarasını verir. USB flas disklerin fabrika seri numaraları vardır onu kullanabilirsiniz.
component olarak miTEC var ama ücretli bir de mrmarman 'ın örneği var yukardaki linkte onu da inceleyebilirsiniz.

[forumsad]

linkte verilen bedava kompenantı yükledim örnek kodu aşağıdaki şekilde sadeleştirdim

orhancc hocamız;
Bedava eklenti var kullanırsan.
http://neftali.clubdelphi.com/?p=586

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
var
  PorcOcup, PorcFree:Integer;
begin
DiskInfo1.DriveLetter := 'K';
    // Kullanılabilir mi?
    if (DiskInfo1.IsReady) then begin
      PorcFree := Round((DiskInfo1.DriveFree.InKB / DiskInfo1.DriveSize.InKB) * 100);
      PorcOcup := 100 - PorcFree;
    end
    else begin
      PorcFree := 0;
      PorcOcup := 0;
    end;

    ShowMessage(DiskInfo1.SerialNumber);

end;

sorun şu sabit disklerinseri numaralarını gösteriyor ama flah belleğe istediğimde hata veriyor okuyamıyor.....orjinal demodada hata veriyor

saygılarımla

[mrmarman]

Merhaba.

Windows Sürücü modelinde takıldığımız yerde Windows Registry yardıma koşuyor.

HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\USBSTOR

registry bağlantısında tüm bilgi mevcut. Buradaki alt başlıklardan sonu "&0" ile bitenler seri numaralarıdır. Aşağıdaki procedure ile bu kısmı parse ederek listeleme yaptım.

Aşağıda verdiğim procedure ile USB'ye takılmış tüm disk sürücü ve usb memory için varsa seri numarasını alabilirsiniz.

Başarılar.

Kod: Tümünü seç

uses Registry;

procedure USBSeriNolariniDoldur( Liste:TStrings );
Var
  Reg : TRegistry;
  i,j   : Integer;
  aList, bList : TStringList;
  aKey, bKey, Marka, SeriNo : String;
begin
  Liste.Clear;
  aList := TStringList.Create;
  bList := TStringList.Create;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  aKey := 'SYSTEM\CurrentControlSet\Enum\USBSTOR';
  if Reg.OpenKeyReadOnly( aKey ) then
  begin
    Reg.GetKeyNames( aList );
    Reg.CloseKey;
    for i := 0 to aList.Count - 1 do
    begin
      bKey := aKey + '\' + aList[i];
      if Reg.OpenKeyReadOnly( bKey ) then
      begin
        Reg.GetKeyNames(bList);
        Reg.CloseKey;
        for j := 0 to bList.Count - 1 do
        begin
          if Reg.OpenKeyReadOnly( bKey + '\' + bList[j] ) then
          begin
            Marka := Reg.ReadString('FriendlyName');
            if Pos('&0', bList[j]) > 0
              then SeriNo := Copy(bList[j], 1, Pos('&0', bList[j])-1)
              else SeriNo := 'bulunamadı...';
            Liste.Add( Marka + '-' + ' s/n: ' +SeriNo);
            Reg.CloseKey;
          end;
        end;
        Reg.CloseKey;
      end;
    end;
  end else showmessage('Olmadı');
  Reg.Free;
end;

Kullanımı :

Kod: Tümünü seç

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   USBSeriNolariniDoldur( Memo1.Lines );
end;