myfunction.pas

界面精美

  var lpTotalNumberOfFreeBytes:Integer):bool;
  stdcall;
  external kernel32
  name 'GetDiskFreeSpaceExA';
procedure GetDiskSizeAvail(TheDrive:PChar;
                                var TotalBytes:double;
                                var TotalFree:double);
var
  AvailToCall:integer;
  TheSize:integer;
  FreeAvail:integer;
begin
   GetDiskFreeSpaceEx(TheDrive,AvailToCall,TheSize,FreeAvail);
   {$IFOPT Q+}
   {$DEFINE TURNOVERFLOWON}
   {$Q-}
   {$ENDIF}
   if TheSize>=0 then
      TotalBytes:=TheSize
   else
    if TheSize=-1 then
     begin
       TotalBytes:=$7FFFFFFF;
       TotalBytes:=TotalBytes*2;
       TotalBytes:=TotalBytes+1;
     end
    else
     begin
       TotalBytes:=$7FFFFFFF;
       TotalBytes:=TotalBytes+abs($7FFFFFFF-TheSize);
     end;
   if AvailToCall>=0 then
      TotalFree:=AvailToCall
   else
    if AvailToCall=-1 then
     begin
       TotalFree:=$7FFFFFFF;
       TotalFree:=TotalFree*2;
       TotalFree:=TotalFree+1;
     end
    else
     begin
       TotalFree:=$7FFFFFFF;
       TotalFree:=TotalFree+abs($7FFFFFFF-AvailToCall);
     end;
end;

//----------获取磁盘卷标信息
function GetVolumeInformation(const Drive:char):TVolumeInfo;
var
  lpRootPathName    :PChar;
  lpVolumeNameBuffer:PChar;
  nVolumeNameSize   :DWORD;
  lpVolumeSerialNumber:DWORD;
  lpMaximumComponentLength:DWORD;
  lpFileSystemFlags       :DWORD;
  lpFileSystemNameBuffer  :PChar;
  nFileSystemNameSize     :DWORD;
begin
  //分配内存
  GetMem(lpVolumeNameBuffer,MAX_PATH+1);
  GetMem(lpFileSystemNameBuffer,MAX_PATH+1);
  try
    nVolumeNameSize:=MAX_PATH+1;
    nFileSystemNameSize:=MAX_PATH+1;
    lpRootPathName:=PChar(Drive+':\');
    if Windows.GetVolumeInformation(lpRootPathName,
                                    lpVolumeNameBuffer,
                                    nVolumeNameSize,
                                    @lpvolumeSerialNumber,
                                    lpMaximumComponentLength,
                                    lpFileSystemFlags,
                                    lpFileSystemNameBuffer,
                                    nFileSystemNameSize)then
     begin
       with Result do
       begin
         Name:=lpVolumeNameBuffer;
         SerialNumber:=lpVolumeSerialNumber;
         MaxComponentLength:=lpMaximumComponentLength;
         FileSystemFlags:=lpFileSystemFlags;
         FileSystemName:=lpFileSystemNameBuffer;
       end; //end of with
     end  //end of if
    else
     begin
       with Result do
       begin
         Name:='';
         SerialNumber:=0;
         MaxComponentLength:=0;
         FileSystemFlags:=0;
         FileSystemName:='';
       end;  //end of with
     end;   //end of else
  finally
    FreeMem(lpVolumeNameBuffer);
    FreeMem(lpFileSystemNameBuffer);
  end;  //end of try
end;

//--------获取内存资源信息
function NewGlobalMemoryStatus(const Index:Integer):DWORD;
var
  MemoryStatus:TMemoryStatus;
begin
  with MemoryStatus do
  begin
    dwLength:=sizeof(TMemoryStatus);
    Windows.GlobalMemoryStatus(MemoryStatus);
    case Index of
      1: Result:= dwMemoryLoad;
      2: Result:= dwTotalPhys div 1024;
      3: Result:= dwAvailPhys div 1024;
      4: Result:= dwTotalPageFile div 1024;
      5: Result:= dwAvailPageFile div 1024;
      6: Result:= dwTotalVirtual div 1024;
      7: Result:= dwAvailVirtual div 1024;
      else Result:=0;
        //1:内存资源百分比  2:物理内存总量 3:未使用的物理内存容量
        //4:交换文件大小 5:未使用的交换文件大小 6:虚拟内存总量 7:未用的虚拟内存量
    end; //end of case
  end; //end of with
end;

//------获得系统CPU信息
function NewGetSystemInfoWORD(const Index:Integer):WORD;
var
  SysInfo:TSystemInfo;
begin
   Windows.GetSystemInfo(SysInfo);
   with SysInfo do
    case Index of
      1: Result:=wProcessorArchitecture;
      2: Result:=wProcessorLevel;
      3: Result:=wProcessorRevision;
      else Result:=0;
    end;  //end of case
end;

function NewGetSystemInfoDWORD(const Index:Integer):DWORD;
var
  SysInfo:TSystemInfo;
begin
  Windows.GetSystemInfo(SysInfo);
  with SysInfo do
    case Index of
      1:  Result:=dwPageSize;
      2:  Result:=dwActiveProcessorMask;
      3:  Result:=dwNumberOfProcessors;
      4:  Result:=dwProcessorType;
      5:  Result:=dwAllocationgranularity;
      else  Result:=0;
    end;   //end of case
end;

//--------获得计算机名
function NewGetComputerName:String;
var
  pcComputer:PChar;
  dwCSize:DWORD;
begin
  dwCSize:=MAX_COMPUTERNAME_LENGTH+1;
  GetMem(pcComputer,dwCSize);
  try
    if Windows.GetComputerName(pcComputer,dwCSize)then
      Result:=pcComputer;
  finally
    FreeMem(pcComputer);
  end;  //end of try
end;

function DynamicResolution(X,Y:WORD):BOOL;
var
  lpDevMode:TDeviceMode;
begin
  Result:=EnumDisplaySettings(nil,0,lpDevMode);
  if Result then
  begin
    lpDevMode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT;
    lpDevMode.dmPelsWidth:=X;
    lpDevMode.dmPelsHeight:=Y;
    Result:=windows.ChangeDisplaySettings(lpDevMode,0)=DISP_CHANGE_SUCCESSFUL;
  end;
end;

//--------对物理磁盘加锁，解锁
function LockDisk(VMM32Handle:cardinal;disk:byte;LockOrNot:boolean):boolean;
var
  R:T32Regs;
  cb:DWord;
begin
{对物理磁盘加锁，解锁，第一参数是VMM32的文件句柄，第二参数是磁盘编号，
软盘从0开始，硬盘从$80开始}
  if(VMM32Handle=INVALID_HANDLE_VALUE)then
  begin
    result:=false;
    exit;
  end;
  fillchar(r,sizeof(r),0);
  if LockOrNot=true then
   begin
     R.ECX:=$084b;
     R.EBX:=$100+disk;
     R.EDX:=1;   //1允许写，0允许格式化
   end
  else
   begin
     R.ECX:=$086b;
     R.EBX:=disk;
   end;
   R.EAX:=$440d;
   DeviceIOControl(VMM32Handle,VWIN32_DIOC_DOS_IOCTL,@R,SizeOf(R),@R,
       SizeOf(R),cb,nil);
   Result:=(R.Flags and 1 =0);
end;

//-----------对逻辑磁盘加锁，解锁
function LockDrive(VMM32Handle:cardinal;drive:byte;LockOrNot:boolean):boolean;
var
  R:T32Regs;
  cb:DWord;
begin
{对逻辑磁盘加锁，解锁，第一参数是VMM32的文件句柄，第二参数是磁盘编号，
1：A, 2: B, 3: C, 4: D …… }
  if(VMM32Handle=INVALID_HANDLE_VALUE)then
   begin
     result:=false;
     exit;
   end;
  fillchar(r,sizeof(r),0);
  if LockOrNot=true then
   begin
     R.ECX:=$084a;
     R.EBX:=$100+drive;
     R.EDX:=1;    //1允许写， 0允许格式化
   end
  else
   begin
     R.ECX:=$086a;
     R.EBX:=drive;
   end;
  R.EAX:=$440d;
  DeviceIoControl(VMM32Handle,VWIN32_DIOC_DOS_IOCTL,@R,SizeOf(R),@R,
         SizeOf(R),cb,nil);
  Result:=(R.Flags and 1=0);
end;

//------------判断字符代码是否为可显示字符
function IsChar(AsciiCode:integer):Char;
begin
  if ((AsciiCode>=32) and (AsciiCode<=128))then
        Result:=Chr(AsciiCode);
  if ((AsciiCode>128) or (AsciiCode<32) and (AsciiCode>=0)) then
        Result:='.';
end;

//----------格式化磁盘 1:quick  2:full  3:sysonly
procedure FormatDrive(Const Drive:Char; OPT:integer);
var
  wDrive:WORD;
  dtDrive:TDriveType;
  strDriveType:string;
begin
  wDrive:=0;
  if Messagedlg('磁盘格式化后 '+Drive+' 盘会掉失所有数据！！！,真的要格式化？',mtWarning,[mbNo,mbYes],0)=IdYes then
  begin
  //确定驱动器的类型
  dtDrive:=DriveType(Drive);
  //如果不是硬盘或软盘则产生一个例外
  if (dtDrive <> dtFloppy) and (dtDrive <> dtFixed) then
    begin
      strDriveType:='Cannot format a';
      case dtDrive of
       dtUnknown:
          strDriveType:='Cannot determine drive type';
       dtNoDrive:
          strDriveType:='Specified drive does not exist';
       dtNetwork:
          strDriveType:=strDriveType+'Network Drive';
       dtCDROM:
          strDriveType:=strDriveType+'CD-ROM Drive';
       dtRAM:
          strDriveType:=strDriveType+'RAM Drive';
      end;   //end of case
      raise Exception.Create(strDriveType+' !!');
    end  //end of if
  else
    //执行格式化操作
    begin
      case Drive of
      'A'..'Z':
        wDrive:=Ord(Drive)-Ord('A');
      'a'..'z':
        wDrive:=Ord(Drive)-Ord('a');
      end; //end of case Drive
      case Opt of
      1:
       SHFormatDrive(Application.Handle,wDrive,SHFMT_ID_DEFAULT,SHFMT_OPT_QUICKFORMAT);
      2:
       SHFormatDrive(Application.Handle,wDrive,SHFMT_ID_DEFAULT,SHFMT_OPT_FULL);
      3:
       SHFormatDrive(Application.Handle,wDrive,SHFMT_ID_DEFAULT,SHFMT_OPT_SYSONLY);
      end;  //end of case Opt
    end;    // end of else
  end;  //end of if Messagedlg  
end;

//-----------获取BIOS版本相关信息
function GetBios(value:integer):string;
//1...Bios Type
//2...Bios Copyright
//3...Bios Date
//4...Bios Extended Info
//5...Bus Type
//6...Machine Type
begin
  result:='(unavailable)';
  case value of
  1: result:=String(PChar(Ptr($FE061)));
  2: result:=String(PChar(Ptr($FE091)));
  3: result:=String(PChar(Ptr($FFFF5)));
  4: result:=String(PChar(Ptr($FEC71)));
  end;  //end of case
end;

//----------获取WINDOWS 操作系统的版本
function GetWinVer:Byte;
var
  Os:TOSVersionInfo;
begin
  os.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
  GetVersionEx(Os);
  case Os.dwPlatformId of
    VER_PLATFORM_WIN32S :       result:=0; //win 31x/32s
    VER_PLATFORM_WIN32_WINDOWS: result:=1; //win95
    VER_PLATFORM_WIN32_NT:      result:=2; //winNT
  end;  // end of case
end;
  
//----------读取某一个逻辑磁盘的引导扇区
procedure ReadAnyLSec(Ldrive:char; SecStart:Cardinal; Sec:Pchar);
const
  BytesPerSector=512;
  SectorCount=1;       //读写扇区数
var
  Ldrive2000:PChar;
  Ldrive9x:integer;
  drive:char;
  cb:DWORD;
  osVerInfo:TOSVersionInfo;
  p:pchar;
begin
   //分析是对哪个逻辑盘操作
   Ldrive9x:=3;
   Ldrive2000:='\\.\C:';
   p:=nil;
   drive:=Ldrive;
   case drive of
   'A'..'Z':
     begin
       Ldrive2000:=Pchar('\\.\'+Ldrive+':');
       Ldrive9x:=Ord(Ldrive)-Ord('A')+1;
     end;
   'a'..'z':
     begin
       Ldrive2000:=PChar('\\.\'+Ldrive+':');
       Ldrive9x:=Ord(Ldrive) -Ord('a')+1;
     end;
   end;  //end of case
   osVerInfo.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
   if(GetVersionEx(osVerInfo))then
      case(osVerInfo.dwPlatformId)of

      //在Windows NT/2000下对磁盘读写
        VER_PLATFORM_WIN32_NT:{Windows NT/2000}
        begin
         hDeviceHandle:=CreateFile(Ldrive2000,GENERIC_ALL,
           FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
         if (hDeviceHandle<>INVALID_HANDLE_VALUE)then
         begin                                    //if (1)
          p:=allocmem(SectorCount*BytesPerSector);
          //p 必须为新申请的内存或全局变量，不能是局部变量，用于临时缓冲
          //如"p:array[0..512-1] of char" 定义为局部变量是不能读写磁盘的。

          //读盘
          FileSeek(hDevicehandle,SecStart*BytesPerSector,0);//起始扇区
          if FileRead(hDevicehandle,p[0],SectorCount*BytesPerSector)<>SectorCount*BytesPerSector then   //读扇区
             raise exception.Create('Read 错误');

          Move(p^,Sec^,SectorCount*512); //参数分别是源地址，目标地址，需移动的数据量
         {
         //写盘
          FileSeek(hDevicehandle,SectorStart*BytesPerSector,0);//起始扇区
          if FileWrite(hDevicehandle,p[0],SectorCount*BytesPerSector)<>SectorCount*BytesPerSector then //写扇区
              raise exception.Create('Write 错误%d');
         }
          freemem(p,SectorCount*BytesPerSector);
          closehandle(hDeviceHandle);
         end;  //end of if (1)
        end;  //end of VER_PLATFORM_WIN32_NT case

        //在WIN9X下对磁盘进行读写
        VER_PLATFORM_WIN32_WINDOWS:{Windows 9x/ME}
        begin
          hDeviceHandle:=CreateFile('\\.\VWIN32',0,0,nil,0,FILE_FLAG_DELETE_ON_CLOSE,0);
          //打开VWIN32，VWIN32在WINDOWS 9X 下提供了INT13、INT21、INT25、INT26的接口
          if(hDeviceHandle<>INVALID_HANDLE_VALUE)then       //if (1)
          begin
            //读盘
            p:=allocmem(SectorCount*BytesPerSector);
            //p 必须为新申请的内存或全局变量，不能是局部变量 ，用于临时缓冲
            //如"p:array[0..512-1] of char" 定义为局部变量是不能读写磁盘的。

            buffer.dwStartSector:=SecStart;   //第SecStart个扇区
            buffer.wSectors:=1;        //共1个扇区
            buffer.lpBuffer:=p;    //缓冲区
            reg.EAX:=$7305;
            reg.EBX:=integer(@buffer);
            reg.ECX:=-1;
            reg.EDX:=Ldrive9X;
            reg.ESI:=0;                 //0表示读
            reg.Flags:=0;

            //执行该磁盘功能
            DeviceIoControl(hDeviceHandle,VWIN32_DIOC_DOS_DRIVEINFO,@reg,