Subversion Repositories userdetect2

Compare Revisions

No changes between revisions

Regard whitespace Rev 94 → Rev 95

/trunk/UserDetect2/Plugins/DriveSerial.dll
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/trunk/UserDetect2/Plugins/DriveSerial.dpr
89,7 → 89,7
 
CoInitialize(nil);
try
stIdentifier := GetDiskSerial(driveletter); // driveletter must be upper case
stIdentifier := GetDriveSerial(driveletter); // driveletter must be upper case
finally
CoUninitialize;
end;
/trunk/UserDetect2/Plugins/Utils/hddinfo.pas
4,19 → 4,82
 
interface
 
function GetDiskSerial(const Drive:AnsiChar):string;
function GetDriveSerial(const Drive: AnsiChar):string;
 
implementation
 
uses
SysUtils,
StrUtils,
ActiveX,
ComObj,
Variants;
 
function GetDiskSerial(const Drive:AnsiChar):string;
// http://stackoverflow.com/questions/4292395/how-to-get-manufacturer-serial-number-of-an-usb-flash-drive
// Modified
 
function VarArrayToStr(const vArray: variant): string;
 
function _VarToStr(const V: variant): string;
var
FSWbemLocator : OLEVariant;
Vt: integer;
begin
Vt := VarType(V);
case Vt of
varSmallint,
varInteger : Result := IntToStr(integer(V));
varSingle,
varDouble,
varCurrency : Result := FloatToStr(Double(V));
varDate : Result := VarToStr(V);
varOleStr : Result := WideString(V);
varBoolean : Result := VarToStr(V);
varVariant : Result := VarToStr(Variant(V));
varByte : Result := char(byte(V));
varString : Result := String(V);
varArray : Result := VarArrayToStr(Variant(V));
end;
end;
 
var
i : integer;
begin
Result := '[';
if (VarType(vArray) and VarArray)=0 then
Result := _VarToStr(vArray)
else
for i := VarArrayLowBound(vArray, 1) to VarArrayHighBound(vArray, 1) do
if i=VarArrayLowBound(vArray, 1) then
Result := Result+_VarToStr(vArray[i])
else
Result := Result+'|'+_VarToStr(vArray[i]);
 
Result:=Result+']';
end;
 
function VarStrNull(const V:OleVariant):string; //avoid problems with null strings
begin
Result := '';
if not VarIsNull(V) then
begin
Result := VarToStr(V);
end;
end;
 
function GetWMIObject(const objectName: String): IDispatch; //create the Wmi instance
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
 
function GetDriveSerial(const Drive:AnsiChar):string;
var
FSWbemLocator : OleVariant;
objWMIService : OLEVariant;
colDiskDrives : OLEVariant;
colLogicalDisks: OLEVariant;
32,23 → 95,33
begin;
Result:='';
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
objWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', ''); //Connect to the WMI
objWMIService := FSWbemLocator.ConnectServer('.', 'root\CIMV2', '', '');
colDiskDrives := objWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive','WQL',0);
oEnumDiskDrive:= IUnknown(colDiskDrives._NewEnum) as IEnumVariant;
while oEnumDiskDrive.Next(1, objDiskDrive, iValue) = 0 do
begin
DeviceID := StringReplace(objDiskDrive.DeviceID,'\','\\',[rfReplaceAll]); //Escape the `\` chars in the DeviceID value because the '\' is a reserved character in WMI.
DeviceID := StringReplace(VarStrNull(objDiskDrive.DeviceID),'\','\\',[rfReplaceAll]); //Escape the `\` chars in the DeviceID value because the '\' is a reserved character in WMI.
colPartitions := objWMIService.ExecQuery(Format('ASSOCIATORS OF {Win32_DiskDrive.DeviceID="%s"} WHERE AssocClass = Win32_DiskDriveToDiskPartition',[DeviceID]));//link the Win32_DiskDrive class with the Win32_DiskDriveToDiskPartition class
oEnumPartition := IUnknown(colPartitions._NewEnum) as IEnumVariant;
while oEnumPartition.Next(1, objPartition, iValue) = 0 do
begin
colLogicalDisks := objWMIService.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID="'+objPartition.DeviceID+'"} WHERE AssocClass = Win32_LogicalDiskToPartition'); //link the Win32_DiskPartition class with theWin32_LogicalDiskToPartition class.
colLogicalDisks := objWMIService.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID="'+VarStrNull(objPartition.DeviceID)+'"} WHERE AssocClass = Win32_LogicalDiskToPartition'); //link the Win32_DiskPartition class with theWin32_LogicalDiskToPartition class.
oEnumLogical := IUnknown(colLogicalDisks._NewEnum) as IEnumVariant;
while oEnumLogical.Next(1, objLogicalDisk, iValue) = 0 do
begin
if objLogicalDisk.DeviceID=(Drive+':') then //compare the device id
if SameText(VarStrNull(objLogicalDisk.DeviceID),Drive+':') then //compare the device id
begin
Result:=objDiskDrive.SerialNumber;
if Result <> '' then exit;
 
// Some drivers of the USB disks does not expose the manufacturer serial number on the Win32_DiskDrive.SerialNumber property, so on this cases we can extract the serial number from the PnPDeviceID property.
Result:=VarStrNull(objDiskDrive.PnPDeviceID);
if AnsiStartsText('USBSTOR', Result) then
begin
iValue:=LastDelimiter('\', Result);
Result:=Copy(Result, iValue+1, Length(Result));
end;
objLogicalDisk:=Unassigned;
Exit;
end;
objLogicalDisk:=Unassigned;
55,7 → 128,12
end;
objPartition:=Unassigned;
end;
objDiskDrive:=Unassigned;
end;
end;
 
initialization
CoInitialize(nil);
finalization
CoUninitialize;
end.
/trunk/UserDetect2/UD2_Main.dfm
1,7 → 1,7
object UD2MainForm: TUD2MainForm
Left = 202
Top = 139
ActiveControl = TasksListView
ActiveControl = Memo1
Caption = 'ViaThinkSoft UserDetect2'
ClientHeight = 481
ClientWidth = 881
22,7 → 22,7
Top = 0
Width = 881
Height = 481
ActivePage = TasksTabSheet
ActivePage = TabSheet5
Align = alClient
TabOrder = 0
object TasksTabSheet: TTabSheet
664,9 → 664,9
object VersionLabel: TLabel
Left = 104
Top = 64
Width = 15
Width = 24
Height = 13
Caption = '2.3'
Caption = '2.3.1'
end
object Memo1: TMemo
Left = 264
2228,7 → 2228,7
Left = 560
Top = 32
Bitmap = {
494C010101000400100020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
494C0101010004001C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000800000002000000001002000000000000040
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
/trunk/UserDetect2/UD2_Main.pas
611,6 → 611,8
begin
// To avoid accidental change of the default tab from the IDE VCL Designer
PageControl1.ActivePage := TasksTabSheet;
 
VersionLabel.Caption := GetFileVersion(ParamStr(0));
end;
 
procedure TUD2MainForm.DynamicTestButtonClick(Sender: TObject);
620,7 → 622,7
newStuff: boolean;
errors: TStrings;
resourcestring
LNG_DETECTED_DYNAMICS = 'The plugin returns following identification strings:';
LNG_DETECTED_DYNAMICS = 'The plugin returned following identification strings:';
LNG_NOTHING_DETECTED = 'The plugin did not send any identification strings.';
LNG_STATUS_RETURNED = 'The plugin sent following status in reply to your request:';
LNG_ERROR_RETURNED = 'The dynamic plugin could not load. The plugin sent following error messages:';
/trunk/UserDetect2/UD2_Utils.pas
42,6 → 42,7
function IndexOf_CS(aStrings: TStrings; aToken: string): Integer;
function UD2_GetThreadErrorMode: DWORD;
function UD2_SetThreadErrorMode(dwNewMode: DWORD; lpOldMode: LPDWORD): BOOL;
function GetFileVersion(const FileName: string=''): string;
 
implementation
 
424,4 → 425,52
end;
end;
 
function GetFileVersion(const FileName: string=''): string;
var
lpVerInfo: pointer;
rVerValue: PVSFixedFileInfo;
dwInfoSize: cardinal;
dwValueSize: cardinal;
dwDummy: cardinal;
lpstrPath: pchar;
a, b, c, d: word;
resourcestring
LNG_NO_VERSION = 'No version specification';
begin
if Trim(FileName) = EmptyStr then
lpstrPath := pchar(ParamStr(0))
else
lpstrPath := pchar(FileName);
 
dwInfoSize := GetFileVersionInfoSize(lpstrPath, dwDummy);
 
if dwInfoSize = 0 then
begin
Result := LNG_NO_VERSION;
Exit;
end;
 
GetMem(lpVerInfo, dwInfoSize);
try
GetFileVersionInfo(lpstrPath, 0, dwInfoSize, lpVerInfo);
VerQueryValue(lpVerInfo, '', pointer(rVerValue), dwValueSize);
 
with rVerValue^ do
begin
a := dwFileVersionMS shr 16;
b := dwFileVersionMS and $FFFF;
c := dwFileVersionLS shr 16;
d := dwFileVersionLS and $FFFF;
 
Result := IntToStr(a);
if (b <> 0) or (c <> 0) or (d <> 0) then Result := Result + '.' + IntToStr(b);
if (c <> 0) or (d <> 0) then Result := Result + '.' + IntToStr(c);
if (d <> 0) then Result := Result + '.' + IntToStr(d);
end;
finally
FreeMem(lpVerInfo, dwInfoSize);
end;
 
end;
 
end.
/trunk/UserDetect2/UserDetect2.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream