Советы по Delphi

Серийный номер винчестера


У меня есть модуль, который позволяет получить имя винчестера и его серийный номер, но этот модуль был создан на Borland Pascal 7.0. Я не проверял как он работает в Delphi, и не стал переводить его комментарии с немецкого, поскольку у меня элементарно нет времени. Может быть он сгодится вам в качестве идеи, в противном случае просто вышвырните его в окно.

    Unit HardDisk;

INTERFACE

FUNCTION
  GetHardDiskNaam               : STRING;
FUNCTION  GetHardDiskSerieNummer        : STRING;
FUNCTION  GetHardDiskControlleNummer    : STRING;


PROCEDURE GetHardDiskGegevens;

CONST
CodeerTabel : ARRAY[0..24] OF BYTE = (3,1,2,1,4,1,3,2,6,4,6,5,1,2,6,4,2,6,3,4,6,2,4,1,2);

TYPE
CharArray = ARRAY[0..24] OF CHAR;
VAR
HardDiskGegevens          : ARRAY[1..256] OF INTEGER; HardDiskNaam              : CharArray; SerieNummer               : CharArray; ControlleNummer           : CharArray; C_HardDiskNaam            : STRING; C_HardDiskSerieNummer     : STRING; C_HardDiskControlleNummer : STRING; C_LicentieNaam            : STRING;
IMPLEMENTATION

FUNCTION
GetHardDiskNaam : STRING; VAR Teller : INTEGER; Lus    : INTEGER; BEGIN GetHardDiskNaam := ''; Teller := 1; FOR Lus := 1 TO 18 DO BEGIN HardDiskNaam[Teller] := CHR( ( HardDiskGegevens[27+Lus] DIV 256 )); Inc(Teller); HardDiskNaam[Teller] := CHR( ( HardDiskGegevens[27+Lus] MOD 256 )); Inc(Teller); END; GetHardDiskNaam := HardDiskNaam; END;
FUNCTION GetHardDiskSerieNummer : STRING; VAR Teller : INTEGER; Lus    : INTEGER; BEGIN GetHardDiskSerieNummer := ''; 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; GetHardDiskSerieNummer := SerieNummer; END;
FUNCTION GetHardDiskControlleNummer : STRING; VAR Teller : INTEGER; Lus    : INTEGER; BEGIN GetHardDiskControlleNummer := ''; Teller := 1; FOR Lus := 1 TO 3 DO BEGIN ControlleNummer[Teller] := CHR( ( HardDiskGegevens[23+Lus] DIV 256 )); Inc(Teller); ControlleNummer[Teller] := CHR( ( HardDiskGegevens[23+Lus] MOD 256 )); Inc(Teller); END; GetHardDiskControlleNummer := ControlleNummer; END;
PROCEDURE GetHardDiskGegevens; VAR Lus    : INTEGER; BEGIN WHILE ( Port[$1f7] <> $50) DO ; Port[$1F6] := $A0 ; Port[$1F7] := $EC ; WHILE ( Port[$1f7] <> $58 ) DO ; FOR Lus := 1 TO 256 DO BEGIN HardDiskGegevens[Lus] := Portw[$1F0] ; END; END;
END.

    unit Chiunit4;

interface

function
Chk...(ParamIn ... ,=20
ParamDatabaseNamePchar: pchar ): longint; export;
implementation

uses
  SysUtils, DBTables, ExtCtrls ;

const
ide_drive_C           =3D $00A0; ide_Data              =3D $1F0; ide_Error             =3D $1F1; ide_DriveAndHead      =3D $1F6; ide_Command           =3D $1F7; ide_command_readpar   =3D $EC; ide_Status            =3D $1F7; ide_status_busy       =3D $80; ide_status_ready      =3D $40; ide_status_error      =3D $01; ide_Fixed             =3D $3F6; ide_Fixed_Irq         =3D $02;
IntervalleMinimum  =3D 0.0000232; { 0.000011574 =3D 1 секунда (.0001 (hh.mmss) (->DEG=3D.0002777) / 24) } { .0000174 =3D 1 1/2 сек }  { .0000232 =3D 2 сек }
type
tIdeRec =3D Record rec : array[0..255] of word; end;
var
ExitSave :  Pointer; IdeRec :    tIdeRec;
function ConvertToString : string;
var i,j : integer; begin FillChar( Result, 20, ' ' ); Result[0] :=3D #20; for i :=3D 1 to 20 do begin j :=3D Trunc( (i-1) /2 ) +10 ; if Lo(IdeRec.Rec[j]) =3D (0) then Result[i]:=3D ' ' else Result[i]:=3D Chr ( Lo( IdeRec.Rec[j] ) ) ; i :=3D i +1; if Hi(IdeRec.Rec[j]) =3D (0) then Result[i]:=3D ' ' else Result[i]:=3D Chr ( Hi( IdeRec.Rec[j] ) ) ; end; end;

function DoIt(Numero: string) : longint;
var
portchar    :byte; boo         :Boolean; i           :integer; S,S1        :String; begin
Result:=3D 19 ; { по умолчанию fail } FillChar( IdeRec.Rec, 512, ' ' ) ;
{ для примера v=E9rifier l'=E9tat } boo :=3D true; { ожидание poll DRQ } i :=3D 5000 ; repeat i :=3D i -1; portchar :=3D Lo(port[ide_status]) ; { получаем статус } until ( i < 1 ) or not ( ( portchar AND ide_status_busy ) =3D ide_status_busy ) ; if i < 1 then begin { Result:=3D 'статус постоянной занятости'; } Result :=3D 180 ; boo :=3D false; end;
if boo then try { premi=E8rement выключаем прерывания устройства } port[ide_Fixed] :=3D 0;
port[ide_DriveAndHead] :=3D ide_drive_C ;  { устанавливаем устройство } portchar :=3D Lo(port[ide_status]) ; { получаем статус } if portchar =3D $ff then begin { Result:=3D 'устанавливаем статус устройства $ff'; } Result :=3D 11 ; boo :=3D false; end;
if boo then begin { ожидание poll DRQ } i :=3D 1024 ; repeat i :=3D i -1; portchar :=3D Lo(port[ide_status]) ; until ( i < 1 ) or not ( ( portchar AND ide_status_busy ) =3D ide_status_busy ) ; if i < 1 then begin { Result:=3D 'статус постоянной занятости'; } Result :=3D 181 ; boo :=3D false; end; end;
if boo then { проверяем готовность } if ( portchar AND ide_status_ready ) =3D 0 then begin { Result:=3D 'устанавливаем статус устройства "Не готов"'; } Result :=3D 12 ; boo :=3D false; end;
if boo then { ok, теперь для readIDE } { требуется посылка команды ReadParameters } port[ide_Command] :=3D ide_command_readpar ;
{ ожидание poll DRQ } i :=3D 5000 ; repeat i :=3D i -1; portchar :=3D Lo(port[ide_status]) ; until ( i < 1 ) or not ( ( portchar AND ide_status_busy ) =3D ide_status_busy ) ; if i < 1 then begin { Result:=3D 'статус постоянной занятости'; } Result :=3D 182 ; boo :=3D false; end;
if boo then { проверяем если нет ошибок} if ( portchar AND ide_status_error ) =3D ide_status_error then begin { Result:=3D 'статус ошибки устройства после ReadPar'; } Result :=3D 13 ; boo :=3D false; end;
if boo then { проверяем готовность } if ( portchar AND ide_status_ready ) =3D 0 then begin { Result:=3D 'после ReadPar статус устройства "Не готов"'; } Result :=3D 14 ; boo :=3D false; end;
if boo then try { ok, теперь читаем из буфера 256 слов } for i :=3D 0 to 255 do begin IdeRec.Rec[i] :=3D ( portw[ide_Data] ) ; end; except on Exception do begin { ShowMessage( 'Ошибка portw i=3D '+intToStr(i)= ) ; }
boo :=3D false; Result :=3D 15 ; end; else begin boo :=3D false; Result :=3D 16 ; raise; end; end;
if boo Then begin S :=3D ConvertToString; if length(Numero) < 20 then S1:=3D Numero +' ' else S1:=3D Numero; if CompareStr ( S, Copy(S1,1,20) ) =3D 0 then Result :=3D 10 else Result :=3D 17 ; { Result :=3D '('+S+')<>('+Copy(S1,1,20)+')' ; } end; finally { снова включаем прерывания диска } port[ide_Fixed] :=3D ide_Fixed_Irq ; end; END;

procedure MyExit; far;
{ восстанавливаем параметры диска во избежании того, чтобы другие операции с диском не разрушили его в случае прерывания программы }
begin
ExitProc :=3D ExitSave;        { восстанавливаем предыдущий exitproc } {  Port[ide_Command]:=3D$10;      { посылаем команду: сбросить текущее устройство }
end;

function GetParam(ParamAlias: string): String;
var
i : integer ; t : TTable ; S : String ; begin
Result :=3D ''; try t :=3D nil; t :=3D TTable.Create(nil); t.DatabaseName :=3D ParamAlias; t.TableName :=3D ...; t.TableType :=3D ttPARADOX; t.open; ...
finally if
Assigned(t) then t.free ; end; end;

function FixParam(ParamAlias: string): boolean;
var
i : integer ; t : TTable ; S : String ; begin
Result :=3D False; try t :=3D nil; t :=3D TTable.Create(nil); t.DatabaseName :=3D ParamAlias; t.TableName :=3D  ; t.TableType :=3D ttPARADOX; t.open; if=20 begin ...         t.Edit; t.setFields([nil, S]); t.post; end; t.close; Result :=3D True; finally if Assigned(t) then t.free ; end; end;

{----------------------------------------------------}
function Chk...(ParamIn: ;
ParamDatabaseNamePchar: pchar ): longInt ; var
ParamString :  String; =20 Temps :        Real; Ok :           boolean; i:             integer; S :            string[20]; S6 :           string[6]; r :            longInt;
Label
Jump; BEGIN
Result:=3D 0 ;  { значение d=E9faut } if Ok then i :=3D 0; repeat begin i :=3D i +1 ; r :=3D DoIt(Copy(ParamString,54,20)) ; if r =3D 10 then begin Ok :=3D True ; break end else begin Ok :=3D False ; Result:=3D r; Continue; end; end; until i =3D 3 ; If Ok then begin Ok :=3D FixParam(ParamDatabaseName) ; If Ok then else { Result :=3D 'Ошибка FixParam'; } Result :=3D 2 ; end; If Ok then Result :=3D 1 ; END;

Begin
ExitSave:=3D ExitProc; ExitProc:=3D @MyExit; end.

[001957]



Содержание раздела