Subversion Repositories userdetect2

Compare Revisions

No changes between revisions

Regard whitespace Rev 82 → Rev 83

/trunk/UserDetect2/Plugins/TestDynamicEcho.dof
0,0 → 1,140
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=1
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=ViaThinkSoft
FileDescription=TestDynamicEcho plugin for UserDetect2
FileVersion=1.0.0.0
InternalName=UD2-TestDynamicEcho
LegalCopyright=(C) 2016 ViaThinkSoft
LegalTrademarks=
OriginalFilename=TestDynamicEcho.dll
ProductName=UserDetect2
ProductVersion=3.0.0.0
Website=www.viathinksoft.de
Project leader=Daniel Marschall - www.daniel-marschall.de
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
/trunk/UserDetect2/Plugins/TestDynamicEcho.dpr
0,0 → 1,93
library TestDynamicEcho;
 
uses
Windows,
SysUtils,
Classes,
UD2_PluginIntf in '..\UD2_PluginIntf.pas',
UD2_PluginUtils in '..\UD2_PluginUtils.pas',
UD2_PluginStatus in '..\UD2_PluginStatus.pas';
 
{$R *.res}
 
const
PLUGIN_GUID: TGUID = '{30653D69-0806-450E-AEF9-19C2D36D298E}';
 
function PluginIdentifier: TGUID; cdecl;
begin
result := PLUGIN_GUID;
end;
 
function IdentificationStringW(lpIdentifier: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;
begin
result := UD2_STATUS_NOTAVAIL_ONLY_ACCEPT_DYNAMIC;
end;
 
function PluginNameW(lpPluginName: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
var
stPluginName: WideString;
primaryLangID: Byte;
begin
primaryLangID := wLangID and $00FF;
if primaryLangID = LANG_GERMAN then
stPluginName := 'Dynamisches Echo (Test plugin)'
else
stPluginName := 'Dynamic echo (Test plugin)';
result := UD2_WritePascalStringToPointerW(lpPluginName, cchSize, stPluginName);
end;
 
function PluginVendorW(lpPluginVendor: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
begin
result := UD2_WritePascalStringToPointerW(lpPluginVendor, cchSize, 'ViaThinkSoft');
end;
 
function PluginVersionW(lpPluginVersion: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
begin
result := UD2_WritePascalStringToPointerW(lpPluginVersion, cchSize, '1.0');
end;
 
function IdentificationMethodNameW(lpIdentificationMethodName: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;
var
stIdentificationMethodName: WideString;
begin
stIdentificationMethodName := 'TestEcho';
result := UD2_WritePascalStringToPointerW(lpIdentificationMethodName, cchSize, stIdentificationMethodName);
end;
 
function CheckLicense(lpReserved: LPVOID): UD2_STATUS; cdecl;
begin
result := UD2_STATUS_OK_LICENSED;
end;
 
function DescribeOwnStatusCodeW(lpErrorDescription: LPWSTR; cchSize: DWORD; statusCode: UD2_STATUS; wLangID: LANGID): BOOL; cdecl;
begin
// This function does not use non-generic status codes
result := FALSE;
end;
 
function DynamicIdentificationStringW(lpIdentifier: LPWSTR; cchSize: DWORD; lpDynamicData: LPWSTR): UD2_STATUS; cdecl;
var
stIdentifier: WideString;
begin
try
stIdentifier := lpDynamicData; // "echo"
result := UD2_WritePascalStringToPointerW(lpIdentifier, cchSize, stIdentifier);
except
on E: Exception do result := UD2_STATUS_HandleException(E);
end;
end;
 
 
exports
PluginInterfaceID name mnPluginInterfaceID,
PluginIdentifier name mnPluginIdentifier,
PluginNameW name mnPluginNameW,
PluginVendorW name mnPluginVendorW,
PluginVersionW name mnPluginVersionW,
IdentificationMethodNameW name mnIdentificationMethodNameW,
IdentificationStringW name mnIdentificationStringW,
CheckLicense name mnCheckLicense,
DescribeOwnStatusCodeW name mnDescribeOwnStatusCodeW,
DynamicIdentificationStringW name mnDynamicIdentificationStringW;
 
end.
/trunk/UserDetect2/Plugins/TestDynamicEcho.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/UserDetect2/UD2_Main.dfm
3,7 → 3,7
Top = 177
Width = 784
Height = 440
ActiveControl = TasksListView
ActiveControl = Memo1
Caption = 'ViaThinkSoft UserDetect2'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
22,7 → 22,7
Top = 0
Width = 768
Height = 402
ActivePage = TasksTabSheet
ActivePage = TabSheet5
Align = alClient
TabOrder = 0
object TasksTabSheet: TTabSheet
49,6 → 49,9
object TabSheet2: TTabSheet
Caption = 'Identifications'
ImageIndex = 1
DesignSize = (
760
374)
object IdentificationsListView: TVTSListView
Left = 0
Top = 0
61,6 → 64,9
Width = 100
end
item
Caption = 'Dyn'
end
item
Caption = 'Method name'
Width = 100
end
78,7 → 84,17
ViewStyle = vsReport
OnCompare = ListViewCompare
end
object Button5: TButton
Left = 616
Top = 320
Width = 129
Height = 41
Anchors = [akRight, akBottom]
Caption = 'Test dynamic'
TabOrder = 1
OnClick = Button5Click
end
end
object TabSheet3: TTabSheet
Caption = 'Task Definition File Template'
ImageIndex = 2
603,7 → 619,7
Top = 64
Width = 15
Height = 13
Caption = '2.1'
Caption = '2.2'
end
object Memo1: TMemo
Left = 264
/trunk/UserDetect2/UD2_Main.pas
62,6 → 62,7
MenuItem1: TMenuItem;
Panel2: TPanel;
Image2: TImage;
Button5: TButton;
procedure FormDestroy(Sender: TObject);
procedure TasksListViewDblClick(Sender: TObject);
procedure TasksListViewKeyPress(Sender: TObject; var Key: Char);
78,6 → 79,7
procedure LoadedPluginsPopupMenuPopup(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button5Click(Sender: TObject);
protected
ud2: TUD2;
procedure LoadTaskList;
280,6 → 282,10
with IdentificationsListView.Items.Add do
begin
Caption := pl.PluginName;
if ude.DynamicDataUsed then
SubItems.Add(ude.DynamicData)
else
SubItems.Add('');
SubItems.Add(pl.IdentificationMethodName);
SubItems.Add(ude.IdentificationString);
SubItems.Add(GUIDToString(pl.PluginGUID));
298,6 → 304,7
i, j: integer;
pl: TUD2Plugin;
ude: TUD2IdentificationEntry;
idNames: TStringList;
begin
IniTemplateMemo.Clear;
IniTemplateMemo.Lines.Add('[ExampleTask1]');
317,10 → 324,19
begin
ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
IniTemplateMemo.Lines.Add(Format('; %s', [ude.Plugin.PluginName]));
IniTemplateMemo.Lines.Add(ude.GetPrimaryIdName+'=calc.exe');
 
idNames := TStringList.Create;
try
ude.GetIdNames(idNames);
if idNames.Count >= 1 then
IniTemplateMemo.Lines.Add(idNames.Strings[0]+'=calc.exe');
finally
idNames.Free;
end;
 
end;
end;
end;
 
procedure TUD2MainForm.LoadLoadedPluginList;
resourcestring
551,4 → 567,25
PageControl1.ActivePage := TasksTabSheet;
end;
 
procedure TUD2MainForm.Button5Click(Sender: TObject);
var
idTerm: string;
slCmd: TStrings;
begin
if InputQuery('Enter example term', 'Example: abc|||Testecho:abc=calc.exe', idTerm) then
begin
slCmd := TStringList.Create;
try
ud2.CheckTerm(idTerm, slCmd);
if slCmd.Count = 0 then
ShowMessage('No commands would be executed.')
else
showmessage('Following commands would be executed:' + #13#10#13#10 + slCmd.Text);
finally
slCmd.Free;
end;
end;
LoadDetectedIDs;
end;
 
end.
/trunk/UserDetect2/UD2_Obj.pas
10,12 → 10,16
 
uses
Windows, SysUtils, Classes, IniFiles, Contnrs, Dialogs, UD2_PluginIntf,
UD2_PluginStatus;
UD2_PluginStatus, UD2_Utils;
 
const
cchBufferSize = 32768;
 
dynamicDataDelim = '|||';
 
type
TUD2IdentificationEntry = class;
 
TUD2Plugin = class(TObject)
protected
FDetectedIdentifications: TObjectList{<TUD2IdentificationEntry>};
36,11 → 40,15
Time: Cardinal;
function PluginGUIDString: string;
property DetectedIdentifications: TObjectList{<TUD2IdentificationEntry>}
read FDetectedIdentifications;
property DetectedIdentifications: TObjectList{<TUD2IdentificationEntry>} read FDetectedIdentifications;
destructor Destroy; override;
constructor Create;
procedure AddIdentification(IdStr: WideString);
function AddIdentification(IdStr: WideString): TUD2IdentificationEntry;
 
function InvokeDynamicCheck(dynamicData: string): boolean;
function GetDynamicRequestResult(dynamicData: string): TArrayOfString;
 
function EqualsMethodNameOrGuid(idMethodNameOrGUID: string): boolean;
end;
 
TUD2IdentificationEntry = class(TObject)
47,10 → 55,13
private
FIdentificationString: WideString;
FPlugin: TUD2Plugin;
FDynamicDataUsed: boolean;
FDynamicData: string;
public
property DynamicDataUsed: boolean read FDynamicDataUsed write FDynamicDataUsed;
property DynamicData: string read FDynamicData write FDynamicData;
property IdentificationString: WideString read FIdentificationString;
property Plugin: TUD2Plugin read FPlugin;
function GetPrimaryIdName: WideString;
procedure GetIdNames(sl: TStrings);
constructor Create(AIdentificationString: WideString; APlugin: TUD2Plugin);
end;
72,6 → 83,8
property IniFile: TMemIniFile read FIniFile;
procedure GetAllIdNames(outSL: TStrings);
function FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
procedure CheckTerm(idTermAndCmd: string; commandSLout: TStrings; slIdNames: TStrings=nil);
function FindPluginByMethodNameOrGuid(idMethodName: string): TUD2Plugin;
procedure GetCommandList(ShortTaskName: string; outSL: TStrings);
procedure HandlePluginDir(APluginDir, AFileMask: string);
procedure GetTaskListing(outSL: TStrings);
87,7 → 100,7
implementation
 
uses
UD2_Utils;
Math;
 
type
TUD2PluginLoader = class(TThread)
94,12 → 107,15
protected
dllFile: string;
lngID: LANGID;
useDynamicData: boolean;
dynamicData: WideString;
procedure Execute; override;
function HandleDLL: boolean;
public
pl: TUD2Plugin;
pl: TUD2Plugin; // TODO: why do we need it?! can it be leaked if we use it for dynamic requests?
Errors: TStringList;
constructor Create(Suspended: boolean; DLL: string; alngid: LANGID);
ResultIdentifiers: TArrayOfString;
constructor Create(Suspended: boolean; DLL: string; alngid: LANGID; useDynamicData: boolean; dynamicData: WideString);
destructor Destroy; override;
end;
 
115,6 → 131,7
LNG_STATUS_NOTAVAIL_HW_NOT_SUPPORTED = 'Not available (Hardware not supported)';
LNG_STATUS_NOTAVAIL_NO_ENTITIES = 'Not available (No entities to identify)';
LNG_STATUS_NOTAVAIL_WINAPI_CALL_FAILURE = 'Not available (A Windows API call failed. Message: %s)';
LNG_STATUS_NOTAVAIL_ONLY_ACCEPT_DYNAMIC = 'Not available (Arguments required)';
LNG_UNKNOWN_NOTAVAIL = 'Not available (Unknown status code %s)';
 
LNG_STATUS_FAILURE_UNSPECIFIED = 'Error (Unspecified)';
136,6 → 153,7
else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_HW_NOT_SUPPORTED, false) then result := LNG_STATUS_NOTAVAIL_HW_NOT_SUPPORTED
else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_NO_ENTITIES, false) then result := LNG_STATUS_NOTAVAIL_NO_ENTITIES
else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_WINAPI_CALL_FAILURE, false) then result := Format(LNG_STATUS_NOTAVAIL_WINAPI_CALL_FAILURE, [FormatOSError(grStatus.dwExtraInfo)])
else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_ONLY_ACCEPT_DYNAMIC, false) then result := LNG_STATUS_NOTAVAIL_ONLY_ACCEPT_DYNAMIC
 
else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_UNSPECIFIED, false) then result := LNG_STATUS_FAILURE_UNSPECIFIED
else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_BUFFER_TOO_SMALL, false) then result := LNG_STATUS_FAILURE_BUFFER_TOO_SMALL
157,9 → 175,10
result := UpperCase(GUIDToString(PluginGUID));
end;
 
procedure TUD2Plugin.AddIdentification(IdStr: WideString);
function TUD2Plugin.AddIdentification(IdStr: WideString): TUD2IdentificationEntry;
begin
DetectedIdentifications.Add(TUD2IdentificationEntry.Create(IdStr, Self))
result := TUD2IdentificationEntry.Create(IdStr, Self);
DetectedIdentifications.Add(result);
end;
 
destructor TUD2Plugin.Destroy;
174,19 → 193,77
FDetectedIdentifications := TObjectList{<TUD2IdentificationEntry>}.Create(true);
end;
 
{ TUD2IdentificationEntry }
function TUD2Plugin.InvokeDynamicCheck(dynamicData: string): boolean;
var
ude: TUD2IdentificationEntry;
i: integer;
ids: TArrayOfString;
id: string;
begin
result := false;
 
function TUD2IdentificationEntry.GetPrimaryIdName: WideString;
for i := 0 to FDetectedIdentifications.Count-1 do
begin
result := Plugin.IdentificationMethodName+':'+IdentificationString;
ude := FDetectedIdentifications.Items[i] as TUD2IdentificationEntry;
if ude.dynamicDataUsed and (ude.dynamicData = dynamicData) then
begin
// The dynamic content was already evaluated (and therefore is already added in FDetectedIdentifications).
Exit;
end;
end;
 
SetLength(ids, 0);
ids := GetDynamicRequestResult(dynamicData);
 
for i := 0 to Length(ids)-1 do
begin
id := ids[i];
 
ude := AddIdentification(id);
ude.dynamicDataUsed := true;
ude.dynamicData := dynamicData;
 
result := true;
end;
end;
 
function TUD2Plugin.GetDynamicRequestResult(dynamicData: string): TArrayOfString;
var
lngID: LANGID;
pll: TUD2PluginLoader;
begin
lngID := GetSystemDefaultLangID;
 
pll := TUD2PluginLoader.Create(false, PluginDLL, lngid, true, dynamicData);
try
pll.WaitFor;
result := pll.ResultIdentifiers;
finally
pll.Free;
end;
end;
 
function TUD2Plugin.EqualsMethodNameOrGuid(idMethodNameOrGUID: string): boolean;
begin
result := SameText(IdentificationMethodName, idMethodNameOrGUID) or
SameText(GUIDToString(PluginGUID), idMethodNameOrGUID)
end;
 
{ TUD2IdentificationEntry }
 
procedure TUD2IdentificationEntry.GetIdNames(sl: TStrings);
begin
sl.Add(GetPrimaryIdName);
if DynamicDataUsed then
begin
sl.Add(DynamicData+dynamicDataDelim+Plugin.IdentificationMethodName+':'+IdentificationString);
sl.Add(DynamicData+DynamicDataDelim+Plugin.PluginGUIDString+':'+IdentificationString);
end
else
begin
sl.Add(Plugin.IdentificationMethodName+':'+IdentificationString);
sl.Add(Plugin.PluginGUIDString+':'+IdentificationString);
end;
end;
 
constructor TUD2IdentificationEntry.Create(AIdentificationString: WideString;
APlugin: TUD2Plugin);
226,7 → 303,7
try
repeat
try
tob.Add(TUD2PluginLoader.Create(false, path + sr.Name, lngid));
tob.Add(TUD2PluginLoader.Create(false, path + sr.Name, lngid, false, ''));
except
on E: Exception do
begin
339,13 → 416,14
 
(*
 
NAMING EXAMPLE: ComputerName:ABC&&User:John=calc.exe
NAMING EXAMPLE: dynXYZ|||ComputerName:ABC&&User:John=calc.exe
 
idTerm: ComputerName:ABC&&User:John
idTerm: dynXYZ|||ComputerName:ABC&&User:John
idName: ComputerName:ABC
IdMethodName: ComputerName
IdStr ABC
cmd: calc.exe
dynamicData: dynXYZ
 
*)
 
370,11 → 448,14
const
CASE_SENSITIVE_FLAG = '$CASESENSITIVE$';
var
x: TArrayOfString;
x, y, z: TArrayOfString;
i: integer;
p: TUD2Plugin;
idName: WideString;
cleanUpStringList: boolean;
caseSensitive: boolean;
dynamicData: string;
idMethodName: string;
begin
cleanUpStringList := slIdNames = nil;
try
387,6 → 468,7
SetLength(x, 0);
if Pos(':', idTerm) = 0 then
begin
// Exclude stuff like "Description"
result := false;
Exit;
end;
396,6 → 478,33
begin
idName := x[i];
 
/// --- Start Dynamic Extension
 
SetLength(y, 0);
y := SplitString(dynamicDataDelim, idName);
 
if Length(y) >= 2 then
begin
dynamicData := y[0];
 
SetLength(z, 0);
z := SplitString(':', y[1]);
idMethodName := z[0];
 
p := FindPluginByMethodNameOrGuid(idMethodName);
if Assigned(p) then
begin
if p.InvokeDynamicCheck(dynamicData) then
begin
// Reload the identifications
slIdNames.Clear;
GetAllIdNames(slIdNames);
end;
end;
end;
 
/// --- End Dynamic Extension
 
if Pos(CASE_SENSITIVE_FLAG, idName) >= 1 then
begin
idName := StringReplace(idName, CASE_SENSITIVE_FLAG, '', [rfReplaceAll]);
419,16 → 528,29
end;
end;
 
function TUD2.FindPluginByMethodNameOrGuid(idMethodName: string): TUD2Plugin;
var
i: integer;
p: TUD2Plugin;
begin
result := nil;
for i := 0 to LoadedPlugins.Count-1 do
begin
p := LoadedPlugins.Items[i] as TUD2Plugin;
 
if p.EqualsMethodNameOrGuid(idMethodName) then
begin
result := p;
Exit;
end;
end;
end;
 
procedure TUD2.GetCommandList(ShortTaskName: string; outSL: TStrings);
var
i: integer;
cmd: string;
idTerm: WideString;
slSV, slIdNames: TStrings;
nameVal: TArrayOfString;
begin
SetLength(nameVal, 0);
 
slIdNames := TStringList.Create;
try
GetAllIdNames(slIdNames);
438,22 → 560,47
FIniFile.ReadSectionValues(ShortTaskName, slSV);
for i := 0 to slSV.Count-1 do
begin
CheckTerm(slSV.Strings[i], outSL, slIdNames);
end;
finally
slSV.Free;
end;
finally
slIdNames.Free;
end;
end;
 
procedure TUD2.CheckTerm(idTermAndCmd: string; commandSLout: TStrings; slIdNames: TStrings=nil);
var
nameVal: TArrayOfString;
idTerm, cmd: string;
slIdNamesCreated: boolean;
begin
slIdNamesCreated := false;
try
if not Assigned(slIdNames) then
begin
slIdNamesCreated := true;
slIdNames := TStringList.Create;
GetAllIdNames(slIdNames);
end;
 
SetLength(nameVal, 0);
 
// We are doing the interpretation of the line ourselves, because
// TStringList.Values[] would not allow multiple command lines with the
// same key (idTerm)
nameVal := SplitString('=', slSV.Strings[i]);
// TODO xxx: big problem when we want to check environment variables, since our idTerm would contain '=' !
nameVal := SplitString('=', idTermAndCmd);
if Length(nameVal) < 2 then exit;
idTerm := nameVal[0];
cmd := nameVal[1];
 
if FulfilsEverySubterm(idTerm, slIdNames) then outSL.Add(cmd);
end;
if FulfilsEverySubterm(idTerm, slIdNames) then commandSLout.Add(cmd);
finally
slSV.Free;
if slIdNamesCreated then slIdNames.Free;
end;
finally
slIdNames.Free;
end;
end;
 
{ TUD2PluginLoader }
 
464,7 → 611,7
HandleDLL;
end;
 
constructor TUD2PluginLoader.Create(Suspended: boolean; DLL: string; alngid: LANGID);
constructor TUD2PluginLoader.Create(Suspended: boolean; DLL: string; alngid: LANGID; useDynamicData: boolean; dynamicData: WideString);
begin
inherited Create(Suspended);
dllfile := dll;
471,6 → 618,8
pl := nil;
Errors := TStringList.Create;
lngid := alngid;
self.useDynamicData := useDynamicData;
Self.dynamicData := dynamicData;
end;
 
destructor TUD2PluginLoader.Destroy;
482,7 → 631,6
function TUD2PluginLoader.HandleDLL: boolean;
var
sIdentifier: WideString;
sIdentifiers: TArrayOfString;
buf: array[0..cchBufferSize-1] of WideChar;
pluginInterfaceID: TGUID;
dllHandle: Cardinal;
493,6 → 641,7
fPluginVersionW: TFuncPluginVersionW;
fIdentificationMethodNameW: TFuncIdentificationMethodNameW;
fIdentificationStringW: TFuncIdentificationStringW;
fDynamicIdentificationStringW: TFuncDynamicIdentificationStringW;
fCheckLicense: TFuncCheckLicense;
fDescribeOwnStatusCodeW: TFuncDescribeOwnStatusCodeW;
statusCode: UD2_STATUS;
504,6 → 653,7
function _ErrorLookup(statusCode: UD2_STATUS): WideString;
var
ret: BOOL;
buf: array[0..cchBufferSize-1] of WideChar;
begin
if Assigned(fDescribeOwnStatusCodeW) then
begin
620,6 → 770,22
Exit;
end;
 
fDynamicIdentificationStringW := nil;
fIdentificationStringW := nil;
if useDynamicData then
begin
@fDynamicIdentificationStringW := GetProcAddress(dllHandle, mnDynamicIdentificationStringW);
if not Assigned(fDynamicIdentificationStringW) then
begin
// TODO xxx: Darf hier ein fataler Fehler entstehen, obwohl dieses Szenario nur durch die INI file auftreten kann?
// TODO (allgemein): In der Modulübersicht soll auch gezeigt werden, ob dieses Modul dynamischen Content erlaubt.
// TODO (allgemein): doku
Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnDynamicIdentificationStringW, dllFile]));
Exit;
end;
end
else
begin
@fIdentificationStringW := GetProcAddress(dllHandle, mnIdentificationStringW);
if not Assigned(fIdentificationStringW) then
begin
626,6 → 792,7
Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationStringW, dllFile]));
Exit;
end;
end;
 
@fPluginNameW := GetProcAddress(dllHandle, mnPluginNameW);
if not Assigned(fPluginNameW) then
732,7 → 899,14
 
ZeroMemory(@buf, cchBufferSize);
statusCode := UD2_STATUS_FAILURE_NO_RETURNED_VALUE; // This status will be used when the DLL does not return anything (which is an error by the developer)
if useDynamicData then
begin
statusCode := fDynamicIdentificationStringW(@buf, cchBufferSize, PWideChar(dynamicData));
end
else
begin
statusCode := fIdentificationStringW(@buf, cchBufferSize);
end;
pl.IdentificationProcedureStatusCode := statusCode;
pl.IdentificationProcedureStatusCodeDescribed := _ErrorLookup(statusCode);
if statusCode.wCategory = UD2_STATUSCAT_SUCCESS then
741,16 → 915,19
if UD2_STATUS_Equal(statusCode, UD2_STATUS_OK_MULTILINE, false) then
begin
// Multiple identifiers (e.g. multiple MAC addresses are delimited via UD2_MULTIPLE_ITEMS_DELIMITER)
SetLength(sIdentifiers, 0);
sIdentifiers := SplitString(UD2_MULTIPLE_ITEMS_DELIMITER, sIdentifier);
for i := Low(sIdentifiers) to High(sIdentifiers) do
SetLength(ResultIdentifiers, 0);
ResultIdentifiers := SplitString(UD2_MULTIPLE_ITEMS_DELIMITER, sIdentifier);
for i := Low(ResultIdentifiers) to High(ResultIdentifiers) do
begin
pl.AddIdentification(sIdentifiers[i]);
pl.AddIdentification(ResultIdentifiers[i]);
end;
end
else
begin
pl.AddIdentification(sIdentifier);
 
SetLength(ResultIdentifiers, 1);
ResultIdentifiers[0] := sIdentifier;
end;
end
else if statusCode.wCategory <> UD2_STATUSCAT_NOT_AVAIL then
/trunk/UserDetect2/UD2_PluginIntf.pas
22,6 → 22,7
mnIdentificationMethodNameW = 'IdentificationMethodNameW';
mnIdentificationStringW = 'IdentificationStringW';
mnDescribeOwnStatusCodeW = 'DescribeOwnStatusCodeW';
mnDynamicIdentificationStringW = 'DynamicIdentificationStringW';
 
{$IF not Declared(LPVOID)}
type
39,6 → 40,12
TFuncIdentificationStringW = function(lpIdentifier: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;
TFuncDescribeOwnStatusCodeW = function(lpErrorDescription: LPWSTR; cchSize: DWORD; statusCode: UD2_STATUS; wLangID: LANGID): BOOL; cdecl;
 
// Extension of the plugin API starting with version 3.
// We don't assign a new PluginIdentifier GUID since the methods of the old API
// are still valid, so an UserDetect2 2.x plugin can be still used with UserDetect2 3.x.
// Therefore, this function *MUST* be optional and therefore it may only be imported dynamically.
TFuncDynamicIdentificationStringW = function(lpIdentifier: LPWSTR; cchSize: DWORD; lpDynamicData: LPWSTR): UD2_STATUS; cdecl;
 
const
UD2_MULTIPLE_ITEMS_DELIMITER = #10;
 
/trunk/UserDetect2/UD2_PluginStatus.pas
108,6 → 108,14
dwMessage: 4;
dwExtraInfo: 0
);
UD2_STATUS_NOTAVAIL_ONLY_ACCEPT_DYNAMIC: UD2_STATUS = (
cbSize: SizeOf(UD2_STATUS);
bReserved: 0;
wCategory: UD2_STATUSCAT_NOT_AVAIL;
grAuthority: UD2_STATUSAUTH_GENERIC_;
dwMessage: 5;
dwExtraInfo: 0
);
 
(* Failure codes *)
 
/trunk/vcl/PatchU.pas
1,8 → 1,5
unit PatchU;
 
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_TYPE OFF}
 
interface
 
type
/trunk/vcl/VTSCompat.pas
4,10 → 4,6
{$LEGACYIFEND ON}
{$IFEND}
 
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
 
interface
 
uses
/trunk/vcl/VTSListView.pas
1,8 → 1,5
unit VTSListView;
 
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_TYPE OFF}
 
interface
 
// This ListView adds support for sorting arrows