小弟第一次做加密程序,现高分求购读取硬盘或CPU或BIOS序列号的源代码?谢谢。我只能给100分,如果不购再加可以吗?
解决方案 »
- 网络上的注册表随意跳是如何编写的?
- c58342418..
- 如果一个三层系统有几千客户端连接,那这个系统用什么技术好,要注意一些什么,请高手帮忙指教,分不够再加
- 求一段简单的代码:能在页面用脚本调用一个函数.....
- AdvStringGrid 折叠的问题。。。。。麻烦大家看看
- 请教学网络数据库编程的好书
- 关联表(参照完整性)删除记录问题
- 请问带OCX的程序如何打包啊???
- 一个很容易的画图问题(初学者)
- 在两个表单间传递参数的问题请高手指教
- 求版主别删除!尊敬的大侠:您好!明天我要去应聘网络管理、维护人员。网络管理、维护人员是干些什么事情的?他们可能会问什么问题(技术
- 怎样让dbgrid的的某一列可编辑,其他列不能编辑。
CoDelphi.com
摘 要:用Delphi调用Bios的信息
关键字:BIOS
类 别:系统控制
CoDelphi.com版权所有,未经允许,不得进行任何形式转载
添加一个Tbutton和一个Tmemo组件到窗体并写如下代码到按钮的OnClick事件:
with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end; 以上代码在Win9X上运行通过。
{$R BiosInfo.res}interfaceuses
Windows, Messages, Classes, Controls, Forms, dsgnintf;type TAboutBiosInfo = class(TPropertyEditor)
private
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
end; TMainBoardBiosInformation = class(TComponent)
private
{ Private declarations }
FAbout:TAboutBiosInfo;
FMainBoardBiosName,
FMainBoardBiosCopyright,
FMainBoardBiosDate,
FMainBoardBiosSerialNo:string;
protected
{ Protected declarations }
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure Refresh;
published
{ Published declarations }
property About : TAboutBiosInfo read FAbout write FAbout;
property MainBoardBiosName : string read FMainBoardBiosName write FMainBoardBiosName;
property MainBoardBiosCopyright : string read FMainBoardBiosCopyright write FMainBoardBiosCopyright;
property MainBoardBiosDate : string read FMainBoardBiosDate write FMainBoardBiosDate;
property MainBoardBiosSerialNo : string read FMainBoardBiosSerialNo write FMainBoardBiosSerialNo;
end;procedure Register;implementation{ TAboutBiosInfo }procedure TAboutBiosInfo.Edit;
begin
Application.MessageBox('By izzet uslu - 2000'#13#13'E-Mail : [email protected]'#13'WEB : http://members.xoom.com/izus','Mainboard Bios Information component version 1.0', MB_OK+ MB_ICONINFORMATION);
end;function TAboutBiosInfo.GetAttributes: TPropertyAttributes;
begin
GetAttributes:=[paDialog, paReadOnly];
end;function TAboutBiosInfo.GetValue: string;
begin
GetValue:='(About)';
end;{ TMainBoardBiosInformation }
constructor TMainBoardBiosInformation.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
Refresh;
end;destructor TMainBoardBiosInformation.Destroy;
begin
inherited Destroy;
end;procedure TMainBoardBiosInformation.Refresh;
begin
try
fMainBoardBiosName := String(Pchar(Ptr($FE061)));
fMainBoardBiosCopyright := String(Pchar(Ptr($FE091)));
fMainBoardBiosDate := String(Pchar(Ptr($FFFF5)));
fMainBoardBiosSerialNo := String(Pchar(Ptr($FEC71)));
except
fMainBoardBiosName := 'Unsupported';
fMainBoardBiosCopyright := 'Unsupported';
fMainBoardBiosDate := 'Unsupported';
fMainBoardBiosSerialNo := 'Unsupported';
end;
end;procedure Register;
begin
RegisterComponents('izus', [TMainBoardBiosInformation]);
RegisterPropertyEditor(TypeInfo(TAboutBiosInfo), TMainBoardBiosInformation, 'ABOUT', TAboutBiosInfo);
end;
end.
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,DsgnIntf;
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. Must be zero.
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs; TSendCmdInParams = packed record
cBufferSize : DWORD;
irDriveRegs : TIDERegs;
bDriveNumber : Byte;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte;
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;
type TDISKSN = class(TComponent)
private
FAbout : string;
FSerialNumber: string;
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent); override;
procedure Loaded; override;
destructor Destroy; override;
procedure ShowAbout;
{ Public declarations }
published
{ Published declarations }
property About: string read FAbout write FAbout stored False;
property GetDiskSN :string read FSerialNumber;
end;procedure Register;implementation
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; //存放硬盘序列号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 @3iretd //中断返回
end;
procedure Change2Ring0();
var i :integer;
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]
// 将 中 断 描 述 符 表 寄 存 器(IDTR)的 内 容 取 出
mov ebx, dword ptr [IDTR+2]
// 取 出 中 断 描 述 符 表(IDT) 基 地 址
add ebx, 8*3
// 计 算Int 3 的 描 述 符 应 放 置 的 地 址 选 用
//Int3 是 因 为 它 在Win32 保 护 模 式 下 未 占 用
mov edi, offset SavedGate
mov esi, ebx
movsd // 保 存 原 来 的Int 9 描 述 符 到
movsd //SavedGate 以 便 恢 复mov edi, ebx
mov esi, offset OurGate
cli
movsd // 替 换 原 来 的 中 断 门 描 述 符
movsd // 以 安 装 中 断 服 务 例 程
sti
mov eax,6200h
// 用 以 测 试 放 在EAX 中 的 数 据 能 否 正 确 传 到Ring0 中 断
mov ecx,0
// 用 以 测 试 放 在ECX 中 的 数 据
// 能 否 正 确 传 到Ring0 中 断
// 因 为 很 多VxD 服 务 都 用此二 寄 存 器 传 递 参 数
int 3h
// 人 为 触 发 中 断, 平 时 会 出 现保 护 错 误 蓝 屏 或 非 法 操
// 作 对 话 框, 现 在 安 装 了
// 中 断 服 务 例 程 后, 就 会 通 过
//VMM 在Ring0 调 用 中 断 服 务 例 程Ring0Proc
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,20
jne @4
end;
for i:=0 to 10 do
dsn[i]:=dsn[i+10];
end;
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;
多数实例都不能在W2000或winxp下执行
===============================================================
笑眯眯的看着你
var
a:array[0..15] of byte;
dword save_edi, save_esi, save_esp, save_ebp, save_ebx;
begin
asm
mov save_edi, EDI
mov save_esi, ESI
mov save_esp, ESP
mov save_ebp, EBP
mov save_ebx, EBX
mov eax,0
DW $A20F
lea esi, a
mov edi, 0
// mov a[0],ebx
mov dword ptr [esi+edi], ebx
add edi, 4
// mov a[4],edx
mov dword ptr [esi+edi], edx
add edi, 4
// mov a[8],ecx
mov dword ptr [esi+edi], ecx
mov ebx, save_ebx
mov ebp, save_ebp
mov esp, save_esp
mov esi, save_esi
mov EDI, save_edi
end;
end;
var R: array[0..19] of Char;
var CpuID: Integer;
begin
FillChar(R, 20, 0);
asm
mov eax, 0
db 0fh, 0a2h // 其实就是cpuid汇编指令
mov dword ptr R[0], ebx
mov dword ptr R[4], edx
mov dword ptr R[8], ecx
mov eax, 1
db 0fh, 0a2h // cpuid
mov CpuID, edx
end;
ShowMessage('CPU制造商为:' + R);
ShowMessage('序列号为:' + IntToStr(CpuID));
end;procedure TForm1.Button1Click(Sender: TObject);
begin
GetCpuInfo;
end;
var R: array[0..19] of Char;
var CpuID: Integer;
begin
FillChar(R, 20, 0);
asm
mov eax, 0
db 0fh, 0a2h // 其实就是cpuid汇编指令
mov dword ptr R[0], ebx
mov dword ptr R[4], edx
mov dword ptr R[8], ecx
mov eax, 1
db 0fh, 0a2h // cpuid
mov CpuID, edx
end;
ShowMessage('CPU制造商为:' + R);
ShowMessage('序列号为:' + IntToStr(CpuID));
end;procedure TForm1.Button1Click(Sender: TObject);
begin
GetCpuInfo;
end;
而上面的提供的DiskSN是旧的版本,应该在WIN2K下面不通执行通过的.
Lbl_DriveType:Tlabel;
DriveType:WORD; //定义驱动器类型变量
DriveType:=GetDriveType(RootPathName); //获得RootPathName所对应的磁盘驱动器信息
case DriveType of
DRIVE_REMOVABLE:Lbl_DriveType.Caption:= '软盘驱动器';
DRIVE_FIXED : Lbl_DriveType.Caption:= '硬盘驱动器';
DRIVE_REMOTE: Lbl_DriveType.Caption:= '网络驱动器';
DRIVE_CDROM: Lbl_DriveType.Caption:= '光盘驱动器';
DRIVE_RAMDISK: Lbl_DriveType.Caption:= '内存虚拟盘';
end; //将该磁盘信息显示在Lbl_DriveType中
二、 用GlobalMemoryStatus函数获取内存使用信息
MemStatus: TMEMORYSTATUS; //定义内存结构变量
Lbl_Memory:Tlabel;
MemStatus.dwLength := size of(TMEMORYSTATU
S);
GlobalMemoryStatus(MemStatus); //返回内存使用信息
Lbl_Memory.Caption := format('共有内存: %d KB 可用内存: %dKB',[MemStatus.dwAvailPhys div 1024,MemStatus.dwTotalPhys div 1024]);
//将内存信息显示在Lbl_Memory中
三、 用GetSystemInfo函数获取CPU信息
SysInfo: TSYSTEMINFO;
Lbl_CPUName:Tlabel;
GetSystemInfo(SysInfo);//获得CPU信息
case SysInfo.dwProcessorType of
PROCESSOR_INTEL_386:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumber Of Processors,'Intel80386']);
PROCESSOR_INTEL_486:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumber Of Processors, 'Intel 80486']);
PROCESSOR_INTEL_PENTIUM:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNum
berOfProcessors, 'Intel Pentium']);
PROCESSOR_MIPS_R4000:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'MIPS R4000']);
PROCESSOR_ALPHA_21064:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'ALPHA 21064']);
end;//把CPU信息显示在Lbl_CPUName中。(
const
Subkey: string = ''Hardware\description\system'';
var
hkSB: HKEY;
rType: LongInt;
ValueSize, OrigSize: Longint;
ValueBuf: array[0..1000] of char;
procedure ParseValueBuf(const VersionType: string);
var
I, Line: Cardinal;
S: string;
begin
i := 0;
Line := 0;
while ValueBuf[i] <> #0 do
begin
S := StrPas(@ValueBuf[i]); // move the Pchar into a string
Inc(Line);
Memo1.Lines.Append(Format(''%s Line %d = %s'',
[VersionType, Line, S])); // add it to a Memo
inc(i, Length(S) + 1);
// to point to next sz, or to #0 if at
end
end;
end; begin
if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(Subkey), 0,
KEY_READ, hkSB) = ERROR_SUCCESS then
try
OrigSize := sizeof(ValueBuf);
ValueSize := OrigSize;
rType := REG_MULTI_SZ;
if RegQueryValueEx(hkSB, ''SystemBiosVersion'', nil, @rType,
@ValueBuf, @ValueSize) = ERROR_SUCCESS then
ParseValueBuf(''System BIOS Version''); ValueSize := OrigSize;
rType := REG_SZ;
if RegQueryValueEx(hkSB, ''SystemBIOSDate'', nil, @rType,
@ValueBuf, @ValueSize) = ERROR_SUCCESS then
Memo1.Lines.Append(''System BIOS Date '' + ValueBuf); ValueSize := OrigSize;
rType := REG_MULTI_SZ;
if RegQueryValueEx(hkSB, ''VideoBiosVersion'', nil, @rType,
@ValueBuf, @ValueSize) = ERROR_SUCCESS then
ParseValueBuf(''Video BIOS Version''); ValueSize := OrigSize;
rType := REG_SZ;
if RegQueryValueEx(hkSB, ''VideoBIOSDate'', nil, @rType,
@ValueBuf, @ValueSize) = ERROR_SUCCESS then
Memo1.Lines.Append(''Video BIOS Date '' + ValueBuf);
finally
RegCloseKey(hkSB);
end;
end;
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
VName,FSName:Array[0..512] Of Char;
VID:integer;
x,y:Cardinal;
implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
begin
GetVolumeInformation('C:\',VName,255,@VID,x,y,FSName,255);
Edit1.Text:=IntToStr(VID);
end;end.