Советы по 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]
