دخول

مراد23 · 20-09-2010, 12:21 AM

السلام عليكم ورحم الله وبركاته

اخي العزيز لديا محاولة

الشرح
تستطيع بعد الحصول على رقم الهارديسك في سلسلة نصية

أن تدخله في حلقة بنفس طول السلسلة

مع وجود تعليمة الشرط CASE
تستطيع تغير الارقام في الكود كما تشاء

كود :
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetIdeSerialNumber0():string;
const IDENTIFY_BUFFER_SIZE = 512;
type
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 for future use. Must be zero.
end;
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; // Input buffer.
end;
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    : DWORD;
    wMultSectorStuff           : Word;
    ulTotalAddressableSectors : DWORD;
    wSingleWordDMA             : Word;
    wMultiWordDMA              : Word;
    bReserved                  : Array[0..127] of BYTE;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
    bDriverError : Byte;
    bIDEStatus   : Byte;
    bReserved    : Array[0..1] of Byte;
    dwReserved   : Array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
    cBufferSize : DWORD;
    DriverStatus : TDriverStatus;
    bBuffer      : Array[0..0] of BYTE;
end;
var
    hDevice : THandle;
    cbBytesReturned : DWORD;
    ptr : PChar;
    SCIP : TSendCmdInParams;
    aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
    IdOutCmd : TSendCmdOutParams absolute aIdOutCmd;

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;
begin
Result := ''; // return empty string on error
if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000


begin
//???? EU?? PhysicalDrive0 C?? PhysicalDrive1 C? PhysicalDrive2
   hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
end
else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
    FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
    FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
    cbBytesReturned := 0;
    with SCIP do
    begin
    cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
   with irDriveRegs do
   begin
   bSectorCountReg := 1;
   bSectorNumberReg := 1;
   bDriveHeadReg    := $A0;
   bCommandReg      := $EC;
    end;
    end;
    if not DeviceIoControl(hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
      @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
finally
    CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do
begin
    ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber) );
    (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
    Result := PChar(@sSerialNumber);
end;
end;






procedure TForm1.Button1Click(Sender: TObject);
var N,I : integer;
B: char;
S,R:string;

begin


 s:=trim(AnsiUpperCase(GetIdeSerialNumber0));
 N:=length(s);
 R:='';

for I:= 1 to N do
begin


       b:=S[i];
       case b of
       'A'..'D': R:=r+'2';
       'E'..'H': R:=r+'7';
       'I'..'L': R:=r+'3';
       'M'..'P': R:=r+'4';
       'Q'..'S': R:=r+'5';
       'T'..'V': R:=r+'6';
       'W'..'Z': R:=r+'1';
       '-' : R:=r+'3'
        else  R:=R+S[i];
       end;

end;
ShowMessage('رقم الهارديسك بعد التحويل :  '+R);

end;

procedure TForm1.FormCreate(Sender: TObject);
var s:string;
begin
s:=(GetIdeSerialNumber0);
Edit1.Text:=s;
end;

end.

المثال المرفق :

.rar

ConverNeHardisque.rar (الحجم : 174.24 ك ب / التحميلات : 133)

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة