myfunction.pas

界面精美

unit MyFunction;

interface

uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,shellAPI,
Forms,Dialogs,ExtCtrls,StdCtrls,ComCtrls,Registry;

const
 cOsUnknown:integer=-1;
 cOsWin95:integer=0;
 cOsWin98:integer=1;
 cOsWin98SE:integer=2;
 cOsWinME:integer=3;
 cOsWinNT:integer=4;
 cOsWin2000:integer=5;
 cOsWhistler:integer=6;
 IOR_READ=0;
 IOR_WRITE=1;
 IORF_PHYS_CMD=$40000000;
 IORF_VERSION_002=$400;
 IORF_SYNC_COMMAND=$100;
 IORF_HIGH_PRIORITY=1;

 //用于FORMAT的常量
 SHFMT_ID_DEFAULT        = $FFFF;
 // Formating options
 SHFMT_OPT_QUICKFORMAT   = $0000;
 SHFMT_OPT_FULL          = $0001;
 SHFMT_OPT_SYSONLY       = $0002;
 // Error codes
 SHFMT_ERROR             = $FFFFFFFF;
 SHFMT_CANCEL            = $FFFFFFFE;
 SHFMT_NOFORMAT          = $FFFFFFFD;

 //以下磁盘读写操作使用
 FILE_FLAG_DELETE_ON_CLOSE=$04000000;

 VWIN32_DIOC_DOS_IOCTL=1;{MS-DOS INT 21H 44XXH FUNCTION CALL}
 VWIN32_DIOC_DOS_INT25=2;{MS-DOS INT 25H FUNCTION CALL}
 VWIN32_DIOC_DOS_INT26=3;{MS-DOS INT 26H FUNCTION CALL}
 VWIN32_DIOC_DOS_INT13=4;{MS-DOS INT 13H FUNCTION CALL}
 VWIN32_DIOC_DOS_DRIVEINFO=6;{MS-DOS INT21H FUNCTION 730X}
 MAX_DRV=8;

type
  //TVolumeInfo 为一个记录类，其各字段记录各个逻辑驱动器的不同信息
  TVolumeInfo=record
     Name:string;
     SerialNumber :DWORD;
     MaxComponentLength:DWORD;
     FileSystemFlags:DWORD;
     FileSystemName:string;
   end;  //end of TVolumeInfo

   //TRegistInfo 为一个记录类，其各字段记录用户注册信息
   TRegistInfo=record
      Company:string;
      User:string;
      ProductID:string;
      ProductKey:string;
    end;  //end of TRegistInfo

    //TDriveType为一个驱动器类型集合类型
    TDriveType=(dtUnknown,dtNoDrive,dtFloppy,dtFixed,
                 dtNetwork,dtCDROM,dtRAM);

    MemoryStatus=record
       dwLength:DWORD;  //该记录的大小，sizeof(MEMORYSTATUS)
       dwMemoryLoad:DWORD; //当前正在使用的内存资源的百分比
       dwTotalPhys:DWORD;  //物理内存的字节数
       dwAvailPhys:DWORD;  //未使用的物理内存的字节数
       dwTotalPageFile:DWORD; //交换文件的字节数
       dwAvailPageFile:DWORD; //未使用的交换文件的字节数
       dwTotalVirtual:DWORD;  //虚拟内存的字节数
       dwAvailVirtual:DWORD;  //未使用的虚拟内存的字节数
    end; //end of MemoryStatus

    //磁盘IO结构
    TDiskIO=packed Record
      dwStartSector:longint;
      wSectors:smallint;
      lpBuffer:PChar;
    end;   //end of TDiskIO

    //32位寄存器结构
    P32Regs=^T32Regs;
    T32Regs=record
      EBX:longint;
      EDX:longint;
      ECX:longint;
      EAX:longint;
      EDI:longint;
      ESI:longint;
      Flags:longint;
    end; //  end of T32Regs

 Ttype_sdeffsd_req_usage = packed record
   _IOR_ioctl_drive:word;
   _IOR_ioctl_function:word;
   _IOR_ioctl_control_param:longword;
   _IOR_ioctl_buffer_ptr:longword;
   _IOR_ioctl_client_params:longword;
   _IOR_ioctl_return:longword;
  end;
  Turequestor_usage = packed record
  case integer of
  1:(
   _IOR_requestor_usage:array[0..4]of longword;);
  2:(
   sdeffsd_req_usage:Ttype_sdeffsd_req_usage;);
  end;
  TIOR=packed record
      IOR_next:longword;{ 为BCB的(MBZ for IORF_VERSION_002) 的客户链接 }
      IOR_func:word;{子功能号}
      IOR_status:word;{请求的状态}
      IOR_flags:longword;{请求控制标志}
      IOR_callback:procedure;{如果IORF_SYNC_COMMAND未设置，则为回调函数地址}
      IOR_start_addr:array[0..1]of longword;{相对开始地址}
      IOR_xfer_count:longword;{处理的扇区数}
      IOR_buffer_ptr:longword;{客户缓冲区指针}
      IOR_private_client:longword;{ BlockDev/IOS客户保留}
      IOR_private_IOS:longword;{IOS保留空间}
      IOR_private_port:longword;{端口驱动的私有区域}
      _ureq:Turequestor_usage;
      IOR_req_req_handle:longword;{请求句柄}
      IOR_req_vol_handle:longword;{媒体句柄，指向VRP结构}
      IOR_sgd_lin_phys:longword;{指向第一个物理SGD }
      IOR_num_sgds:byte;{物理SGD的数目}
      IOR_vol_designtr:byte;{视子功能号的不同，可能是以下两种情况：(1)A盘为0，B盘为1，C盘为2……(2)软盘是0-7F，硬盘是80-FF}
      IOR_ios_private_1:word;{由IOS保留强制对齐}
      IOR_reserved_2:array[0..1]of longword;  {保留，内部使用}
  end;
  PIOR=^TIOR;
  TRing0DiskRW = record
     ReadOrNot:boolean;
     Drv:byte;
     StartSecLo,StartSecHi:longword;
     DiskBuffer:pchar;
     result:boolean;
  end;
  PTable=^Table;
  Table = record
  	Bootable:char;
        SysType :char;
        BeginHead:word;
	BeginCylinder:word;
	EndCylinder:word;
	StartSector:longword;
	OverSector:longword ;
	TotalSectors:longword ;
	Logical:bool ;//是否为逻辑分区
	FLAG:char ; ////////作为更新分区表标志用
	Next:PTable;
   end;

var
   UserName  :string;
   ComputerName:string;

   buffer:TDiskIO;
   hdeviceHandle:THandle;
   reg:T32Regs;

   IDT : array [0..5] of byte;
   lpOldGate : dword;
   Ring0DiskRW:TRing0DiskRW;
   DiskTotalSecs:longword;
   maxtracks:word;
   mhead,msector:array[0..MAX_DRV-1]of word;
   mtrack:array[0..MAX_DRV-1]of word;
   bhead,ehead,bsector,esector:array[0..MAX_DRV-1]of longword;
   btrack,etrack:array[0..MAX_DRV-1]of longword;
   //totalSec:array[0..MAX_DRV-1]of longword;
   Sector_No,End_Sector_No,Extend_Start_No:longword;
   PartType:array[0..MAX_DRV-1]of integer;
   maxParts:integer;
   //Dbuf:array[0..512-1]of char;
    THead:PTable=nil;
    Cylinder,Head,Sector:longword;/////当前的柱面，磁头，扇区
    Cylinders,Heads,Sectors:longword;//硬盘决柱面数据，总磁头数，扇区数/每磁道
    TotalSectors:longword;//硬盘总扇区数
    StartSector:longword;//操作时的开始扇区数
   //
   function GetRegistInfo:TRegistInfo;
   function GetOSVersion:integer;
   function GetOSName(OSCode:integer):string;
   function GetOSLanguage:string;
   function GetOSStartModel:string;
   function NewGetLogicalDrives:string;
   function DriveType(const Drive:Char):TDriveType;
   procedure GetDiskSizeAvail(TheDrive:PChar;
                              var TotalBytes:double;
                              var TotalFree:double);
   function GetVolumeInformation(const Drive:char):TVolumeInfo;
   function NewGlobalMemoryStatus(const Index:Integer):DWORD;
   function NewGetSystemInfoWORD(const Index:Integer):WORD;
   function NewGetSystemInfoDWORD(const Index:Integer):DWORD;
   function NewGetComputerName:String;
   function DynamicResolution(X,Y:WORD):BOOL;
   function LockDisk(VMM32Handle:cardinal;disk:byte;LockOrNot:boolean):boolean;
   function LockDrive(VMM32Handle:cardinal;drive:byte;LockOrNot:boolean):boolean;
   function IsChar(AsciiCode:integer):char;
   procedure FormatDrive(Const Drive:Char;OPT:integer);
   function GetBios(value:integer):string;
   procedure ReadAnyLSec(Ldrive:char; SecStart:Cardinal; Sec:Pchar);
   procedure ReadAnyPSec(SecStart:longword; SecBuf:Pchar);
   procedure SearchDrivers();
   function GetWinVer:Byte;  //获取WINDOWS 操作系统的版本
   Procedure WriteAnyPSec(SecStart:longword;Buf:array of char);

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt;
        stdcall; external 'shell32.dll' name 'SHFormatDrive'

implementation

uses unit2, main;

//--------获取用户注册信息
function GetRegistInfo:TRegistInfo;
var
  osVerInfo:TOSVersionInfo;
  Reg:TRegistry;  //必须在Uses加入registry

begin
 //判断是9x还是NT系统，再对相应的注册表进行操作
 osVerInfo.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
 if(GetVersionEx(osVerInfo))then
 begin
  case(osVerInfo.dwPlatformId)of
    VER_PLATFORM_WIN32_NT:{Windows NT/2000}
    begin                           //从注册表中得到用户注册信息
     Reg:=TRegistry.Create;
     Reg.RootKey:=HKEY_LOCAL_MACHINE;//主键
     Reg.OpenKey('software\Microsoft\Windows NT\CurrentVersion',False);//打开键
     with Result do
     begin
      //Co Infomation
      Company:=Reg.ReadString('RegisteredOrganization');
      //User Information
      User:=Reg.ReadString('RegisteredOwner');
      //Serial No.
      ProductID:=Reg.ReadString('ProductID');
      //regist NO.
      ProductKey:=Reg.ReadString('ProductKey');
     end;       //end of with
     Reg.CloseKey;//关闭键
     Reg.Free;
    end;       //end of VER_PLATFORM_WIN32_NT

    VER_PLATFORM_WIN32_WINDOWS:{Windows 9x/ME}
    begin
     Reg:=TRegistry.Create;
     Reg.RootKey:=HKEY_LOCAL_MACHINE;//主键
     Reg.OpenKey('software\Microsoft\Windows\CurrentVersion',False);//打开键
     with Result do
     begin
      //Co Infomation
      Company:=Reg.ReadString('RegisteredOrganization');
      //User Information
      User:=Reg.ReadString('RegisteredOwner');
      //Serial No.
      ProductID:=Reg.ReadString('ProductID');
      //regist NO.
      ProductKey:=Reg.ReadString('ProductKey');
     end;       //end of with
     Reg.CloseKey;//关闭键
     Reg.Free;
    end;//end of VER_PLATFORM_WIN32_WINDOWS
  end;//end of case
 end; //end of if
end;

//----------获取系统的版本号
function GetOSVersion:integer;
var
 osVerInfo:TOSVersionInfo;
 majorVer,minorVer:integer;
begin
 Result:=cOsUnknown;
 osVerInfo.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
 if(GetVersionEx(osVerInfo))then
 begin
   majorVer:=osVerInfo.dwMajorVersion;
   minorVer:=osVerInfo.dwMinorVersion;
   case(osVerInfo.dwPlatformId)of
    VER_PLATFORM_WIN32_NT:{Windows NT/2000}
    begin
      if(majorVer<=4)then
        Result:=cOsWinNT
      else
      if((majorVer=5)and(minorVer=0))then
        Result:=cOsWin2000
      else
      if((majorVer=5)and(minorVer=1))then
        Result:=cOsWhistler
      else
        Result:=cOsUnknown;
    end;
    VER_PLATFORM_WIN32_WINDOWS:{Windows 9x/ME}
    begin
      if((majorVer=4)and(minorVer=0))then
        Result:=cOsWin95
      else
      if((majorVer=4)and(minorVer=10))then
       begin
        if(osVerInfo.szCSDVersion[1]='A')then
          Result:=cOsWin98SE
        else
          Result:=cOswin98;
       end
      else
       if((majorVer=4)and(minorVer=90))then
        Result:=cOsWinME
       else
        Result:=cOsUnknown;
    end;
   else
     Result:=cOsUnknown;
  end; //end of case
 end
 else
    Result:=cOsUnknown;
end;

//----------获取系统版本名称
function GetOSName(OSCode:integer):string;
var
  VersionInfo:TOSVersionInfo;
begin
 VersionInfo.dwOSVersionInfoSize:=sizeof(TOSVersionInfo);
 if Windows.GetVersionEx(VersionInfo)then

   with VersionInfo do
   if(OSCode=cOsUnknown)then
     Result:='(sconociuto)'
   else
    if(OSCode=cOsWin95)then
      Result:='Microsoft Windows 95'+
              #13+inttostr(dwMajorVersion)+'.'+
              IntToStr(dwMinorVersion)+'.'+
              IntToStr(LOWORD(dwBuildNumber))+':'+szCSDVersion
    else
     if(OSCode=cOsWin98)then
       Result:='Microsoft Windows 98'+
              #13+inttostr(dwMajorVersion)+'.'+
              IntToStr(dwMinorVersion)+'.'+
              IntToStr(LOWORD(dwBuildNumber))+':'+szCSDVersion
     else
      if(OSCode=cOsWin98SE)then
        Result:='Microsoft Windows 98 Second Edition'+
              #13+inttostr(dwMajorVersion)+'.'+
              IntToStr(dwMinorVersion)+'.'+
              IntToStr(LOWORD(dwBuildNumber))+':'+szCSDVersion
      else
       if(OSCode=cOsWinME)then
         Result:='Micorsoft Windows Millennium Edition'+
              #13+inttostr(dwMajorVersion)+'.'+
              IntToStr(dwMinorVersion)+'.'+
              IntToStr(dwBuildNumber)+':'+szCSDVersion
       else
        if(OSCode=cOsWinNT)then
          Result:='Microsoft Windows New Technology'+
              #13+inttostr(dwMajorVersion)+'.'+
              IntToStr(dwMinorVersion)+'.'+
              IntToStr(dwBuildNumber)+':'+szCSDVersion
        else
         if(OSCode=cOsWin2000)then
           Result:='Microsoft Windows 2000/NT 5'+
              #13+inttostr(dwMajorVersion)+'.'+
              IntToStr(dwMinorVersion)+'.'+
              IntToStr(dwBuildNumber)+':'+szCSDVersion
         else
           Result:='Microsoft Windows'+
              #13+inttostr(dwMajorVersion)+'.'+
              IntToStr(dwMinorVersion)+'.'+
              IntToStr(dwBuildNumber)+':'+szCSDVersion;
end;

//----------识别各种语言版本的WINDWOS
function GetOSLanguage:string;
var
  ID:LangID;
  Language:array[0..100]of char;
begin
  ID:=GetSystemDefaultLangID;
  VerLanguageName(ID,Language,100);
  Result:=String(Language);
end;

//----------检测WINDOWS的启动模式
function GetOSStartModel:string;
begin
  case(GetSystemMetrics(SM_CLEANBOOT))of
   0:Result:='正常模式启动';
   1:Result:='安全模式启动';
   2:Result:='安全模式启动，但附带网络功能';
  else
   Result:='错误：系统启动有问题。';
  end;  //  end of case
end;

//---------获得系统逻辑盘符
function NewGetLogicalDrives:string;
var
  //逻辑磁盘最大数目为25
  drives:set of 0..25; //0至25的枚举变量
  drive:integer;
begin
  Result:='';
  DWORD(drives):=Windows.GetLogicalDrives;
  for drive:=0 to 25 do
    if drive in drives then
      Result:=Result+Chr(drive+Ord('A'));
end;

//----------获取驱动器类型
function DriveType(const Drive:Char):TDriveType;
begin
  Result:=TDriveType(GetDriveType(PChar(Drive+':\')));
end;

//----------获取各盘容量信息(只适用于总容量小于4GB的磁盘)
function GetDiskFreeSpaceEx(lpDirectoryName:PAnsiChar;
  var lpFreeBytesAvailableToCaller:Integer;
  var lpTotalNumberOfBytes:Integer;