各位大哥：能帮我一把吗？有请。。。(100分)

凤仙花 · 2003-09-21

我是新手，慕名Delphi而苦苦地学起了Delphi！！！不知有何捷径能让我快速掌握Delphi的数据库编程技术？          既然来了，何不帮我新手一把？！： 【我要提的问题】：如何用delphi取得： CPU硬件编号、硬盘物理系列号（不是格式化系列号）？我想这是你们高手发布程序时都是要用到的加密问题，应该是小事一桩！      有完整的例子文件吗？      先谢谢个位了！

D影子D · 2003-09-21

找控件了

凤仙花 · 2003-09-21

哪个控件？ 哪里有？ 谢谢～

liwens · 2003-09-21

借花献佛；取得硬盘序列号： Function GetHardDiskSerieNummer : string; var   Teller      : integer;   Lus         : integer;   SerieNummer : array[0..24] of char; begin   result := '';   Teller := 1;   for Lus := 1 to 8 do   begin    SerieNummer[Teller] := chr((HardDiskGegevens[10+Lus] div 256 ));    inc(Teller);    SerieNummer[Teller] := CHR((HardDiskGegevens[10+Lus] mod 256 ));    inc(Teller);   end;   result := SerieNummer;  end; 取得CPU编号： TCPUIDARRAY=array[1..4] of Longint; function GetCPUID : TCPUIDARRAY; assembler;register; asm   PUSH    EBX         {Save affected register}   PUSH    EDI   MOV     EDI,EAX     {@Resukt}   MOV     EAX,1   DW      $A20F       {CPUID Command}   STOSD {CPUID[1]}   MOV     EAX,EBX   STOSD               {CPUID[2]}   MOV     EAX,ECX   STOSD               {CPUID[3]}   MOV     EAX,EDX   STOSD               {CPUID[4]}   POP     EDI {Restore registers}   POP     EBX end;

bjaman · 2003-09-21

以下转载自：http://www.delphiok.com/，即delphi技巧网 --------------------------------》》》》》》》》》》  69、如何在DELPHI5中通过程序获取计算机一系列硬件信息？   1、申明部份： uses ....Winsock,Registry,NB30.... ...... implementation ...... var s4,s5:string; type TNBLanaResources = (lrAlloc, lrFree); type PMACAddress = ^TMACAddress; TMACAddress = array[0..5] of Byte; type TGate = record Off2,op,seg,off1:WORD; end; LONGDWORD = INT64; var IDTR: LONGDWORD; SavedGate:TGate; OurGate: TGate; dd: array [0..256] of word; dsn:array [0..20] of char; {$R *.DFM} //以下函数用以获得硬盘出厂序列号。 procedure Ring0Proc(); asm // Wait for controller not busy mov dx,01f7h @1:in al,dx cmp al,050h jne @1 // Get first/second drive dec dx mov al,0a0h out dx,al // Get drive info data inc dx mov al,0ech out dx,al nop nop // Wait for data ready @2:in al,dx cmp al,058h jne @2 nop nop // Read sector xor ecx,ecx mov dx,01f0h @3:in ax,dx mov word ptr dd[ecx*2],ax inc ecx cmp ecx,256 jne @3 iretd end; procedure Change2Ring0(); begin asm mov eax, offset Ring0Proc mov OurGate.off2, ax shr eax, 16 mov OurGate.off1, ax mov OurGate.op,0028h mov OurGate.seg,0ee00h mov ebx,offset IDTR sidt [ebx] mov ebx, dword ptr [IDTR+2] add ebx, 8*3 mov edi, offset SavedGate mov esi, ebx movsd movsd mov edi, ebx mov esi, offset OurGate cli movsd movsd sti mov eax,6200h mov ecx,0 int 3h mov edi, ebx mov esi, offset SavedGate cli movsd movsd sti end; asm xor ecx,ecx mov ebx,offset dd[10*2] @4:mov ax,[ebx] mov byte ptr dsn[ecx],ah inc ecx mov byte ptr dsn[ecx],al inc ebx inc ebx inc ecx cmp ecx,10 jne @4 end; showmessage(dsn); end; //以下函数用以获得系统时间。 function GetSystemTime : AnsiString; var stSystemTime : TSystemTime; begin Windows.GetSystemTime( stSystemTime ); Result := DateTimeToStr( SystemTimeToDateTime( stSystemTime ) ); end; //以下函数用以获得本地时间。 function GetLocalTime : AnsiString; var stSystemTime : TSystemTime; begin Windows.GetLocalTime( stSystemTime ); Result := DateTimeToStr( SystemTimeToDateTime( stSystemTime ) ); end; //以下函数用以获得计算机名。 function GetComputerName: AnsiString; var lpBuffer: array[0..MAX_PATH] of char; dwSize: DWORD; begin dwSize:= MAX_PATH; if not Windows.GetComputerName(lpBuffer, dwSize) then raise Exception.Create(SysErrorMessage(GetLastError())); Result:= StrPas(lpBuffer); end; {function GetUserName: AnsiString; var lpBuffer: array[0..MAX_PATH] of char; dwSize: DWORD; begin dwSize:= MAX_PATH; if not Windows.GetUserName(lpBuffer, dwSize) then raise Exception.Create(SysErrorMessage(GetLastError())); Result:= StrPas(lpBuffer); end;} //以下函数用以获得计算机BIOS系统信息。 function GetBios(value: integer): String; // 1...Bios Type // 2.. Bios Copyright // 3.. Bios Date // 4.. Bios Extended Info // 5.. Bustype // 6.. MachineType begin result:='(unavailable)'; case value of 1: result:=String(Pchar(Ptr($FE061))); 2: result:=String(Pchar(Ptr($FE091))); 3: result:=String(Pchar(Ptr($FFFF5))); 4: result:=String(Pchar(Ptr($FEC71))); end; end; //以下函数是用以获得WINDOWS序列号函数中所调用的函数。 Function HexByte( b : Byte ) : String; Const Hex : Array[ $0..$F ] Of Char = '0123456789ABCDEF'; Begin HexByte := Hex[ b Shr 4 ] + Hex[ b And $F ]; End; Function HexWord( w : Word ) : String; Begin HexWord := HexByte( Hi( w ) ) + HexByte( Lo( w ) ); End; Function DecToHex( aValue : LongInt ) : String; Var w : Array[ 1..2 ] Of Word Absolute aValue; Begin Result := HexWord( w[ 2 ] ) + HexWord( w[ 1 ] ); End; //以下函数用以获得网卡地址。 function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte; var AdapterStatus: PAdapterStatus; StatNCB: PNCB; begin New(StatNCB); ZeroMemory(StatNCB, SizeOf(TNCB)); StatNCB.ncb_length := SizeOf(TAdapterStatus) + 255 * SizeOf(TNameBuffer); GetMem(AdapterStatus, StatNCB.ncb_length); try with StatNCB^ do begin ZeroMemory(MACAddress, SizeOf(TMACAddress)); ncb_buffer := PChar(AdapterStatus); ncb_callname := '* ' + #0; ncb_lana_num := Char(LanaNum); ncb_command := Char(NCBASTAT); NetBios(StatNCB); Result := Byte(ncb_cmd_cplt); if Result = NRC_GOODRET then MoveMemory(MACAddress, AdapterStatus, SizeOf(TMACAddress)); end; finally FreeMem(AdapterStatus); Dispose(StatNCB); end; end; function GetLanaEnum(LanaEnum: PLanaEnum): Byte; var LanaEnumNCB: PNCB; begin New(LanaEnumNCB); ZeroMemory(LanaEnumNCB, SizeOf(TNCB)); try with LanaEnumNCB^ do begin ncb_buffer := PChar(LanaEnum); ncb_length := SizeOf(TLanaEnum); ncb_command := Char(NCBENUM); NetBios(LanaEnumNCB); Result := Byte(ncb_cmd_cplt); end; finally Dispose(LanaEnumNCB); end; end; //以下函数用以得本机IP地址。 function LocalIP : string; type TaPInAddr = array [0..10] of PInAddr; PaPInAddr = ^TaPInAddr; var phe : PHostEnt; pptr : PaPInAddr; Buffer : array [0..63] of char; I : Integer; GInitData : TWSADATA; begin WSAStartup($101, GInitData); Result := ''; GetHostName(Buffer, SizeOf(Buffer)); phe :=GetHostByName(buffer); if phe = nil then Exit; pptr := PaPInAddr(Phe^.h_addr_list); I := 0; while pptr^ <> nil do begin result:=StrPas(inet_ntoa(pptr^^)); Inc(I); end; WSACleanup; end; //以下函数用以获得WINDOWSID号。 function GetWindowsProductID: string; var reg:TRegistry; begin Result := ''; reg := TRegistry.Create; with reg do begin RootKey := HKEY_LOCAL_MACHINE; OpenKey('Software', False); Result := ReadString('ProductID'); end; reg.Free; end; //以下是在窗口出现时，显示计算机的硬件信息。 procedure TForm2.FormCreate(Sender: TObject); var s0,s1,s2,s3:string; //s4,s5:string为全程变量 n1,n2:longint; myfile:textfile; userschar; i:dword; MACAddress: PMACAddress; RetCode: Byte; var fulldrive :string[3]; tmp_drive :array[0..2] of char; VolName :array[0..255] of Char; SerialN WORD; MaxCLength WORD; FileSysFlag WORD; FileSysName :array[0..255] of Char; begin Label2.Caption:='你的IP地址是: '+LocalIP; label3.caption:='你的windowsID是：'+GetWindowsProductID; New(MACAddress); try RetCode := GetMACAddress(0, MACAddress); if RetCode = NRC_GOODRET then begin label5.caption := '你的网卡地址是：'+Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x', [MACAddress[0], MACAddress[1], MACAddress[2], MACAddress[3], MACAddress[4], MACAddress[5]]); end; finally Dispose(MACAddress); end; i:=255; getmem(users,255); getusername(users,i); //获得Windows用户名 label6.caption:='你登录windows的用户名是 :'+users; freemem(users); fulldrive:='c:; strpcopy(tmp_drive,fulldrive); GetVolumeInformation(tmp_drive, VolName, 255, @SerialN, MaxCLength,FileSysFlag, FileSysName, 255); label7.caption:='你的硬盘卷标是：'+VolName; label8.caption:='你的硬盘序列号是：'+DecToHex(SerialN); label9.caption:='你的计算机名是：'+getcomputername; IF getbios(1)<>'' then label10.caption:='你的BIOS版本号是：'+getbios(1) else label10.caption:='未取得BIOS版本号'; if getbios(2)<>'' then label11.caption:='你的BIOS序列号是：'+getbios(4) else label11.caption:='未取得BIOS序列号'; if getsystemtime<>'' then label12.caption:='你的系统时间是：'+getsystemtime else label12.Caption:='未取得系统时间'; if getlocaltime<>'' then label13.caption:='你的本地时间是：'+getlocaltime else label13.caption:='未取得本地时间'; if inttostr(DiskSize(3) div 1024)<>'' then label14.caption:='你的系统硬盘空间是：'+inttostr(DiskSize(3) div 1024) else label14.caption:='未取得系统硬盘间'; procedure TForm2.Button2Click(Sender: TObject); begin Change2Ring0(); end; 说明：     由于以上操作需要在申明处加入：Winsock,Registry,NB30     以上方法在DELPHI5、WINDOWS98下通过。

凤仙花 · 2003-09-21

不知怎么回事～我总是不能delphi7编译、运行！ 各位大哥，好人做到底，能否干脆做个示例工程发到我mail好吗？谢谢～ fxhua1979@163.com

各位大哥：能帮我一把吗？有请。。。(100分)

凤仙花

Unregistered / Unconfirmed

D影子D

Unregistered / Unconfirmed

凤仙花

Unregistered / Unconfirmed

liwens

Unregistered / Unconfirmed

bjaman

Unregistered / Unconfirmed

凤仙花

Unregistered / Unconfirmed

Similar threads

各位大哥： 能帮我一把吗？有请。。。(100分)

凤仙花

Unregistered / Unconfirmed

D影子D

Unregistered / Unconfirmed

凤仙花

Unregistered / Unconfirmed

liwens

Unregistered / Unconfirmed

bjaman

Unregistered / Unconfirmed

凤仙花

Unregistered / Unconfirmed

Similar threads

各位大哥：能帮我一把吗？有请。。。(100分)