取CPU序列号，获取网卡，取硬盘系列号，获取目录下的文件，强制删除目录

[delphi] view plain copy







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.
http://blog.csdn.net/earbao/article/details/19629579