(Cylinders:845; Heads:7; Sectors:35; Name:'Toshiba MK234FC (106 MB'), (Cylinders:965; Heads:5; Sectors:17; Name:'Quantum ProDrive 40AT (40 M B)'), (Cylinders:965; Heads:10; Sectors:17; Name:'Quantum ProDrive 80AT (80 M B)'), (Cylinders:1050; Heads:2; Sectors:40; Name:'Teac SD-340 (41 MB)'), (Cylinders:776; Heads:8; Sectors:33; Name:'Conner CP-3104 (100 MB)'), (Cylinders:745; Heads:4; Sectors:28; Name:'Priam 3804M (40.7 MB)'), (Cylinders:980; Heads:10; Sectors:17; Name:'Western Digitial Caviar AC2 80 (81 MB)'), (Cylinders:560; Heads:6; Sectors:26; Name:'Seagate ST157A (42 MB)'), (Cylinders:732; Heads:8; Sectors:35; Name:'ALPS ELECTRIC Co.,LTD. DR31 1C (102 MB)'), (Cylinders:0; Heads:0; Sectors:0; Name:'')); type parray = ^tarray; tarray = array[1..256] of Word; var secbuf: parray; drive: Byte; drv: String[1]; procedure printinfo; var id: TIdeInfo; capacity: Word; types: String; i: Integer; function zo(const value: Byte): String; begin if Boolean(value) then zo := '' else zo := 'not'; end; function ToStr(value: LongInt): String; var S: String; begin Str(value, S); ToStr := S; end; function ConvertHex(Value: Word): String; const hexTable: array[0..15] of Char = '0123456789ABCDEF'; begin ConvertHex := hexTable[Hi(Value) shr 4] + hexTable[Hi(Value) and $f] +
hexTable[Lo(Value) shr 4] + hexTable[Lo(Value) and $f]; end; procedure SwapBytes(var Source, Dest; Len: Byte); assembler; asm push ds lds si, Source les di, Dest mov cl, len xor ch, ch @1: mov ax, ds:[si] xchg ah, al mov es:[di], ax inc si inc si inc di inc di loop @1 pop ds end;
begin id := PIdeInfo(secbuf)^; { get disk type by characteristics } i := 1; while IdeTypes[i].Cylinders <> 0 do Begin if (IdeTypes[i].cylinders = id.fixcyls) and (IdeTypes[i].heads = id.heads) and (IdeTypes[i].sectors = id.sectors) then Begin types := IdeTypes[i].name; break; end; inc(i); end; { unknown disk } if (IdeTypes[i].cylinders = 0) then Begin types := ' '; { calculate capacity in MB } capacity := (LongInt(id.fixcyls) * id.heads * id.sectors) div 2048; types := types + ToStr(capacity); types := types + ' Mbytes'; end; { swap bytes in ASCII fields except for WD disks } if (i <> 4) and (i <> 5) then Begin SwapBytes(id.serial, id.serial, 10); SwapBytes(id.firmware, id.firmware, 4); SwapBytes(id.model, id.model, 20); end; WriteLn('Drive ', drive-2, ' :', types); WriteLn('Drive ID : ', ConvertHex(id.genconf)); WriteLn('Cylinders : ', id.fixcyls{, ' ' id.remcyls, ' removables'}); WriteLn('Heads : ', id.heads); Writeln('Sectors : ', id.sectors); WriteLn('Serial No. : ', id.serial); WriteLn('Firmware : ', id.firmware); WriteLn('Model : ', id.model); { WriteLn('Bytes per track : ', id.bytetrack); Writeln('Bytes per sector : ', id.bytesector); WriteLn('Bytes of intersector gap: ', id.byteisg); Writeln('Bytes of sync : ', id.byteplo); WriteLn('Controller type : ', id.contype);} Writeln('Buffer : ', id.bufsiz div 2, ' KBytes'); WriteLn('Bytes of ECC: ', id.byteecc); end; procedure readsect; assembler; asm { poll DRQ } @1: mov dx, HDC_STATUS in al, dx and al, HDC_STATUS_BUSY or al, al jne @1 { read up sector } mov cx, 256 mov dx, HDC_DATA les di, secbuf @2: in ax, dx mov es:[di], ax inc di inc di loop @2 end; function DriveValid(Drive: Char; var Drv: Byte): Boolean; assembler; asm mov ah, 19h { Save the current drive in BL } int 21h mov bl, al mov dl, Drive { Select the given drive } sub dl, 'A' les di, DRV mov es:[di], dl mov ah, 0Eh int 21h mov ah, 19h { Retrieve what DOS thinks is current } int 21h mov cx, 0 { Assume false } cmp al, dl { Is the current drive the given drive? } jne @1 mov cx, 1 { It is, so the drive is valid } mov dl, bl { Restore the old drive } mov ah, 0eh int 21h @1: xchg ax, cx { Put the return value into AX } end; function CurDisk: Byte; assembler; { Returns current drive } asm mov ah, 19h int 21h end; begin Writeln('IDE ver 1.2 (c) 1995 Keenvim software workgroup, Inc.'); writeln('Programmed by Mr. LiuJie'#13#10); if ParamCount > 0 then Begin drv := ParamStr(1); drv[1] := UpCase(drv[1]); if not DriveValid(drv[1], Drive) or not (drv[1] in ['C'..'Z']) then
Begin WriteLn('There isn''t such drive or drive invalid!'); Halt(1); end; end else drive := CurDisk; { disable interrupt from drive } Port[HDC_FIXED] := HDC_FIXED_IRQ; { set up task file parameter } Port[HDC_SDH] := $A0 + (drive shl 4); { issue read parameters } Port[HDC_COMMAND] := HDC_COMMAND_READPAR; GetMem(secbuf, SizeOf(secbuf)); { read up sector } readsect; { print out info } printinfo; FreeMem(secbuf, SizeOf(secbuf)); end. ******************** 程序是编译过了，可是一运行就死机，帮我看看如何
unit Getsn;interfaceuses Windows, SysUtils, Classes;type TGetsn = class(TComponent) private protected { Protected declarations } public { Public declarations } published { Published declarations } end;var pw:array[1..256] of word; idt,int_idt:dword; Base:dword; Entry:word; function inp(rdx:WORD):byte; function inpw(rdx:WORD):word; procedure outp(rdx:WORD;ral:integer); function WaitIde:integer; procedure ReadIDE; procedure NowInRing0; procedure GetIDEInfo; function harddisksn:string;implementation function inp(rdx:WORD):byte;Assembler; asm xor eax, eax mov dx, rdx in al, dx mov result,al end;function inpw(rdx:WORD):word;Assembler; asm xor eax, eax mov dx, rdx in ax, dx mov result,ax; end;procedure outp(rdx:WORD;ral:integer);Assembler; asm mov dx, rdx mov eax, ral out dx, al end;function WaitIde:integer; var al:word; begin al:=inp($1F7); while (al<$80)do al:=inp($1F7); result:=al; end; procedure ReadIDE; var al,i:byte; begin WaitIde; outp($1F6,$A0); al:= WaitIde; if ((al and $50)<>$50) then exit; outp($1F6,$A0); outp($1F7,$EC); al:=WaitIde; if ((al and $58)<>$58) then exit; for i:=0 to 255 do pw[i]:=inpw($1F0); end;procedure NowInRing0;Assembler; asm push ebp mov ebp,esp call ReadIDE; cli mov ebx, int_idt mov ax, Entry mov word ptr[ebx-4], ax mov eax, Base shr eax, 16 mov [ebx+2], ax sti leave iretd end; procedure GetIDEInfo;Assembler; var dwExcept:DWORD; begin dwexcept:=dword(addr(nowinring0)); asm mov eax, fs:[0] push eax sidt [esp-02h] pop ebx mov idt, ebx add ebx, $1C mov int_idt, ebx mov eax, [ebx] mov [Base], eax mov ax, [ebx-4] mov [Entry], ax cli mov esi, dwExcept push esi mov [ebx-4], si shr esi, 16 mov [ebx+2], si pop esi sti //到这里死机 int 3 end;end; function harddisksn:string; var s:array[1..80] of char; i,j:integer; begin GetIDEInfo; j:=0; for i:=0 to 9 do while (j<=19) do begin s[j]:=chr(pw[10+i]shr 8); j:=j+1; s[j]:=chr(pw[10+i]and $FF); j:=j+1; end; s[j]:=chr(0); result:=s; end;end.
string(Pchar(Ptr($FE061))); //MainBoardBiosName
string(Pchar(Ptr($FE091))); //MainBoardBiosCopyRight
string(Pchar(Ptr($FFFF5))); // MainBoardBiosDate
string(Pchar(Ptr($FE061))); //MainBoardBiosName －－空
string(Pchar(Ptr($FE091))); //MainBoardBiosCopyRight －－空
string(Pchar(Ptr($FFFF5))); // MainBoardBiosDate －－正确看来好像不对
IDE.PAS (IDE硬盘参数检测)
?Programmed by: 刘 杰
?nbsp;Designed : 04/11/92
?nbsp;Last modified: 01/26/95
?请使用 Turbo Pascal 7.0 编译. const
{ read/write --------------------------- }
HDC_DATA = $01F0;
HDC_ERROR = $01F1;
HDC_SECCOU = $01F2;
HDC_SECNUM = $01F3;
HDC_CYLLOW = $01F4;
HDC_CYLHIGH = $01F5;
HDC_SDH = $01F6;
{ read --------------------------------- }
HDC_STATUS : Word = $01F7;
HDC_ALTSTA = $03F6;
{ write -------------------------------- }
HDC_COMMAND = $01F7;
HDC_FIXED = $03F6;
{ commands ----------------------------- }
HDC_COMMAND_RESTORE = $10;
HDC_COMMAND_SEEK = $70;
HDC_COMMAND_READ = $20;
HDC_COMMAND_WRITE = $30;
HDC_COMMAND_FORMAT = $50;
HDC_COMMAND_READVER = $90;
HDC_COMMAND_DIAG = $90;
HDC_COMMAND_SETPAR = $91;
HDC_COMMAND_WRSTACK = $E8;
HDC_COMMAND_RDSTACK = $E4;
HDC_COMMAND_READPAR = $EC;
HDC_COMMAND_POWER = $E0;
HDC_FIXED_IRQ = $02;
HDC_FIXED_RESET = $04;
HDC_STATUS_ERROR = $01;
HDC_STATUS_INDEX = $02;
HDC_STATUS_ECC = $04;
HDC_STATUS_DRQ = $08;
HDC_STATUS_COMPLETE = $10;
HDC_STATUS_WRFAULT = $20;
HDC_STATUS_READY = $40;
HDC_STATUS_BUSY = $80;
type
TIdeTypes = record
Cylinders,
Heads,
Sectors: Word;
Name: String[38];
end;
PIdeInfo = ^TIdeInfo;
TIdeInfo = record
genconf,
fixcyls,
remcyls,
heads,
bytetrack, { bytes per track }
bytesector, { bytes per sector }
sectors, { sectors per track }
byteisg, { bytes intesector gap }
byteplo, { bytes in sync }
worduniq: Word; { words unique status }
serial: array[1..20] of Char;
contype, { controller type }
bufsiz, { buffer size in 512 byte blocks }
byteecc: Word; { ECC bytes trasferred in read/write long
}
firmware: array[1..8] of Char; { firmware revision }
model: array[1..40] of Char; { model ID }
secsint, { number of sectors transferred per inte
rrupt }
dblword, { double word transfer flag }
writepro: Word; { write protect }
end;
const
IdesInDataBase = 17;
IdeTypes: array[1..IdesInDataBase] of TIdeTypes =
((Cylinders:667; Heads:4; Sectors:33; Name:'Fujitsu M2611T (42.9 MB)'),
(Cylinders:667; Heads:8; Sectors:33; Name:'Fujitsu M2612T (85.9 MB)'),
(Cylinders:667; Heads:12; Sectors:33; Name:'Fujitsu M2613T (128.9 MB)')
,
(Cylinders:667; Heads:16; Sectors:33; Name:'Fujitsu M2614T (171.9 MB)')
,
(Cylinders:782; Heads:2; Sectors:27; Name:'Western Digital WD93024-A (
20.6 MB)'),
(Cylinders:782; Heads:4; Sectors:27; Name:'Western Digital WD93044-A (
41.2 MB)'),
(Cylinders:845; Heads:3; Sectors:35; Name:'Toshiba MK232FC (45.4 MB'),
(Cylinders:845; Heads:7; Sectors:35; Name:'Toshiba MK234FC (106 MB'),
(Cylinders:965; Heads:5; Sectors:17; Name:'Quantum ProDrive 40AT (40 M
B)'),
(Cylinders:965; Heads:10; Sectors:17; Name:'Quantum ProDrive 80AT (80 M
B)'),
(Cylinders:1050; Heads:2; Sectors:40; Name:'Teac SD-340 (41 MB)'),
(Cylinders:776; Heads:8; Sectors:33; Name:'Conner CP-3104 (100 MB)'),
(Cylinders:745; Heads:4; Sectors:28; Name:'Priam 3804M (40.7 MB)'),
(Cylinders:980; Heads:10; Sectors:17; Name:'Western Digitial Caviar AC2
80 (81 MB)'),
(Cylinders:560; Heads:6; Sectors:26; Name:'Seagate ST157A (42 MB)'),
(Cylinders:732; Heads:8; Sectors:35; Name:'ALPS ELECTRIC Co.,LTD. DR31
1C (102 MB)'),
(Cylinders:0; Heads:0; Sectors:0; Name:''));
type
parray = ^tarray;
tarray = array[1..256] of Word;
var
secbuf: parray;
drive: Byte;
drv: String[1];
procedure printinfo;
var
id: TIdeInfo;
capacity: Word;
types: String;
i: Integer;
function zo(const value: Byte): String;
begin
if Boolean(value) then
zo := ''
else
zo := 'not';
end;
function ToStr(value: LongInt): String;
var
S: String;
begin
Str(value, S);
ToStr := S;
end;
function ConvertHex(Value: Word): String;
const
hexTable: array[0..15] of Char = '0123456789ABCDEF';
begin
ConvertHex := hexTable[Hi(Value) shr 4] + hexTable[Hi(Value) and $f] +
hexTable[Lo(Value) shr 4] + hexTable[Lo(Value) and $f];
end;
procedure SwapBytes(var Source, Dest; Len: Byte); assembler;
asm
push ds
lds si, Source
les di, Dest
mov cl, len
xor ch, ch
@1: mov ax, ds:[si]
xchg ah, al
mov es:[di], ax
inc si
inc si
inc di
inc di
loop @1
pop ds
end;
id := PIdeInfo(secbuf)^;
{ get disk type by characteristics }
i := 1;
while IdeTypes[i].Cylinders <> 0 do
Begin
if (IdeTypes[i].cylinders = id.fixcyls) and
(IdeTypes[i].heads = id.heads) and
(IdeTypes[i].sectors = id.sectors) then
Begin
types := IdeTypes[i].name;
break;
end;
inc(i);
end;
{ unknown disk }
if (IdeTypes[i].cylinders = 0) then
Begin
types := ' ';
{ calculate capacity in MB }
capacity := (LongInt(id.fixcyls) * id.heads * id.sectors) div 2048;
types := types + ToStr(capacity);
types := types + ' Mbytes';
end;
{ swap bytes in ASCII fields except for WD disks }
if (i <> 4) and (i <> 5) then
Begin
SwapBytes(id.serial, id.serial, 10);
SwapBytes(id.firmware, id.firmware, 4);
SwapBytes(id.model, id.model, 20);
end;
WriteLn('Drive ', drive-2, ' :', types);
WriteLn('Drive ID : ', ConvertHex(id.genconf));
WriteLn('Cylinders : ', id.fixcyls{, ' ' id.remcyls, ' removables'});
WriteLn('Heads : ', id.heads);
Writeln('Sectors : ', id.sectors);
WriteLn('Serial No. : ', id.serial);
WriteLn('Firmware : ', id.firmware);
WriteLn('Model : ', id.model);
{ WriteLn('Bytes per track : ', id.bytetrack);
Writeln('Bytes per sector : ', id.bytesector);
WriteLn('Bytes of intersector gap: ', id.byteisg);
Writeln('Bytes of sync : ', id.byteplo);
WriteLn('Controller type : ', id.contype);}
Writeln('Buffer : ', id.bufsiz div 2, ' KBytes');
WriteLn('Bytes of ECC: ', id.byteecc);
end;
procedure readsect; assembler;
asm
{ poll DRQ }
@1: mov dx, HDC_STATUS
in al, dx
and al, HDC_STATUS_BUSY
or al, al
jne @1
{ read up sector }
mov cx, 256
mov dx, HDC_DATA
les di, secbuf
@2: in ax, dx
mov es:[di], ax
inc di
inc di
loop @2
end;
function DriveValid(Drive: Char; var Drv: Byte): Boolean; assembler;
asm
mov ah, 19h { Save the current drive in BL }
int 21h
mov bl, al
mov dl, Drive { Select the given drive }
sub dl, 'A'
les di, DRV
mov es:[di], dl
mov ah, 0Eh
int 21h
mov ah, 19h { Retrieve what DOS thinks is current }
int 21h
mov cx, 0 { Assume false }
cmp al, dl { Is the current drive the given drive? }
jne @1
mov cx, 1 { It is, so the drive is valid }
mov dl, bl { Restore the old drive }
mov ah, 0eh
int 21h
@1: xchg ax, cx { Put the return value into AX }
end;
function CurDisk: Byte; assembler;
{ Returns current drive }
asm
mov ah, 19h
int 21h
end;
begin
Writeln('IDE ver 1.2 (c) 1995 Keenvim software workgroup, Inc.');
writeln('Programmed by Mr. LiuJie'#13#10);
if ParamCount > 0 then
Begin
drv := ParamStr(1);
drv[1] := UpCase(drv[1]);
if not DriveValid(drv[1], Drive) or not (drv[1] in ['C'..'Z']) then
Begin
WriteLn('There isn''t such drive or drive invalid!');
Halt(1);
end;
end
else
drive := CurDisk;
{ disable interrupt from drive }
Port[HDC_FIXED] := HDC_FIXED_IRQ;
{ set up task file parameter }
Port[HDC_SDH] := $A0 + (drive shl 4);
{ issue read parameters }
Port[HDC_COMMAND] := HDC_COMMAND_READPAR;
GetMem(secbuf, SizeOf(secbuf));
{ read up sector }
readsect;
{ print out info }
printinfo;
FreeMem(secbuf, SizeOf(secbuf));
end.
********************
程序是编译过了，可是一运行就死机，帮我看看如何
unit Getsn;interfaceuses
Windows, SysUtils, Classes;type
TGetsn = class(TComponent)
private protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
end;var
pw:array[1..256] of word;
idt,int_idt:dword;
Base:dword;
Entry:word; function inp(rdx:WORD):byte;
function inpw(rdx:WORD):word;
procedure outp(rdx:WORD;ral:integer);
function WaitIde:integer;
procedure ReadIDE;
procedure NowInRing0;
procedure GetIDEInfo;
function harddisksn:string;implementation
function inp(rdx:WORD):byte;Assembler;
asm
xor eax, eax
mov dx, rdx
in al, dx
mov result,al
end;function inpw(rdx:WORD):word;Assembler;
asm
xor eax, eax
mov dx, rdx
in ax, dx
mov result,ax;
end;procedure outp(rdx:WORD;ral:integer);Assembler;
asm
mov dx, rdx
mov eax, ral
out dx, al
end;function WaitIde:integer;
var
al:word;
begin
al:=inp($1F7);
while (al<$80)do
al:=inp($1F7);
result:=al;
end;
procedure ReadIDE;
var
al,i:byte;
begin
WaitIde;
outp($1F6,$A0);
al:= WaitIde;
if ((al and $50)<>$50) then exit;
outp($1F6,$A0);
outp($1F7,$EC);
al:=WaitIde;
if ((al and $58)<>$58) then exit;
for i:=0 to 255 do
pw[i]:=inpw($1F0);
end;procedure NowInRing0;Assembler;
asm
push ebp
mov ebp,esp
call ReadIDE;
cli
mov ebx, int_idt
mov ax, Entry
mov word ptr[ebx-4], ax
mov eax, Base
shr eax, 16
mov [ebx+2], ax
sti
leave
iretd
end;
procedure GetIDEInfo;Assembler;
var
dwExcept:DWORD;
begin
dwexcept:=dword(addr(nowinring0));
asm
mov eax, fs:[0]
push eax
sidt [esp-02h]
pop ebx
mov idt, ebx
add ebx, $1C
mov int_idt, ebx
mov eax, [ebx]
mov [Base], eax
mov ax, [ebx-4]
mov [Entry], ax
cli
mov esi, dwExcept
push esi
mov [ebx-4], si
shr esi, 16
mov [ebx+2], si
pop esi
sti //到这里死机
int 3
end;end;
function harddisksn:string;
var
s:array[1..80] of char;
i,j:integer;
begin
GetIDEInfo;
j:=0;
for i:=0 to 9 do
while (j<=19) do
begin
s[j]:=chr(pw[10+i]shr 8);
j:=j+1;
s[j]:=chr(pw[10+i]and $FF);
j:=j+1;
end;
s[j]:=chr(0);
result:=s;
end;end.