delphi 常用函数

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TFileItem = class(TCollectionItem)
  public
    FileName: WideString;
    FileSize: Int64;
    IsDirectory: Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//------ 取CPU序列号 uses WinSock
function GetCPUID: string;
  procedure SetCPU(Handle: THandle; CPUNO: Integer);
  var
    ProcessAffinity: Cardinal;
    _SystemAffinity: Cardinal;
  begin
    GetProcessAffinityMask(handle, ProcessAffinity, _SystemAffinity);
    ProcessAffinity := CPUNO;
    SetProcessAffinityMask(handle, ProcessAffinity);
  end;

const
  CPUINFO = '%.8x-%.8x-%.8x-%.8x';
var
  iEax: Integer;
  iEbx: Integer;
  iEcx: Integer;
  iEdx: Integer;
begin
  SetCPU(GetCurrentProcess, 1);
  asm
    push ebx
    push ecx
    push edx
    mov   eax, 1
    DW $A20F//cpuid
    mov   iEax, eax
    mov   iEbx, ebx
    mov   iEcx, ecx
    mov   iEdx, edx
    pop edx
    pop ecx
    pop ebx
  end;
  Result := Format(CPUINFO, [iEax, iEbx, iEcx, iEdx]);
end;
//获取网卡
function MacAddress: string;
var
 Lib: Cardinal;
 Func : function(GUID: PGUID): Longint; stdcall;
 GUID1, GUID2: TGUID;
begin
 Result := '';
 Lib := LoadLibrary('rpcrt4.dll');
 if Lib <> 0 then
 begin
   if Win32Platform <>VER_PLATFORM_WIN32_NT then
     @Func := GetProcAddress(Lib, 'UuidCreate')
     else @Func := GetProcAddress(Lib, 'UuidCreateSequential');
   if Assigned(Func) then
   begin
     if (Func(@GUID1) = 0) and
       (Func(@GUID2) = 0) and
       (GUID1.D4[2] = GUID2.D4[2]) and
       (GUID1.D4[3] = GUID2.D4[3]) and
       (GUID1.D4[4] = GUID2.D4[4]) and
       (GUID1.D4[5] = GUID2.D4[5]) and
       (GUID1.D4[6] = GUID2.D4[6]) and
       (GUID1.D4[7] = GUID2.D4[7]) then
     begin
       Result :=
        IntToHex(GUID1.D4[2], 2) + '-' +
        IntToHex(GUID1.D4[3], 2) + '-' +
        IntToHex(GUID1.D4[4], 2) + '-' +
        IntToHex(GUID1.D4[5], 2) + '-' +
        IntToHex(GUID1.D4[6], 2) + '-' +
        IntToHex(GUID1.D4[7], 2);
     end;
   end;
   FreeLibrary(Lib);
 end;
end;

//取硬盘系列号:
function GetIdeSerialNumber: Pansichar; //获取硬盘的出厂系列号；
const IDENTIFY_BUFFER_SIZE = 512;
type
  TIDERegs = packed record
  bFeaturesReg: BYTE;
  bSectorCountReg: BYTE;
  bSectorNumberReg: BYTE;
  bCylLowReg: BYTE;
  bCylHighReg: BYTE;
  bDriveHeadReg: BYTE;
  bCommandReg: BYTE;
  bReserved: BYTE;
  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;
  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;
  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 := '';
  if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then
  begin // Windows NT, Windows 2000
  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;
  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 := PAnsichar(@sSerialNumber);
  end;
end;
//获取目录下的文件
procedure FindAllFiles(APath: WideString; AFiles: TCollection;
  var AFileSize: Int64);
var
  strSearchPath: WideString;
  strSafePath: WideString;
  FindData: WIN32_FIND_DATAW;
  hFind: THandle;
  objItem: TFileItem;
begin
  strSafePath := Trim(APath);
  if strSafePath[Length(strSafePath)] <> '\' then strSafePath := strSafePath + '\';
  strSearchPath := strSafePath + '*.*';

  hFind := FindFirstFileW(PWideChar(strSearchPath), FindData);
  if (INVALID_HANDLE_VALUE = hFind) then Exit;

  while True do
  begin
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
    begin
      if(FindData.cFileName[0] <> '.') then
      begin
        objItem := TFileItem(AFiles.Add());
        objItem.FileName := strSafePath + FindData.cFileName;
        objItem.FileSize := 0;
        objItem.IsDirectory := True;

        FindAllFiles(strSafePath + FindData.cFileName, AFiles, AFileSize);
      end;
    end
    else
    begin
      objItem := TFileItem(AFiles.Add());
      objItem.FileName := strSafePath + FindData.cFileName;
      objItem.FileSize := FindData.nFileSizeLow or FindData.nFileSizeHigh shl SizeOf(FindData.nFileSizeHigh);
      objItem.IsDirectory := False;

      AFileSize := AFileSize + objItem.FileSize;
    end;
    if (not FindNextFileW(hFind, FindData)) then Break;
  end;
  Windows.FindClose(hFind);
end;
 //强制删除目录
function ForceToRemoveDir(ADir: string): Boolean;
var
  pDir: PChar;
  SR: TSearchRec;
  FR: Integer;
begin
  Result := False;
  pDir := PChar(ADir);
  if not DirectoryExists(pDir) then Exit;
  try
    if Copy(pDir, Length(pDir), 1) <> '\' then
      pDir := PChar(pDir + '\');
    FR := FindFirst(pDir + '*.*', FaAnyfile, SR);
    while FR = 0 do
    begin
      if ((SR.Attr and FaDirectory) = FaDirectory) and
        (SR.Name <> '.') and (SR.Name <> '..') then
      begin
        if not ForceToRemoveDir(StrPas(pDir) + SR.Name) then Break;
      end;
      if ((SR.Attr and FaDirectory <> FaDirectory) and
        (SR.Attr and FaVolumeID <> FaVolumeID)) then
      begin
        SysUtils.FileSetAttr(pDir + SR.Name,
          SysUtils.FileGetAttr(pDir + SR.Name) and (not
          SysUtils.faReadOnly)); //取消文件的只读属性
        if not DeleteFile(PChar(pDir + SR.Name)) then
          Break;
      end;
      FR := FindNext(SR);
    end;
    SysUtils.FindClose(SR);
    RemoveDirectory(pDir);
    Result := True;
  except
  end;
end;
//获取windows系统版本
function GetWindowsVersion: string;
var
  AWin32Version: Extended;
  os: string;
begin
  os := 'Windows ';
  AWin32Version := StrtoFloat(format('%d.%d' ,[Win32MajorVersion, Win32MinorVersion]));
  if Win32Platform = VER_PLATFORM_WIN32s then
    Result := os + '32'
  else if Win32Platform=VER_PLATFORM_WIN32_WINDOWS then
  begin
    if AWin32Version=4.0 then
      Result := os + '95'
    else if AWin32Version=4.1 then
      Result := os + '98'
    else if AWin32Version=4.9 then
      Result := os + 'Me'
    else
      Result := os + '9x'
  end
  else if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    if AWin32Version=3.51 then
      Result := os + 'NT 3.51'
    else if AWin32Version=4.0 then
      Result := os + 'NT 4.0'
    else if AWin32Version=5.0 then
      Result := os + '2000'
    else if AWin32Version=5.1 then
      Result := os + 'XP'
    else if AWin32Version=5.2 then
      Result := os + '2003'
    else if AWin32Version=6.0 then
      Result := os + 'Vista'
    else if AWin32Version=6.1 then
      Result := os + '7'
    else
      Result := os ;
  end
  else
    Result := os + '??';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
begin
  showmessage(MacAddress());
  showmessage(GetCPUID());
  showmessage(GetIdeSerialNumber());
  showmessage(GetWindowsVersion());
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  aFiles: TCollection;
  aFileSize: Int64;
begin
  //FindAllFiles('C:\\apache-tomcat-6.0.32',aFiles,aFileSize);
  //showmessage(inttostr(aFileSize));
  ForceToRemoveDir('C:\apache-tomcat-6.0.32');
  showmessage('删除目录成功！');
end;

end.