[ perabanj @ 28.04.2004. 17:21 ] @
Zna li neko kod za Visual Basic koji cita seriski broj harddiska (ne seriski broj koji nastaje prilikom formatiranja, nego njegov seriski broj) |
[ perabanj @ 28.04.2004. 17:21 ] @
[ mladenovicz @ 28.04.2004. 18:03 ] @
Pretrazi forum, neko je napravio DLL za to.
[ degojs @ 28.04.2004. 18:59 ] @
Takođe, dll potraži i na .NET forumu.
[ impact @ 28.04.2004. 23:09 ] @
Ovo sam pronašao baš na ovom forumu:
Code: Function brojdiska() Dim fs, d, s, t Set fs = CreateObject("Scripting.FileSystemObject") Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(2))) Select Case d.DriveType Case 0: t = "Unknown" Case 1: t = "Removable" Case 2: t = "Fixed" Case 3: t = "Network" Case 4: t = "CD-ROM" Case 5: t = "RAM Disk" End Select s = d.SerialNumber brojdiska = s & " " & t End Function [ degojs @ 28.04.2004. 23:47 ] @
Ne, čini mi se da je to upravo ono što je perabanj naveo da mu ne treba. Taj broj se menja prilikom formatiranja tako da i nije baš nešto pouzdan :)
[ anebojsa @ 30.04.2004. 09:08 ] @
I meni je neko napisao ovaj cod, ali se on menja.
Evo ti pravi cod. Treba ti: 1 - Textbox od Text1(0) do Text1(15) Code: Option Explicit Private Declare Function GetVolumeSerialNumber Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long Public Function VolumeSerialNumber(ByVal RootPath As String) As String Dim VolLabel As String Dim VolSize As Long Dim Serial As Long Dim MaxLen As Long Dim Flags As Long Dim Name As String Dim NameSize As Long Dim s As String Dim ret As Boolean ret = GetVolumeSerialNumber(RootPath, VolLabel, VolSize, Serial, MaxLen, Flags, Name, NameSize) If ret Then 'Create an 8 character string s = Format(Hex(Serial), "00000000") 'Adds the '-' between the first 4 characters and the last 4 characters VolumeSerialNumber = Left(s, 4) + "-" + Right(s, 4) Else 'If the call to API function fails the function returns a zero serial number VolumeSerialNumber = "0000-0000" End If End Function Private Sub Form_Load() Katanac Text1(1) = VolumeSerialNumber(Text1(0) & ":\") 'Shows the serial number of your Hard Disk Text1(3) = VolumeSerialNumber(Text1(2) & ":\") 'Shows the serial number of your Hard Disk Text1(5) = VolumeSerialNumber(Text1(4) & ":\") 'Shows the serial number of your Hard Disk Text1(7) = VolumeSerialNumber(Text1(6) & ":\") 'Shows the serial number of your Hard Disk Text1(9) = VolumeSerialNumber(Text1(8) & ":\") 'Shows the serial number of your Hard Disk Text1(11) = VolumeSerialNumber(Text1(10) & ":\") 'Shows the serial number of your Hard Disk Text1(13) = VolumeSerialNumber(Text1(12) & ":\") 'Shows the serial number of your Hard Disk Text1(15) = VolumeSerialNumber(Text1(14) & ":\") 'Shows the serial number of your Hard Disk End Sub Public Sub PreSel(txt As Control) If TypeOf txt Is TextBox Then txt.SelStart = 0 txt.SelLength = Len(txt) End If End Sub Public Sub Katanac() Text1(0).Locked = True Text1(1).Locked = True Text1(2).Locked = True Text1(3).Locked = True Text1(4).Locked = True Text1(5).Locked = True Text1(6).Locked = True Text1(7).Locked = True Text1(8).Locked = True Text1(9).Locked = True Text1(10).Locked = True Text1(11).Locked = True Text1(12).Locked = True Text1(13).Locked = True Text1(14).Locked = True Text1(15).Locked = True End Sub Private Sub Text1_GotFocus(Index As Integer) PreSel Text1(Index) End Sub Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 27 Then Unload Me End If End Sub Private Sub Text1_LostFocus(Index As Integer) PreSel Text1(Index) End Sub Pozdrav [ anebojsa @ 30.04.2004. 09:12 ] @
Zaboravio sam da ti napisem
Text1(0) treba da stoji slovo A Text1(2) treba da stoji slovo B Text1(4) treba da stoji slovo C Text1(6) treba da stoji slovo D Text1(8) treba da stoji slovo E Text1(10) treba da stoji slovo F Text1(12) treba da stoji slovo G Text1(14) treba da stoji slovo H [ mpecanac @ 23.10.2007. 22:08 ] @
Nedavno me haker urnisao tako da sam ostao bez icega. Inace, imao sam VB kod koji cita "pravi" serijski broj diska. Nisam nikada vise uspeo da pronadjem taj kod na netu. Probaj ovo, izgleda da sljaka samo je kod predugacak u odnosu na ono sto sam ja imao: http://www.dreamincode.net/code/snippet429.htm .
[ rgdrajko @ 12.04.2008. 20:17 ] @
Evo kod programa koji cita fabricki serijski broj diska(MANUFACTURER SERIAL NUMBER OF THE HARD DISK). Ceo program sa sve kodom je u dodatku.
Kod koji upisujete u klasu HDSN: Code: Option Explicit ' Antonio Giuliana, 2001-2003 ' Costanti per l'individuazione della versione di OS Private Const VER_PLATFORM_WIN32S = 0 Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Const VER_PLATFORM_WIN32_NT = 2 ' Costanti per la comunicazione con il driver IDE Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088 ' Costanti per la CreateFile Private Const FILE_SHARE_READ = &H1 Private Const FILE_SHARE_WRITE = &H2 Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const OPEN_EXISTING = 3 Private Const CREATE_NEW = 1 ' Enumerazione dei comandi per la CmnGetHDData Private Enum HDINFO HD_MODEL_NUMBER HD_SERIAL_NUMBER HD_FIRMWARE_REVISION End Enum ' Struttura per l'individuazione della versione di OS Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type ' Struttura per il campo irDriveRegs della struttura SENDCMDINPARAMS Private Type IDEREGS bFeaturesReg As Byte bSectorCountReg As Byte bSectorNumberReg As Byte bCylLowReg As Byte bCylHighReg As Byte bDriveHeadReg As Byte bCommandReg As Byte bReserved As Byte End Type ' Struttura per l'I/O dei comandi al driver IDE Private Type SENDCMDINPARAMS cBufferSize As Long irDriveRegs As IDEREGS bDriveNumber As Byte bReserved(1 To 3) As Byte dwReserved(1 To 4) As Long End Type ' Struttura per il campo DStatus della struttura SENDCMDOUTPARAMS Private Type DRIVERSTATUS bDriveError As Byte bIDEStatus As Byte bReserved(1 To 2) As Byte dwReserved(1 To 2) As Long End Type ' Struttura per l'I/O dei comandi al driver IDE Private Type SENDCMDOUTPARAMS cBufferSize As Long DStatus As DRIVERSTATUS ' ovvero DriverStatus bBuffer(1 To 512) As Byte End Type ' Per ottenere la versione del SO Private Declare Function GetVersionEx _ Lib "kernel32" Alias "GetVersionExA" _ (lpVersionInformation As OSVERSIONINFO) As Long ' Per ottenere un handle al device IDE Private Declare Function CreateFile _ Lib "kernel32" Alias "CreateFileA" _ (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long ' Per chiudere l'handle del device IDE Private Declare Function CloseHandle _ Lib "kernel32" _ (ByVal hObject As Long) As Long ' Per comunicare con il driver IDE Private Declare Function DeviceIoControl _ Lib "kernel32" _ (ByVal hDevice As Long, _ ByVal dwIoControlCode As Long, _ lpInBuffer As Any, _ ByVal nInBufferSize As Long, _ lpOutBuffer As Any, _ ByVal nOutBufferSize As Long, _ lpBytesReturned As Long, _ ByVal lpOverlapped As Long) As Long ' Per azzerare buffer di scambio dati Private Declare Sub ZeroMemory _ Lib "kernel32" Alias "RtlZeroMemory" _ (dest As Any, _ ByVal numBytes As Long) ' Per copiare porzioni di memoria Private Declare Sub CopyMemory _ Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, _ Source As Any, _ ByVal Length As Long) Private Declare Function GetLastError _ Lib "kernel32" () As Long Private mvarCurrentDrive As Byte ' Drive corrente Private mvarPlatform As String ' Piattaforma usata Public Property Get Copyright() As String ' Copyright Copyright = "HDSN Vrs. 1.00, (C) Antonio Giuliana, 2001-2003" End Property ' Metodo GetModelNumber Public Function GetModelNumber() As String ' Ottiene il ModelNumber GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER) End Function ' Metodo GetSerialNumber Public Function GetSerialNumber() As String ' Ottiene il SerialNumber GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER) End Function ' Metodo GetFirmwareRevision Public Function GetFirmwareRevision() As String ' Ottiene la FirmwareRevision GetFirmwareRevision = CmnGetHDData(HD_FIRMWARE_REVISION) End Function ' Proprieta' CurrentDrive Public Property Let CurrentDrive(ByVal vData As Byte) ' Controllo numero di drive fisico IDE If vData < 0 Or vData > 3 Then Err.Raise 10000, , "Illegal drive number" ' IDE drive 0..3 End If ' Nuovo drive da considerare mvarCurrentDrive = vData End Property ' Proprieta' CurrentDrive Public Property Get CurrentDrive() As Byte ' Restituisce drive fisico corrente (IDE 0..3) CurrentDrive = mvarCurrentDrive End Property ' Proprieta' Platform Public Property Get Platform() As String ' Restituisce tipo OS Platform = mvarPlatform End Property Private Sub Class_Initialize() ' Individuazione del tipo di OS Dim OS As OSVERSIONINFO OS.dwOSVersionInfoSize = Len(OS) Call GetVersionEx(OS) mvarPlatform = "Unk" Select Case OS.dwPlatformId Case Is = VER_PLATFORM_WIN32S mvarPlatform = "32S" ' Win32S Case Is = VER_PLATFORM_WIN32_WINDOWS If OS.dwMinorVersion = 0 Then mvarPlatform = "W95" ' Win 95 Else mvarPlatform = "W98" ' Win 98 End If Case Is = VER_PLATFORM_WIN32_NT mvarPlatform = "WNT" ' Win NT/2000 End Select End Sub Private Function CmnGetHDData(hdi As HDINFO) As String ' Rilevazione proprieta' IDE Dim bin As SENDCMDINPARAMS Dim bout As SENDCMDOUTPARAMS Dim hdh As Long Dim br As Long Dim ix As Long Dim hddfr As Long Dim hddln As Long Dim s As String Select Case hdi ' Selezione tipo caratteristica richiesta Case HD_MODEL_NUMBER hddfr = 55 ' Posizione nel buffer del ModelNumber hddln = 40 ' Lunghezza nel buffer del ModelNumber Case HD_SERIAL_NUMBER hddfr = 21 ' Posizione nel buffer del SerialNumber hddln = 20 ' Lunghezza nel buffer del SerialNumber Case HD_FIRMWARE_REVISION hddfr = 47 ' Posizione nel buffer del FirmwareRevision hddln = 8 ' Lunghezza nel buffer del FirmwareRevision Case Else Err.Raise 10001, "Illegal HD Data type" ' Altre informazioni non disponibili '(Evoluzione futura) End Select Select Case mvarPlatform Case "WNT" ' Per Win NT/2000 apertura handle al drive fisico hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive, _ GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, _ 0, OPEN_EXISTING, 0, 0) Case "W95", "W98" ' Per Win 9X apertura handle al driver SMART ' (in \WINDOWS\SYSTEM da spostare in \WINDOWS\SYSTEM\IOSUBSYS) ' che comunica con il driver IDE hdh = CreateFile("\\.\Smartvsd", _ 0, 0, 0, CREATE_NEW, 0, 0) Case Else ' Piattaforma non supportata (Win32S) Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)" ' Altre piattaforme non gestite End Select ' Controllo validita handle If hdh = 0 Then Err.Raise 10003, , "Error on CreateFile" End If ' Azzeramento strutture per l'I/O da driver ZeroMemory bin, Len(bin) ZeroMemory bout, Len(bout) ' Preparazione parametri struttura di richiesta al driver With bin .bDriveNumber = mvarCurrentDrive .cBufferSize = 512 With .irDriveRegs If (mvarCurrentDrive And 1) Then .bDriveHeadReg = &HB0 Else .bDriveHeadReg = &HA0 End If .bCommandReg = &HEC .bSectorCountReg = 1 .bSectorNumberReg = 1 End With End With ' Richiesta al driver DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, _ bin, Len(bin), bout, Len(bout), br, 0 ' Formazione stringa di risposta ' da buffer di uscita ' L'ordine dei byte e' invertito s = "" For ix = hddfr To hddfr + hddln - 1 Step 2 If bout.bBuffer(ix + 1) = 0 Then Exit For s = s & Chr(bout.bBuffer(ix + 1)) If bout.bBuffer(ix) = 0 Then Exit For s = s & Chr(bout.bBuffer(ix)) Next ix ' Chiusura handle CloseHandle hdh ' Restituzione informazione richiesta CmnGetHDData = Trim(s) End Function I kod koji upisujete u formu: Code: [/code]Option Explicit 'VERSION 1.0 CLASS '-------------------------------------------------------------------------- ' 'In the form, place a combobox with values 0,1,2,3 represents Primary Master, Primary Slave, ' 'Secondary Master & Secondary Slave HDDs. ' 'Code is Dim h As HDSN Private Sub cmdGo_Click() Dim hT As Long Dim uW() As Byte Dim dW() As Byte Dim pW() As Byte Set h = New HDSN With h .CurrentDrive = Val(cbDrive.Text) lstInfo.Clear lstInfo.AddItem "Current drive: " & .CurrentDrive lstInfo.AddItem "" lstInfo.AddItem "Model number: " & .GetModelNumber lstInfo.AddItem "Serial number: " & .GetSerialNumber lstInfo.AddItem "Firmware Revision: " & .GetFirmwareRevision lstInfo.AddItem "" lstInfo.AddItem "Copyright: " & .Copyright End With Set h = Nothing End Sub Private Sub Form_Load() cbDrive.AddItem "0" cbDrive.AddItem "1" cbDrive.AddItem "2" cbDrive.AddItem "3" cbDrive.ListIndex = 0 End Sub [ Shadowed @ 12.04.2008. 20:20 ] @
Je l' stvarno potreban sav taj kod?
E, ne ide Rajku od ruke ovo koriscnjenje ubb kodova pa to ti je :] [ stefanpn @ 12.04.2008. 20:34 ] @
Moze li ovo da se izvede bez S.M.A.R.T.-a i bez Win32, znaci FreeBASIC i DOS?
Ovo u Windowsu i nije neka mustra, ali kad pod DOS-om pokusam da ocitam hdd kontroler racunar mi jednostavno blokira... Pa se pitam da li postoji neki low-level Bios poziv za to? [ rgdrajko @ 12.04.2008. 21:00 ] @
Moze za DOS ali u Pascalu http://community.freepascal.or...e_id=117587&forum_id=24089
[ Eurora3D Team @ 12.04.2008. 23:40 ] @
@Stefane ajd vec jednom objasni kako se uopste pravi DOS program u FreeBasicu pa mozda nesto i uradimo :)
Ja imam FreeBasic za win32 i FbEdit IDE ... trebam da skinem DOS verziju ? Zakacio sam kod i kompajlovanu verziju (com fajl) koji sam nasao na netu ... nesto cita :) sad dali je broj pravi ko zna (bar je unikatan) fajl sistem jeste tacano pronadjen ... Pogledaj Code: mov bx,03h ; 1 = a:, 2 = b:, 3 = c:, etc za promenu diska Inace (kao sto se vidi) ovo je asm kod za MASM assembler, a FreeBasic ima podrsku za inline assembler [ stefanpn @ 12.04.2008. 23:51 ] @
evo linka za download FBCDOS kompajlera:
http://downloads.sourceforge.n...IC-v0.18.4b-dos32.zip?download ako ga koristis u sirovom dos-u treba ti i neki *dpmi.exe posto je 32-bitni compiler. Kod je kompatibilan sa win32 verzijom (cak i gfx, s' tim sto se koristi VESA driver). Inace sam ja kod pisao i kompajlirao pod windows-om(fbc-dos). Ako mozes pomagaj, mislim da ovo cita onaj promenljivi broj ali nema veze, da je bar nesto... [ Eurora3D Team @ 13.04.2008. 11:45 ] @
@stefanpn
FB HD serial Preveo sam ovaj asm kod u FB za DOS Dok sam ga pravio i probao windows je pitao "aplikacija hoce da pristupi disku ... dozvoliti ?" posle par puta vise nije pitao (pretpostavljam da je operacija zabranjena i ne izvrsava se a prvih par puta je radio) tako da ustvari ne znam dali kod stvarno radi jer konacni kod nisam mogao da isprobam. Ovaj asm kod iz proslog teksta se kompajlira u com format i tu nema problema a FB za dos pravi dos exe fajl (i to 32 bitni ? koliko sam shvatio) i tu nastaje taj problem ... com verzija se izvrsava bez provere ... Nemoj da kompajlujes ovaj kod kao windows app (FB za win32) zato sto koristi int (privilegovanu instukciju) i napravice runtime error Probaj da otkrijes dali FB za DOS moze da napravi com fajl ... ja sam kompajlovao ovaj fajl sa fbc "hd.bas" Code: Dim InfoLevel As ULong Dim LO As Integer ' LOWORD Dim HI As Integer 'HIWORD Dim SerialNoStr As String Asm 'FN za dobijanja informacija o HD-u mov bx,1 ' 1 = a:, 2 = b:, 3 = c:, etc ' Broj diska mov cx,&h0866 ' 08h = disk, 66h = get Media ID ' opis funkcije mov dx,[InfoLevel] ' dx = offset of buffer ' Adresa Buffera int &h21 ' do it ' Interrupt 21h koji izvrsava FN ' 'Vrednost je zapisana na adresi koja je u bx registru mov ax,[bx+2] ' get LO order of double word push ax pop LO mov ax,[bx] ' get HI order of double word push ax pop HI End Asm SerialNoStr = Str(LO) & " - " & Str(HI) Print "Serial Number: "& SerialNoStr [ Eurora3D Team @ 13.04.2008. 15:11 ] @
@Rajko ovaj VB kod koji si okacio radi ... hvala
[ rgdrajko @ 13.04.2008. 18:31 ] @
Pa da. Odskoro svaki kod pre nego sto okacim proverim i dam izvorni i izvrsni kod u zip formatu, tako je lakse za sve. Ucim se.
Inace taj kod ima ogromne mogucnosti kod zastite programa od kopiranja, preko fabrickog broja hard diska, tj. taj kod sa komandom XOR i i nekom nasom sifrom daje kod koji korisnik preko telefona ili e-mailom mora da javi programeru, ovo radi i microsoft, i kada korisnik dobije drugi kod kao rezultat i taj fajl program pre startovanja ocitava i desifruje u njemu fabricki serijski brioj diska i taj broj onada uporedjuje sa stvarnim fabrickim serijskim brojem diska ocitanog preko klase unutar programa. Normalno taj fajl sa rezultatom treba sakriti negde na disku pod nekim slicnim imenom windows fajlova i sa ekstenzijom sistemskih ili exe fajlova(sys, bat, exe, dll, reg...) (iako je sam fajl tekstualni), promeniti datum i vreme na datum i vreme u okviru tog foldera i kao atribut staviti npr system ili hiden ili readonly... Normalno moze se staviti da sam program svaki put fajl sa rezultatom upisuje na drugu poziciju t. folder.... Da neko ne bi pokusao desifrovanje fajla sa rezultatom. Normalno to moze neko od nas programera koji ima ovaj kod za fabricki serijski broj diska. I to je to. Ima i drugih zastita, ali nesto mora ostati i tajna.... [ stefanpn @ 13.04.2008. 18:45 ] @
@Eurora - HVALA!
[ stefanpn @ 14.04.2008. 03:12 ] @
Doslo je do greske prilikom izvrsavanja ovog poslednjeg koda iz FreeDOS-a :(
Evo i opisa: ![]() Malo je losijeg kvaliteta, slikano je telefonom i pod uglom :( [ Eurora3D Team @ 14.04.2008. 14:39 ] @
Znam ... probao sam na Virtual PC - u
Izgleda da ne moze tako u FB-u ... Copyright (C) 2001-2025 by www.elitesecurity.org. All rights reserved.
|