unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, ShellAPI, md5, Registry,
ExtCtrls;
type
TUSBAccess =
class(TService)
Timer1: TTimer;
procedure ServiceCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
procedure CheckStick;
public
function GetServiceController: TServiceController;
override;
{ Public-Deklarationen }
end;
var
USBAccess: TUSBAccess;
implementation
{$R *.DFM}
function BlockInput (fBlockInput : boolean) : DWord;
stdcall;
external '
user32.DLL'
procedure ServiceController(CtrlCode: DWord);
stdcall;
begin
USBAccess.Controller(CtrlCode);
end;
function TUSBAccess.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
function DriveExists(DriveByte: Byte): Boolean;
begin
Result := GetLogicalDrives
and (1
shl DriveByte) <> 0;
end;
function DriveType(DriveByte: Byte):
String;
begin
case GetDriveType(PChar(Chr(DriveByte + Ord('
A')) + '
:\'))
of
DRIVE_UNKNOWN: Result := '
unbekannt';
DRIVE_NO_ROOT_DIR: Result := '
Laufwerk existiert nicht';
DRIVE_REMOVABLE: Result := '
Wechseldatenträger';
DRIVE_FIXED: Result := '
Festplatte';
DRIVE_REMOTE: Result := '
Netzwerk';
DRIVE_CDROM: Result := '
CD-ROM/DVD';
DRIVE_RAMDISK: Result := '
RAM Disk';
else
Result := '
anderer Laufwerkstyp';
end;
end;
function GetSerialNumber(Drive: PChar): DWord;
var
FileSysName, VolName:
array[0..255]
of Char;
SerialNum, MaxCLength, FileSysFlag: DWORD;
i : integer;
begin
GetVolumeInformation(Drive, VolName, 255, @SerialNum, MaxCLength, FileSysFlag, FileSysName, 255);
Result := SerialNum;
end;
// Wandelt MD5 in String um
function LogEntry(Dig: MD5Digest):
string;
begin
Result := Format('
%s', [MD5Print(Dig)]);
end;
procedure TUSBAccess.CheckStick;
var
I: Integer;
check: Boolean;
res1, drive, md5key, md5key2:
string;
serial: integer;
regist: TRegistry;
begin
check:=False;
regist:=TRegistry.Create;
regist.RootKey:=HKEY_LOCAL_MACHINE;
regist.OpenKey('
Software\....\.....', true);
md5key:=regist.ReadString('
Key');
regist.free;
for I := 0
to 25
do
begin
if DriveExists(I)
then
begin
res1:=Chr(I + Ord('
A')) + '
:\ (' + DriveType(I) + '
)';
drive:=Copy(res1,1,3);
serial:=GetSerialNumber(PChar(drive));
md5key2:=LogEntry(MD5String(IntToStr(serial)));
if (md5key=md5key2)
then
begin
BlockInput(false);
check:=true;
end;
end;
end;
if check=False
then
begin
BlockInput(true);
//LockWorkStation;
end;
end;
procedure TUSBAccess.ServiceCreate(Sender: TObject);
begin
USBAccess.CheckStick;
end;
procedure TUSBAccess.Timer1Timer(Sender: TObject);
begin
USBAccess.CheckStick;
end;
end.