hdid.pas

商品房合同套打程序

Unit HDID;

Interface
Uses
   Windows, SysUtils, shellapi, ActiveX, ComObj, Shlobj;

Function GetHDID(Var sID: pchar): integer;
Procedure CreateShortCut(FileName, ShortCutName, DestDir: pchar);
     //在桌面上创建快捷方式

Implementation

Procedure CreateShortCut(FileName, ShortCutName, DestDir: pchar);
//use Shellapi, ActiveX, ComObj, Shlobj
//TODO: 创建快捷方式
//Example CreateShortCut('c:\windows\notepad.exe','记事本')

   Function AddTail(Src: String): String;
  //在路径字符串的最后加上'\'
   Begin
      If (Src[Length(Src)] <> '\') Then result := Src + '\' Else
         result := Src;
   End;
Var
   tmpObject        : IUnknown;
   tmpSLink         : IShellLink;
   tmpPFile         : IPersistFile;
 //  PIDL : PItemIDList;
   StartupDirectory : pchar;            //array[0..MAX_PATH] of Char;
   StartupFilename  : String;
   LinkFilename     : WideString;
Begin
   StartupFilename := FileName;
   tmpObject := CreateComObject(CLSID_ShellLink);
   tmpSLink := tmpObject As IShellLink;
   tmpPFile := tmpObject As IPersistFile;
   tmpSLink.SetPath(pchar(StartupFilename));
   tmpSLink.SetWorkingDirectory(pchar(ExtractFilePath(StartupFilename)));
 //  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);
 //  SHGetPathFromIDList(PIDL, StartupDirectory);
   StartupDirectory := DestDir;
   LinkFilename := AddTail(StartupDirectory) + ShortCutName + '.lnk';
   tmpPFile.Save(pWChar(LinkFilename), false);
End;

  /////////////////////////////////////////////////

Function GetHDID(Var sID: pchar): integer;
//TODO:获取Ide硬盘序列号
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;
Var
   hDevice          : THandle;
   cbBytesReturned  : dword;
   pInData          : PSendCmdInParams;
   pOutData         : Pointer;          // PSendCmdOutParams
   Buffer           : Array[0..BufferSize - 1] Of byte;
   srbControl       : TSrbIoControl Absolute Buffer;
   Tmp              : String;

   Procedure ChangeByteOrder(Var Data: Array Of char; 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 := 0;
   FillChar(Buffer, BufferSize, #0);
   If Win32Platform = VER_PLATFORM_WIN32_NT Then Begin // Windows NT, Windows 2000
    // Get SCSI port handle
      hDevice := CreateFile('\\.\Scsi0:',
         GENERIC_READ Or GENERIC_WRITE,
         FILE_SHARE_READ Or FILE_SHARE_WRITE,
         Nil, OPEN_EXISTING, 0, 0);
      If hDevice = INVALID_HANDLE_VALUE Then Exit;
      Try
         srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
         System.Move('SCSIDISK', srbControl.Signature, 8);
         srbControl.Timeout := 2;
         srbControl.Length := DataSize;
         srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
         pInData := PSendCmdInParams(pchar(@Buffer)
            + SizeOf(SRB_IO_CONTROL));
         pOutData := pInData;
         With pInData^ Do Begin
            cBufferSize := IDENTIFY_BUFFER_SIZE;
            bDriveNumber := 0;
            With irDriveRegs Do Begin
               bFeaturesReg := 0;
               bSectorCountReg := 1;
               bSectorNumberReg := 1;
               bCylLowReg := 0;
               bCylHighReg := 0;
               bDriveHeadReg := $A0;
               bCommandReg := IDE_ID_FUNCTION;
            End;
         End;
         If Not DeviceIoControl(hDevice, IOCTL_SCSI_MINIPORT,
            @Buffer, BufferSize, @Buffer, BufferSize,
            cbBytesReturned, Nil) Then Exit;
      Finally
         CloseHandle(hDevice);
      End;
   End Else Begin                       // Windows 95 OSR2, Windows 98
      hDevice := CreateFile('\\.\SMARTVSD', 0, 0, Nil,
         CREATE_NEW, 0, 0);
      If hDevice = INVALID_HANDLE_VALUE Then Exit;
      Try
         pInData := PSendCmdInParams(@Buffer);
         pOutData := @pInData^.bBuffer;
         With pInData^ Do Begin
            cBufferSize := IDENTIFY_BUFFER_SIZE;
            bDriveNumber := 0;
            With irDriveRegs Do Begin
               bFeaturesReg := 0;
               bSectorCountReg := 1;
               bSectorNumberReg := 1;
               bCylLowReg := 0;
               bCylHighReg := 0;
               bDriveHeadReg := $A0;
               bCommandReg := IDE_ID_FUNCTION;
            End;
         End;
         If Not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA,
            pInData, SizeOf(TSendCmdInParams) - 1, pOutData,
            W9xBufferSize, cbBytesReturned, Nil) Then Exit;
      Finally
         CloseHandle(hDevice);
      End;
   End;
   With PIdSector(pchar(pOutData) + 16)^ Do Begin
      ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
      SetString(Tmp, sSerialNumber, SizeOf(sSerialNumber));
      sID := pchar(Tmp);
      result := lstrlen(sID);
   End;
End;

End.