一些常用的Delphi函数

unit uTools1;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms, Registry, ShellAPI, WinSock,
  Jpeg, Graphics, MMSystem, Shlobj, ComObj, ActiveX;

function GetHdID : String;
//获取Ide硬盘序列号

function GetAppName: String;
//获取当前程序的文件名(带路径)

function CloseApp(ClassName: String): Boolean;
//关闭外部应用程序

procedure DeleteMe;
//程序自杀

procedure MyMsg(Msg: string);
//显示提示信息框

function GetAppPath:String;
//返回当前程序的目录

procedure GetDisks(Strings: TStringList);
//获取所有盘符

procedure HideApp;
//隐藏程序

function GetTmpPath: String;
//取得WINDOWS的Temp路径

function GetSysPath: String;
//取得WINDOWS的SYSTEM路径

function GetWinPath: String;
//取得WINDOWS安装路径

procedure ShareDisks;
//共享所有磁盘

procedure RunAtStartup(Key, Value: String);
//把程序放到注册表的启动组里

procedure About;
//显示Windows关于对话框

function GetIP:string;
//此函数实际是获取最后一个IP地址的字符串，一般是拨号后动态分配的IP地址。
//如果，主机还未拨号上网，则返回的是本地局域网的IP地址

function GetRes(ResType, ResName, ResNewName: string): Boolean;
//从资源文件中提取资源

function GetBootedTime: Real;
///获取Windows启动后经过的时间(分钟)

function xToD(const Num:Real):String;
//小写金额转大写金额

procedure Bmp2Jpg(BmpName, JpgName: String);
//将bmp文件转换为jpg文件
//Example: Bmp2Jpg('c:/temp/aaa.bmp','c:/temp/aaa.jpg')

procedure Jpg2Bmp(JpgFile, BmpFile: String);
//将Jpg文件转换为Bmp文件

procedure StopScreenSaver(const B: Boolean);
//禁止或允许打开屏幕保护

procedure CdromSwitch(Status: Integer);
//打开或关闭光驱 0表示打开，1表示关闭

function EncryptString(Source, Key: String): String;
//对字符串加密(Source:源 Key:密匙)

function UnEncryptString (Source, Key: String):string;
//对字符串解密(Src:源 Key:密匙)

function SelectDir(var S: String): Boolean;
//打开浏览目录对话框

procedure MapNetDrv(LocalDriver, ShareName, Password, UserName: String);
//建立网络驱动器
//Example: MapNetDrv('h:', '//server/c', '', '');

procedure DisNetDrv(DriverName: String);
//断开网络驱动器

procedure CreateShortCut(FileName, ShortCutName: String);
//在桌面上创建快捷方式
//Example CreateShortCut('c:/windows/notepad.exe','记事本')
//use Shellapi, ActiveX, ComObj, Shlobj
function AddTail(Src: String): String;

procedure ChangeWallPaper (BmpFile: String);
//更改墙纸

implementation

procedure ChangeWallPaper(BmpFile: String);
//更改墙纸
var
  Reg: TRegistry;
begin
   Reg:=TRegistry.Create;
   Reg.RootKey:=Hkey_Current_User;
   Reg.OpenKey('Control Panel/Desktop', False);
   Reg.WriteString('Wallpaper', BmpFile);
   Reg.WriteString('TileWallpaper', '1'); //( 1-平铺 0-居中 2-拉伸)
   SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_UPDATEINIFILE);
   SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, SPI_SETDESKWALLPAPER, 0);
   Reg.CloseKey;
   Reg.Free;
end;

procedure CreateShortCut(FileName, ShortCutName: String);
//use Shellapi, ActiveX, ComObj, Shlobj
//创建快捷方式
//Example CreateShortCut('c:/windows/notepad.exe','记事本')
var
   tmpObject : IUnknown;
   tmpSLink : IShellLink;
   tmpPFile : IPersistFile;
   PIDL : PItemIDList;
   StartupDirectory : 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);
   LinkFilename:=AddTail(StartupDirectory) + ShortCutName + '.lnk';
   tmpPFile.Save(pWChar(LinkFilename), FALSE);
end;

function AddTail(Src: String): String;
//在路径字符串的最后加上'/'
begin
   if (Src[length(Src)]<>'/') then result:=Src+'/' else result:=Src;
end;

procedure DisNetDrv(DriverName: String);
//断开网络驱动器
begin
   if (DriverName[Length(DriverName)]<>':') then DriverName:=DriverName + ':';
   WNetCancelConnection2(PChar(DriverName), CONNECT_UPDATE_PROFILE, True);
end;

procedure MapNetDrv(LocalDriver, ShareName, Password, UserName: String);
//建立网络驱动器
var NRW: TNetResource;
begin
   if (LocalDriver[Length(LocalDriver)]<>':') then LocalDriver:=LocalDriver+':';

   with NRW do
      begin
         dwType:= RESOURCETYPE_ANY;
         lpLocalName:=PChar(LocalDriver);
         lpRemoteName:=PChar(ShareName);
         lpProvider:='';
       end;
   WNetAddConnection2(NRW, PChar(Password), PChar(UserName), CONNECT_UPDATE_PROFILE);
end;

function SelectDir(var S: String): Boolean;
//打开浏览目录对话框
var
   BI: TBrowseInfo;
   pIDLst: PItemIDList;
   Str: array[0..MAX_PATH-1] of char;
begin
   Result:=False;
   FillChar(Str, SizeOf(Str), 0);
   with BI do
      begin
         hwndOwner := Application.Handle;
         pidlRoot := nil;
         pszDisplayName := nil;
         lpszTitle := '请选择目录';
         ulFlags := 0;
         lpfn := nil;
         lParam := 0;
         iImage := 0;
      end;
   pIDLst:=SHBrowseForFolder(BI);
   SHGetPathFromIDList(pIDLst, @Str);
   //if BI.pszDisplayName <> nil then
   S:=Str;  //返回值在S中
   if S<>'' then Result:=True;
end;

function EncryptString(Source, Key: String): String;
//对字符串加密(Source:源 Key:密匙)
var KeyLen :Integer;
    KeyPos :Integer;
    offset :Integer;
    dest :string;
    SrcPos :Integer;
    SrcAsc :Integer;
    Range :Integer;
begin
   KeyLen:=Length(Key);
   if KeyLen = 0 then key:='ZhangLei';
   KeyPos:=0;
   Range:=256;
   Randomize;
   offset:=Random(Range);
   dest:=format('%1.2x',[offset]);
   for SrcPos := 1 to Length(Source) do
      begin
         SrcAsc:=(Ord(Source[SrcPos]) + offset) MOD 255;
         if KeyPos < KeyLen
         then KeyPos:= KeyPos + 1
         else KeyPos:=1;
         SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
         dest:=dest + format('%1.2x',[SrcAsc]);
         offset:=SrcAsc;
      end;
   Result:=Dest;
end;

function UnEncryptString (Source, Key: String):string;
//对字符串解密(Src:源 Key:密匙)
var KeyLen :Integer;
    KeyPos :Integer;
    offset :Integer;
    dest :string;
    SrcPos :Integer;
    SrcAsc :Integer;
    TmpSrcAsc :Integer;
begin
   KeyLen:=Length(Key);
   if KeyLen = 0 then key:='ZhangLei';
   KeyPos:=0;
   offset:=StrToInt('$'+ copy(Source,1,2));
   SrcPos:=3;
   repeat
      SrcAsc:=StrToInt('$'+ copy(Source,SrcPos,2));
      if KeyPos < KeyLen
      Then KeyPos := KeyPos + 1
      else KeyPos := 1;
      TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
      if TmpSrcAsc <= offset
      then TmpSrcAsc := 255 + TmpSrcAsc - offset
      else TmpSrcAsc := TmpSrcAsc - offset;
      dest:=dest + chr(TmpSrcAsc);
      offset:=srcAsc;
      SrcPos:=SrcPos + 2;
   until SrcPos >= Length(Source);
   Result:=Dest;
end;

procedure CdromSwitch(Status: Integer);
//打开或关闭光驱-- 0表示打开，1表示关闭
begin
   case Status of
      0: begin
            mciSendString('Set cdaudio door open wait', nil, 0, GetActiveWindow);
         end;
      1: begin
            mciSendString('Set cdaudio door closed wait', nil, 0, GetActiveWindow);
         end;
   end;
end;

procedure StopScreenSaver(const B: Boolean);
//设置禁止或允许屏幕保护
begin
   SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, DWord(B), nil,0);
end;

procedure Jpg2Bmp(JpgFile, BmpFile: String);
//将Jpg文件转换为Bmp文件
var
   MyJPEG : TJPEGImage;
   MyBMP : TBitmap;
begin
   MyJPEG := TJPEGImage.Create;
   with MyJPEG do
      try
         LoadFromFile(JpgFile); //你的图片位置
         MyBMP := TBitmap.Create;
         with MyBMP do
            begin
               Assign(MyJPEG);
               SaveToFile(BmpFile);//保存路径
               Free;
            end;
      finally
         Free;
      end;
end;

procedure Bmp2Jpg(BmpName, JpgName: String);
//将bmp文件转换为jpg文件
var
   MyJPEG : TJPEGImage;
   MyBMP : TBitmap;
begin
   MyBMP := TBitmap.Create;
   with MyBMP do
      try
         LoadFromFile(BmpName); //你的图片位置
         MyJPEG := TJPEGImage.Create;
         with MyJPEG do
            begin
               Assign(MyBMP);
               CompressionQuality:=60; //压缩比例 1..100
               Compress;
               SaveToFile(JpgName);//保存路径
               Free;
            end;
      finally
         Free;
      end;
end;

function xToD(const Num:Real):String;
//小写金额转大写金额
var aa,bb,cc:string;
    bbb:array[1..16]of string;
    uppna:array[0..9] of string;
    i:integer;
begin
   bbb[1]:='万';
   bbb[2]:='仟';
   bbb[3]:='佰';
   bbb[4]:='拾';
   bbb[5]:='亿';;
   bbb[6]:='仟';;
   bbb[7]:='佰';
   bbb[8]:='拾';
   bbb[9]:='万';
   bbb[10]:='仟';
   bbb[11]:='佰';
   bbb[12]:='拾';
   bbb[13]:='元';
   bbb[14]:='.';
   bbb[15]:='角';
   bbb[16]:='分';
   uppna[1]:='壹';
   uppna[2]:='贰';
   uppna[3]:='叁';
   uppna[4]:='肆';
   uppna[5]:='伍';
   uppna[6]:='陆';
   uppna[7]:='柒';
   uppna[8]:='捌';
   uppna[9]:='玖';
   Str(num:16:2,aa);
   cc:='';
   bb:='';
   result:='';
   for i:=1 to 16 do
     begin
       cc:=aa[i];
       if cc<>' ' then
         begin
          bb:=bbb[i];
           if cc='0' then
             cc:='零'
           else
             begin
               if cc='.' then
                 begin
                   cc:='';
                   bb:='';
                 end
               else
                 begin
                   cc:=uppna[StrToInt(cc)];
                 end
             end;
           result:=result+(cc+bb)
         end;
     end;
   //result:=result+'正';
end;

function GetBootedTime: Real;
//获取Windows启动后经过的时间(分钟)
begin
   Result:=Int(GetTickCount/1000/60);
end;

function GetAppName: String;
//获取当前程序的文件名(带路径)
begin
  Result:=Application.ExeName;
end;

function GetRes(ResType, ResName, ResNewName: String): Boolean;
//从资源文件中提取资源
var
  Res: TResourceStream;
begin
  try
    Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
    try
      Res.SavetoFile(ResNewName);
      Result := true;
    finally
      Res.Free;
    end;
  except
    Result := false;
  end;
end;

function GetIP:string;
//此函数实际是获取最后一个IP地址的字符串，一般是拨号后动态分配的IP地址。
//如果，主机还未拨号上网，则返回的是本地局域网的IP地址
var
  WSAData:TWSAData;
  HostName:array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  HostEnt:PHostEnt;
  LastIP:PInAddr;
  IPList:^PInAddr;
begin
  result:='';
  if 0=WSAStartup(MAKEWORD(1,1), WSAData) then
  try
    if 0=gethostname(HostName, MAX_COMPUTERNAME_LENGTH+1) then
    begin
      HostEnt:=gethostbyname(HostName);
      if HostEnt<>nil then
      begin
        IPList:=Pointer(HostEnt^.h_addr_list);
        repeat
          LastIP:=IPList^;
          INC(IPList);
        until IPList^=nil;
        if LastIP<>nil then
          result:=inet_ntoa(LastIP^);
      end;
    end;
  finally
    WSACleanup;
  end;
end;

procedure About;
//显示Windows关于对话框
begin
   ShellAbout(Application.Handle, PChar(application.MainForm.Caption), '',Application.Icon.Handle );
end;

procedure ShareDisks;
//共享所有磁盘
var
   Reg: TRegistry;
   Buffer: PChar;
   i: Integer;
   S: TStringList;
const
   Key='SOFTWARE/Microsoft/Windows/CurrentVersion/Network/LanMan/';
begin
   S:=TStringList.Create;
   GetDisks(S);
   S.Delete(0);

   if Win32Platform <> VER_PLATFORM_WIN32_NT
   then
      begin
         for i:=0 to S.Count-1 do
            begin
               Reg:=TRegistry.Create;
               try
                  Reg.RootKey:=HKEY_LOCAL_MACHINE;
                  Reg.OpenKey(Key + UpperCase(Copy(S.Strings[i],1,1)) + '$', True);
                  Reg.WriteInteger('Flags', 770);
                  Reg.WriteString('Path', UpperCase(S.Strings[i]));
                  Reg.WriteString('Remark', '');
                  Reg.WriteInteger('Type', 0);
                  Reg.WriteBinaryData('Parm1enc', Buffer, 0);
                  Reg.WriteBinaryData('Parm2enc', Buffer, 0);
                  Reg.CloseKey;
               finally
                  Reg.Free;
               end;
            end;
      end
   else
      begin
      end;

   S.Free;
end;

procedure RunAtStartup(Key, Value: String);
//把程序放到注册表的启动组里
var Reg: TRegistry;
begin
   Reg:=TRegistry.Create;
   Reg.RootKey:=HKEY_LOCAL_MACHINE;
   Reg.OpenKey('/SOFTWARE/Microsoft/Windows/CurrentVersion/Run', False);
   Reg.WriteString(Key, Value);
   Reg.Free;
end;

procedure HideApp;
//隐藏程序
type
   TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD; stdcall;
var
   Hndl: THandle;
   RegisterServiceProcess: TRegisterServiceProcess;
begin
   if Win32Platform <> VER_PLATFORM_WIN32_NT
   then //不是NT
      begin
         Hndl:=LoadLibrary('KERNEL32.DLL');
         RegisterServiceProcess:=GetProcAddress(Hndl, 'RegisterServiceProcess');
         RegisterServiceProcess(GetCurrentProcessID, 1);
         //程序不出现在ALT+DEL+CTRL列表中
         SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
         //程序不出现在任务栏
         Application.ShowMainForm:=False;
         //程序不出现主窗口
         FreeLibrary(Hndl);
      end
   else
      begin
         SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
         //程序不出现在任务栏
         Application.ShowMainForm:=False;
         //程序不出现主窗口
      end;
end;

procedure GetDisks(Strings: TStringList);
//获取所有盘符
const BufSize = 256;
var Buffer: PChar;
    P: PChar;
begin
   GetMem(Buffer, BufSize);
   try
      Strings.BeginUpdate;
      try
         Strings.Clear;
         if GetLogicalDriveStrings(BufSize, Buffer) <> 0 then
            begin
               P := Buffer;
                  while P^ <> #0 do
                     begin
                        Strings.Add(P);
                        Inc(P, StrLen(P) + 1);
                     end;
            end;
      finally
         Strings.EndUpdate;
      end;
   finally
      FreeMem(Buffer, BufSize);
   end;
end;

function CloseApp(ClassName: String): Boolean;
//关闭外部应用程序
var Exehandle: THandle;
begin
   //ExeHandle := FindWindow(nil, Pchar(Caption));
   ExeHandle := FindWindow(Pchar(ClassName),nil);
   if ExeHandle <> 0
   then
      begin
         PostMessage(ExeHandle, WM_Quit, 0, 0);
         Result:=True;
      end
   else
      begin
         Result:=False;
      end;
end;

function GetTmpPath: String;
//取得WINDOWS的Temp路径
var TmpDir: PChar ;
begin
   GetMem(TmpDir,255);
   GetTempPath(255, TmpDir);
   Result:=(TmpDir);
   if Result[Length(Result)]<>'/' then Result := Result + '/';
   FreeMem(TmpDir);
end;

function GetWinPath: String;
//取得WINDOWS安装路径
var WinDir: PChar ;
begin
   GetMem(WinDir,255);
   GetWindowsDirectory(WinDir,255);
   Result:=(WinDir);
   if Result[Length(Result)]<>'/' then Result := Result + '/';
   FreeMem(WinDir);
end;

function GetSysPath: String;
//取得WINDOWS的SYSTEM路径
var SysDir: PChar ;
begin
   GetMem(SysDir,255);
   GetSystemDirectory(SysDir,255);
   Result:=(SysDir);
   if Result[Length(Result)]<>'/' then Result := Result + '/';
   FreeMem(SysDir);
end;

function GetAppPath:String;
//返回当前程序的目录
begin
   Result:=ExtractFilePath(Application.ExeName);
   if Result[Length(Result)]<>'/' then Result := Result + '/';
end;

procedure MyMsg(Msg: String);
//显示提示信息框
begin
   Application.MessageBox(PChar(Msg),'信息',
                          MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
end;

procedure DeleteMe;
//程序自杀
   //-----------------------------------------------------------
   //转换长文件名
   function GetShortName(sLongName: string): string;
   var sShortName: string;
       nShortNameLen: integer;
   begin
      SetLength(sShortName, MAX_PATH);
      nShortNameLen := GetShortPathName(PChar(sLongName),
      PChar(sShortName), MAX_PATH - 1);
      if (0 = nShortNameLen) then
         begin
         //handle errors...
         end;
      SetLength(sShortName, nShortNameLen);
      Result := sShortName;
   end;
   //-------------------------------------------------
var
   BatchFile: TextFile;
   BatchFileName: string;
   ProcessInfo: TProcessInformation;
   StartUpInfo: TStartupInfo;
begin
   BatchFileName := ExtractFilePath(ParamStr(0)) + '$$a$$.bat';
   AssignFile(BatchFile, BatchFileName);
   Rewrite(BatchFile);
   Writeln(BatchFile, ':try');
   Writeln(BatchFile, 'del "' + GetShortName(ParamStr(0)) + '"');
   Writeln(BatchFile, 'if exist "' + GetShortName(ParamStr(0)) + '"' + ' goto try');
   Writeln(BatchFile, 'del %0');
   Writeln(BatchFile, 'cls');
   Writeln(BatchFile, 'exit');
   CloseFile(BatchFile);
   FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
   StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
   StartUpInfo.wShowWindow := SW_Hide;
   if CreateProcess(nil, PChar(BatchFileName), nil, nil,
   False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
   ProcessInfo) then
      begin
         CloseHandle(ProcessInfo.hThread);
         CloseHandle(ProcessInfo.hProcess);
      end;
//Application.Terminate;
end;

function GetHdID : String;
//获取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;

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 := '';
  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(Result,sSerialNumber,SizeOf(sSerialNumber));
  end;
end;

end.