Subversion Repositories userdetect2

unit UD2_Obj;

interface

{$IF CompilerVersion >= 25.0}

{$LEGACYIFEND ON}

{$IFEND}

uses

  Windows, SysUtils, Classes, IniFiles, Contnrs, Dialogs;

const

  cchBufferSize = 2048;

type

  TUD2Plugin = class(TObject)

  protected

    FDetectedIdentifications: TObjectList{<TUD2IdentificationEntry>};

  public

    PluginDLL: string;

    PluginGUID: TGUID;

    PluginName: WideString;

    PluginVendor: WideString;

    PluginVersion: WideString;

    IdentificationMethodName: WideString;

    function PluginGUIDString: string;

    property DetectedIdentifications: TObjectList{<TUD2IdentificationEntry>}

      read FDetectedIdentifications;

    destructor Destroy; override;

    constructor Create;

    procedure AddIdentification(IdStr: WideString);

  end;

  TUD2IdentificationEntry = class(TObject)

  private

    FIdentificationString: WideString;

    FPlugin: TUD2Plugin;

  public

    property IdentificationString: WideString read FIdentificationString;

    property Plugin: TUD2Plugin read FPlugin;

    function GetPrimaryIdName: WideString;

    procedure GetIdNames(sl: TStrings);

    constructor Create(AIdentificationString: WideString; APlugin: TUD2Plugin);

  end;

  TUD2 = class(TObject)

  private

    FGUIDLookup: TStrings;

  protected

    FLoadedPlugins: TObjectList{<TUD2Plugin>};

    FIniFile: TMemIniFile;

    FErrors: TStrings;

    FIniFileName: string;

    procedure HandleDLL(dllFile: string);

  public

    property IniFileName: string read FIniFileName;

    property Errors: TStrings read FErrors;

    property LoadedPlugins: TObjectList{<TUD2Plugin>} read FLoadedPlugins;

    property IniFile: TMemIniFile read FIniFile;

    procedure GetCommandList(ShortTaskName: string; outSL: TStrings);

    procedure HandlePluginDir(APluginDir: string);

    procedure GetTaskListing(outSL: TStrings);

    constructor Create(AIniFileName: string);

    destructor Destroy; override;

    function TaskExists(ShortTaskName: string): boolean;

    function ReadMetatagString(ShortTaskName, MetatagName: string;

      DefaultVal: string): string;

    function ReadMetatagBool(ShortTaskName, MetatagName: string;

      DefaultVal: string): boolean;

    function GetTaskName(AShortTaskName: string): string;

  end;

implementation

uses

  UD2_PluginIntf, UD2_Utils;

function UD2_ErrorLookup(ec: UD2_STATUSCODE): string;

resourcestring

  LNG_STATUS_OK               = 'Operation completed sucessfully';

  LNG_STATUS_BUFFER_TOO_SMALL = 'The provided buffer is too small!';

  LNG_STATUS_INVALID_ARGS     = 'The function received invalid arguments!';

  LNG_STATUS_INVALID          = 'Unexpected status code %s';

  LNG_STATUS_NOT_LICENSED     = 'The plugin is not licensed';

begin

       if ec = UD2_STATUS_OK               then result := LNG_STATUS_OK

  else if ec = UD2_STATUS_BUFFER_TOO_SMALL then result := LNG_STATUS_BUFFER_TOO_SMALL

  else if ec = UD2_STATUS_INVALID_ARGS     then result := LNG_STATUS_INVALID_ARGS

  else if ec = UD2_STATUS_NOT_LICENSED     then result := LNG_STATUS_NOT_LICENSED

  else result := Format(LNG_STATUS_INVALID, ['0x'+IntToHex(ec, 8)]);

end;

{ TUD2Plugin }

function TUD2Plugin.PluginGUIDString: string;

begin

  result := UpperCase(GUIDToString(PluginGUID));

end;

procedure TUD2Plugin.AddIdentification(IdStr: WideString);

begin

  DetectedIdentifications.Add(TUD2IdentificationEntry.Create(IdStr, Self))

end;

destructor TUD2Plugin.Destroy;

begin

  DetectedIdentifications.Free;

  inherited;

end;

constructor TUD2Plugin.Create;

begin

  inherited Create;

  FDetectedIdentifications := TObjectList{<TUD2IdentificationEntry>}.Create(true);

end;

{ TUD2IdentificationEntry }

function TUD2IdentificationEntry.GetPrimaryIdName: WideString;

begin

  result := Plugin.IdentificationMethodName+':'+IdentificationString;

end;

procedure TUD2IdentificationEntry.GetIdNames(sl: TStrings);

begin

  sl.Add(GetPrimaryIdName);

  sl.Add(UpperCase(Plugin.IdentificationMethodName)+':'+IdentificationString);

  sl.Add(LowerCase(Plugin.IdentificationMethodName)+':'+IdentificationString);

  sl.Add(UpperCase(Plugin.PluginGUIDString)+':'+IdentificationString);

  sl.Add(LowerCase(Plugin.PluginGUIDString)+':'+IdentificationString);

end;

constructor TUD2IdentificationEntry.Create(AIdentificationString: WideString;

  APlugin: TUD2Plugin);

begin

  inherited Create;

  FIdentificationString := AIdentificationString;

  FPlugin := APlugin;

end;

{ TUD2 }

procedure TUD2.HandleDLL(dllFile: string);

  procedure ReportError(AMsg: string);

  begin

    // MessageDlg(AMsg, mtError, [mbOk], 0);

    Errors.Add(AMsg)

  end;

var

  sIdentifier: array[0..cchBufferSize-1] of WideChar;

  sIdentifiers: TArrayOfString;

  sPluginName: array[0..cchBufferSize-1] of WideChar;

  sPluginVendor: array[0..cchBufferSize-1] of WideChar;

  sPluginVersion: array[0..cchBufferSize-1] of WideChar;

  sIdentificationMethodName: array[0..cchBufferSize-1] of WideChar;

  sPluginConfigFile: string;

  iniConfig: TINIFile;

  sOverrideGUID: string;

  pluginID: TGUID;

  sPluginID: string;

  pluginInterfaceID: TGUID;

  dllHandle: cardinal;

  fPluginInterfaceID: TFuncPluginInterfaceID;

  fPluginIdentifier: TFuncPluginIdentifier;

  fPluginNameW: TFuncPluginNameW;

  fPluginVendorW: TFuncPluginVendorW;

  fPluginVersionW: TFuncPluginVersionW;

  fIdentificationMethodNameW: TFuncIdentificationMethodNameW;

  fIdentificationStringW: TFuncIdentificationStringW;

  fCheckLicense: TFuncCheckLicense;

  statusCode: UD2_STATUSCODE;

  pl: TUD2Plugin;

  i: integer;

  lngID: LANGID;

resourcestring

  LNG_DLL_NOT_LOADED = 'Plugin DLL "%s" could not be loaded.';

  LNG_METHOD_NOT_FOUND = 'Method "%s" not found in plugin "%s". The DLL is probably not a valid plugin DLL.';

  LNG_INVALID_PLUGIN = 'The plugin "%s" is not a valid plugin for this program version.';

  LNG_METHOD_FAILURE = 'Error "%s" at method "%s" of plugin "%s".';

  LNG_PLUGINS_SAME_GUID = 'Attention: The plugin "%s" and the plugin "%s" have the same identification GUID. The latter will not be loaded.';

begin

  lngID := GetSystemDefaultLangID;

  dllHandle := LoadLibrary(PChar(dllFile));

  if dllHandle = 0 then

  begin

    ReportError(Format(LNG_DLL_NOT_LOADED, [dllFile]));

  end;

  try

    @fPluginInterfaceID := GetProcAddress(dllHandle, mnPluginInterfaceID);

    if not Assigned(fPluginInterfaceID) then

    begin

      ReportError(Format(LNG_METHOD_NOT_FOUND, [mnPluginInterfaceID, dllFile]));

      Exit;

    end;

    pluginInterfaceID := fPluginInterfaceID();

    if not IsEqualGUID(pluginInterfaceID, GUID_USERDETECT2_IDPLUGIN_V1) then

    begin

      ReportError(Format(LNG_INVALID_PLUGIN, [dllFile]));

      Exit;

    end;

    @fIdentificationStringW := GetProcAddress(dllHandle, mnIdentificationStringW);

    if not Assigned(fIdentificationStringW) then

    begin

      ReportError(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationStringW, dllFile]));

      Exit;

    end;

    @fPluginNameW := GetProcAddress(dllHandle, mnPluginNameW);

    if not Assigned(fPluginNameW) then

    begin

      ReportError(Format(LNG_METHOD_NOT_FOUND, [mnPluginNameW, dllFile]));

      Exit;

    end;

    @fPluginVendorW := GetProcAddress(dllHandle, mnPluginVendorW);

    if not Assigned(fPluginVendorW) then

    begin

      ReportError(Format(LNG_METHOD_NOT_FOUND, [mnPluginVendorW, dllFile]));

      Exit;

    end;

    @fPluginVersionW := GetProcAddress(dllHandle, mnPluginVersionW);

    if not Assigned(fPluginVersionW) then

    begin

      ReportError(Format(LNG_METHOD_NOT_FOUND, [mnPluginVersionW, dllFile]));

      Exit;

    end;

    @fCheckLicense := GetProcAddress(dllHandle, mnCheckLicense);

    if not Assigned(fCheckLicense) then

    begin

      ReportError(Format(LNG_METHOD_NOT_FOUND, [mnCheckLicense, dllFile]));

      Exit;

    end;

    @fIdentificationMethodNameW := GetProcAddress(dllHandle, mnIdentificationMethodNameW);

    if not Assigned(fIdentificationMethodNameW) then

    begin

      ReportError(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationMethodNameW, dllFile]));

      Exit;

    end;

    sPluginID := '';

    sPluginConfigFile := ChangeFileExt(dllFile, '.ini');

    if FileExists(sPluginConfigFile) then

    begin

      iniConfig := TIniFile.Create(sPluginConfigFile);

      try

        sOverrideGUID := iniConfig.ReadString('Compatibility', 'OverrideGUID', '');

        if sOverrideGUID <> '' then

        begin

          sPluginID := sOverrideGUID;

          pluginID := StringToGUID(sPluginID);

        end;

      finally

        iniConfig.Free;

      end;

    end;

    if sPluginID = '' then

    begin

      @fPluginIdentifier := GetProcAddress(dllHandle, mnPluginIdentifier);

      if not Assigned(fPluginIdentifier) then

      begin

        ReportError(Format(LNG_METHOD_NOT_FOUND, [mnPluginIdentifier, dllFile]));

        Exit;

      end;

      pluginID := fPluginIdentifier();

      sPluginID := GUIDToString(pluginID);

    end;

    if (FGUIDLookup.Values[sPluginID] <> '') and (FGUIDLookup.Values[sPluginID] <> dllFile) then

    begin

      ReportError(Format(LNG_PLUGINS_SAME_GUID, [FGUIDLookup.Values[sPluginID], dllFile]));

      Exit;

    end

    else

    begin

      FGUIDLookup.Values[GUIDToString(pluginID)] := dllFile;

    end;

    statusCode := fCheckLicense(nil);

    if statusCode <> UD2_STATUS_OK then

    begin

      ReportError(Format(LNG_METHOD_FAILURE, [UD2_ErrorLookup(statusCode), mnCheckLicense, dllFile]));

      Exit;

    end;

    statusCode := fPluginNameW(@sPluginName, cchBufferSize, lngID);

    if statusCode <> UD2_STATUS_OK then

    begin

      ReportError(Format(LNG_METHOD_FAILURE, [UD2_ErrorLookup(statusCode), mnPluginNameW, dllFile]));

      Exit;

    end;

    statusCode := fPluginVendorW(@sPluginVendor, cchBufferSize, lngID);

    if statusCode <> UD2_STATUS_OK then

    begin

      ReportError(Format(LNG_METHOD_FAILURE, [UD2_ErrorLookup(statusCode), mnPluginVendorW, dllFile]));

      Exit;

    end;

    statusCode := fPluginVersionW(@sPluginVersion, cchBufferSize, lngID);

    if statusCode <> UD2_STATUS_OK then

    begin

      ReportError(Format(LNG_METHOD_FAILURE, [UD2_ErrorLookup(statusCode), mnPluginVersionW, dllFile]));

      Exit;

    end;

    statusCode := fIdentificationMethodNameW(@sIdentificationMethodName, cchBufferSize);

    if statusCode <> UD2_STATUS_OK then

    begin

      ReportError(Format(LNG_METHOD_FAILURE, [UD2_ErrorLookup(statusCode), mnIdentificationMethodNameW, dllFile]));

      Exit;

    end;

    pl := TUD2Plugin.Create;

    pl.PluginDLL     := dllFile;

    pl.PluginGUID    := pluginID;

    pl.PluginName    := sPluginName;

    pl.PluginVendor  := sPluginVendor;

    pl.PluginVersion := sPluginVersion;

    pl.IdentificationMethodName := sIdentificationMethodName;

    LoadedPlugins.Add(pl);

    statusCode := fIdentificationStringW(@sIdentifier, cchBufferSize);

    if statusCode <> UD2_STATUS_OK then

    begin

      ReportError(Format(LNG_METHOD_FAILURE, [UD2_ErrorLookup(statusCode), mnIdentificationStringW, dllFile]));

      Exit;

    end;

    if sIdentifier = '' then Exit;

    // Multiple identifiers (e.g. multiple MAC addresses are delimited via #10 )

    SetLength(sIdentifiers, 0);

    sIdentifiers := SplitString(UD2_MULTIPLE_ITEMS_DELIMITER, sIdentifier);

    for i := Low(sIdentifiers) to High(sIdentifiers) do

    begin

      pl.AddIdentification(sIdentifiers[i]);

    end;

  finally

    FreeLibrary(dllHandle);

  end;

end;

procedure TUD2.HandlePluginDir(APluginDir: string);

Var

  SR: TSearchRec;

  path: string;

begin

  path := IncludeTrailingPathDelimiter(APluginDir);

  if FindFirst(path + '*.dll', 0, SR) = 0 then

  begin

    repeat

      try

        HandleDLL(path + sr.Name);

      except

        on E: Exception do

        begin

          MessageDlg(E.Message, mtError, [mbOK], 0);

        end;

      end;

    until FindNext(SR) <> 0;

    FindClose(SR);

  end;

end;

destructor TUD2.Destroy;

begin

  FIniFile.Free;

  FLoadedPlugins.Free;

  FGUIDLookup.Free;

  FErrors.Free;

end;

constructor TUD2.Create(AIniFileName: string);

begin

  FIniFileName := AIniFileName;

  FLoadedPlugins := TObjectList{<TUD2Plugin>}.Create(true);

  FIniFile := TMemIniFile.Create(IniFileName);

  FGUIDLookup := TStringList.Create;

  FErrors := TStringList.Create;

end;

function TUD2.GetTaskName(AShortTaskName: string): string;

begin

  result := FIniFile.ReadString(AShortTaskName, 'Description', '('+AShortTaskName+')');

end;

procedure TUD2.GetTaskListing(outSL: TStrings);

var

  sl: TStringList;

  i: integer;

  desc: string;

begin

  sl := TStringList.Create;

  try

    FIniFile.ReadSections(sl);

    for i := 0 to sl.Count-1 do

    begin

      desc := GetTaskName(sl.Strings[i]);

      outSL.Values[sl.Strings[i]] := desc;

    end;

  finally

    sl.Free;

  end;

end;

function TUD2.TaskExists(ShortTaskName: string): boolean;

begin

  result := FIniFile.SectionExists(ShortTaskName);

end;

function TUD2.ReadMetatagString(ShortTaskName, MetatagName: string;

  DefaultVal: string): string;

begin

  result := IniFile.ReadString(ShortTaskName, MetatagName, DefaultVal);

end;

function TUD2.ReadMetatagBool(ShortTaskName, MetatagName: string;

  DefaultVal: string): boolean;

begin

  // DefaultVal is a string, because we want to allow an empty string, in case the

  // user wishes an Exception in case the string is not a valid boolean string

  result := BetterInterpreteBool(IniFile.ReadString(ShortTaskName, MetatagName, DefaultVal));

end;

(*

NAMING EXAMPLE: ComputerName:ABC&&User:John=calc.exe

        idTerm:       ComputerName:ABC&&User:John

        idName:       ComputerName:ABC

        IdMethodName: ComputerName

        IdStr         ABC

        cmd:          calc.exe

*)

procedure TUD2.GetCommandList(ShortTaskName: string; outSL: TStrings);

var

  i, j: integer;

  cmd: string;

  idTerm, idName: WideString;

  slSV, slIdNames: TStrings;

  x: TArrayOfString;

  nameVal: TArrayOfString;

  FulfilsEverySubterm: boolean;

  pl: TUD2Plugin;

  ude: TUD2IdentificationEntry;

begin

  SetLength(x, 0);

  SetLength(nameVal, 0);

  slIdNames := TStringList.Create;

  try

    for i := 0 to LoadedPlugins.Count-1 do

    begin

      pl := LoadedPlugins.Items[i] as TUD2Plugin;

      for j := 0 to pl.DetectedIdentifications.Count-1 do

      begin

        ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;

        ude.GetIdNames(slIdNames);

      end;

    end;

    slSV := TStringList.Create;

    try

      FIniFile.ReadSectionValues(ShortTaskName, slSV);

      for j := 0 to slSV.Count-1 do

      begin

        // 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[j]);

        idTerm := nameVal[0];

        cmd    := nameVal[1];

        if Pos(':', idTerm) = 0 then Continue;

        x := SplitString('&&', idTerm);

        FulfilsEverySubterm := true;

        for i := Low(x) to High(x) do

        begin

          idName := x[i];

          if slIdNames.IndexOf(idName) = -1 then

          begin

            FulfilsEverySubterm := false;

            break;

          end;

        end;

        if FulfilsEverySubterm then outSL.Add(cmd);

      end;

    finally

      slSV.Free;

    end;

  finally

    slIdNames.Free;

  end;

end;

end.