jcldotnet.pas

East make Tray Icon in delphi

function TJclClrHost.GetAppDomainCount: Integer;
begin
  Result := FAppDomains.Count;
end;

function TJclClrHost.GetDefaultAppDomain: IJclClrAppDomain;
var
  Unk: IUnknown;
begin
  OleCheck(FDefaultInterface.GetDefaultDomain(Unk));
  Result := Unk as IJclClrAppDomain;
end;

function TJclClrHost.GetCurrentAppDomain: IJclClrAppDomain;
var
  Unk: IUnknown;
begin
  OleCheck(FDefaultInterface.CurrentDomain(Unk));
  Result := Unk as IJclClrAppDomain;
end;

function TJclClrHost.AddAppDomain(const AppDomain: TJclClrAppDomain): Integer;
begin
  Result := FAppDomains.Add(AppDomain);
end;

function TJclClrHost.RemoveAppDomain(const AppDomain: TJclClrAppDomain): Integer;
begin
  Result := FAppDomains.Remove(AppDomain);
end;

class function TJclClrHost.CorSystemDirectory: WideString;
var
  Len: DWORD;
begin
  SetLength(Result, MAX_PATH);
  OleCheck(GetCORSystemDirectory(PWideChar(Result), Length(Result), Len));
  SetLength(Result, Len);
end;

class function TJclClrHost.CorVersion: WideString;
var
  Len: DWORD;
begin
  SetLength(Result, 64);
  OleCheck(GetCORVersion(PWideChar(Result), Length(Result), Len));
  SetLength(Result, Len);
end;

class function TJclClrHost.CorRequiredVersion: WideString;
var
  Len: DWORD;
begin
  SetLength(Result, 64);
  OleCheck(GetCORRequiredVersion(PWideChar(Result), Length(Result), Len));
  SetLength(Result, Len);
end;

function TJclClrHost.CreateDomainSetup: TJclClrAppDomainSetup;
var
  pUnk: IUnknown;
begin
  OleCheck(FDefaultInterface.CreateDomainSetup(pUnk));
  Result := TJclClrAppDomainSetup.Create(pUnk as IAppDomainSetup);
end;

function TJclClrHost.CreateAppDomain(const Name: WideString;
  const Setup: TJclClrAppDomainSetup;
  const Evidence: IJclClrEvidence): TJclClrAppDomain;
var
  pUnk: IUnknown;
begin
  OleCheck(FDefaultInterface.CreateDomainEx(PWideChar(Name), Setup as IAppDomainSetup, Evidence, pUnk));
  Result := TJclClrAppDomain.Create(Self, pUnk as IJclClrAppDomain);
end;

procedure TJclClrHost.Start;
begin
  OleCheck(DefaultInterface.Start);
  Refresh;
end;

procedure TJclClrHost.Stop;
begin
  OleCheck(DefaultInterface.Stop);
end;

procedure TJclClrHost.Refresh;
begin
  EnumAppDomains;
end;

//=== { TJclClrAppDomain } ===================================================

constructor TJclClrAppDomain.Create(const AHost: TJclClrHost;
  const AAppDomain: IJclClrAppDomain);
begin
  Assert(Assigned(AHost));
  Assert(Assigned(AAppDomain));
  inherited Create;
  FHost := AHost;
  FDefaultInterface := AAppDomain;
  FHost.AddAppDomain(Self);
end;

function TJclClrAppDomain.Execute(const AssemblyFile: TFileName;
  const Arguments: TJclClrAssemblyArguments;
  const AssemblySecurity: IJclClrEvidence): Integer;
var
  Args: Variant;
begin
  Assert(FileExists(AssemblyFile));
  if Length(Arguments) = 0 then
    Result := Execute(AssemblyFile, AssemblySecurity)
  else
  begin
    DynArrayToVariant(Args, @Arguments[0], TypeInfo(TJclClrAssemblyArguments));
    Result := DefaultInterface.ExecuteAssembly_3(AssemblyFile, AssemblySecurity, PSafeArray(TVarData(Args).VArray));
  end;
end;

function TJclClrAppDomain.Execute(const AssemblyFile: TFileName;
  const AssemblySecurity: IJclClrEvidence): Integer;
begin
  Assert(FileExists(AssemblyFile));
  if Assigned(AssemblySecurity) then
    Result := DefaultInterface.ExecuteAssembly(AssemblyFile, AssemblySecurity)
  else
    Result := DefaultInterface.ExecuteAssembly_2(AssemblyFile);
end;

function TJclClrAppDomain.Execute(const AssemblyFile: TFileName;
  const Arguments: TStrings; const AssemblySecurity: IJclClrEvidence): Integer;
var
  Args: Variant;
begin
  Assert(FileExists(AssemblyFile));
  if Arguments.Count = 0 then
    Result := Execute(AssemblyFile, AssemblySecurity)
  else
  begin
    Args := VarArrayFromStrings(Arguments);
    Result := DefaultInterface.ExecuteAssembly_3(AssemblyFile, AssemblySecurity, PSafeArray(TVarData(Args).VArray));
  end;
end;

function TJclClrAppDomain.Load(const AssemblyString: WideString;
  const AssemblySecurity: IJclClrEvidence): TJclClrAssembly;
begin
  if Assigned(AssemblySecurity) then
    Result := TJclClrAssembly.Create(DefaultInterface.Load_7(AssemblyString, AssemblySecurity))
  else
    Result := TJclClrAssembly.Create(DefaultInterface.Load_2(AssemblyString));
end;

function TJclClrAppDomain.Load(const RawAssemblyStream,
  RawSymbolStoreStream: TStream;
  const AssemblySecurity: IJclClrEvidence): TJclClrAssembly;
var
  RawAssembly, RawSymbolStore: Variant;
begin
  Assert(Assigned(RawAssemblyStream));
  RawAssembly := VarArrayCreate([0, RawAssemblyStream.Size-1], varByte);
  try
    try
      RawAssemblyStream.Read(VarArrayLock(RawAssembly)^, RawAssemblyStream.Size);
    finally
      VarArrayUnlock(RawAssembly);
    end;

    if not Assigned(RawSymbolStoreStream) then
      Result := TJclClrAssembly.Create(DefaultInterface.Load_3(PSafeArray(TVarData(RawAssembly).VArray)))
    else
    begin
      RawSymbolStore := VarArrayCreate([0, RawSymbolStoreStream.Size-1], varByte);
      try
        try
          RawSymbolStoreStream.Read(VarArrayLock(RawSymbolStore)^, RawSymbolStoreStream.Size);
        finally
          VarArrayUnlock(RawSymbolStore);
        end;

        if Assigned(AssemblySecurity) then
          Result := TJclClrAssembly.Create(DefaultInterface.Load_5(
            PSafeArray(TVarData(RawAssembly).VArray),
            PSafeArray(TVarData(RawSymbolStore).VArray),
            AssemblySecurity))
        else
          Result := TJclClrAssembly.Create(DefaultInterface.Load_4(
            PSafeArray(TVarData(RawAssembly).VArray),
            PSafeArray(TVarData(RawSymbolStore).VArray)));
      finally
        VarClear(RawSymbolStore);
      end;
    end;
  finally
    VarClear(RawAssembly);
  end;
end;

procedure TJclClrAppDomain.Unload;
var
  AppDomain: TJclClrAppDomain;
begin
  OleCheck(FHost.DefaultInterface.UnloadDomain(DefaultInterface));
  if FHost.FindAppDomain(DefaultInterface, AppDomain) and (AppDomain = Self) then
    FHost.RemoveAppDomain(Self);
end;

//=== { TJclClrObject } ======================================================

constructor TJclClrObject.Create(const AssemblyName, NamespaceName, ClassName: WideString;
  const Parameters: array of const);
begin
  inherited Create;
end;

constructor TJclClrObject.Create(const AssemblyName, NamespaceName, ClassName: WideString;
  const NewInstance: Boolean);
begin
  Create(AssemblyName, NamespaceName, ClassName, []);
end;

function TJclClrObject.GetField(const Name: WideString): TJclClrField;
begin
  // (rom) added to suppress warning until implementation
  Result := nil;
end;

function TJclClrObject.GetProperty(const Name: WideString): TJclClrProperty;
begin
  // (rom) added to suppress warning until implementation
  Result := nil;
end;

function TJclClrObject.GetMethod(const Name: WideString): TJclClrMethod;
begin
  // (rom) added to suppress warning until implementation
  Result := nil;
end;

//=== { TJclClrAppDomainSetup } ==============================================

constructor TJclClrAppDomainSetup.Create(Intf: IAppDomainSetup);
begin
  Assert(Assigned(Intf));
  inherited Create;
  FDefaultInterface := Intf;
end;

function TJclClrAppDomainSetup.GetApplicationBase: WideString;
begin
  OleCheck(FDefaultInterface.Get_ApplicationBase(Result));
end;

function TJclClrAppDomainSetup.GetApplicationName: WideString;
begin
  OleCheck(FDefaultInterface.Get_ApplicationName(Result));
end;

function TJclClrAppDomainSetup.GetCachePath: WideString;
begin
  OleCheck(FDefaultInterface.Get_CachePath(Result));
end;

function TJclClrAppDomainSetup.GetConfigurationFile: WideString;
begin
  OleCheck(FDefaultInterface.Get_ConfigurationFile(Result));
end;

function TJclClrAppDomainSetup.GetDynamicBase: WideString;
begin
  OleCheck(FDefaultInterface.Get_DynamicBase(Result));
end;

function TJclClrAppDomainSetup.GetLicenseFile: WideString;
begin
  OleCheck(FDefaultInterface.Get_LicenseFile(Result));
end;

function TJclClrAppDomainSetup.GetPrivateBinPath: WideString;
begin
  OleCheck(FDefaultInterface.Get_PrivateBinPath(Result));
end;

function TJclClrAppDomainSetup.GetPrivateBinPathProbe: WideString;
begin
  OleCheck(FDefaultInterface.Get_PrivateBinPathProbe(Result));
end;

function TJclClrAppDomainSetup.GetShadowCopyDirectories: WideString;
begin
  OleCheck(FDefaultInterface.Get_ShadowCopyDirectories(Result));
end;

function TJclClrAppDomainSetup.GetShadowCopyFiles: WideString;
begin
  OleCheck(FDefaultInterface.Get_ShadowCopyFiles(Result));
end;

procedure TJclClrAppDomainSetup.SetApplicationBase(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_ApplicationBase(Value));
end;

procedure TJclClrAppDomainSetup.SetApplicationName(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_ApplicationName(Value));
end;

procedure TJclClrAppDomainSetup.SetCachePath(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_CachePath(Value));
end;

procedure TJclClrAppDomainSetup.SetConfigurationFile(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_ConfigurationFile(Value));
end;

procedure TJclClrAppDomainSetup.SetDynamicBase(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_DynamicBase(Value));
end;

procedure TJclClrAppDomainSetup.SetLicenseFile(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_LicenseFile(Value));
end;

procedure TJclClrAppDomainSetup.SetPrivateBinPath(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_PrivateBinPath(Value));
end;

procedure TJclClrAppDomainSetup.SetPrivateBinPathProbe(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_PrivateBinPathProbe(Value));
end;

procedure TJclClrAppDomainSetup.SetShadowCopyDirectories(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_ShadowCopyDirectories(Value));
end;

procedure TJclClrAppDomainSetup.SetShadowCopyFiles(const Value: WideString);
begin
  OleCheck(FDefaultInterface.Set_ShadowCopyFiles(Value));
end;

//=== { TJclClrAssembly } ====================================================

constructor TJclClrAssembly.Create(Intf: IJclClrAssembly);
begin
  Assert(Assigned(Intf));
  inherited Create;
  FDefaultInterface := Intf;
end;

// History:

// $Log: JclDotNet.pas,v $
// Revision 1.13  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.12  2005/02/25 07:20:15  marquardt
// add section lines
//
// Revision 1.11  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.10  2004/10/17 21:00:14  mthoma
// cleaning
//
// Revision 1.9  2004/08/09 06:38:08  marquardt
// add JvWStrUtils.pas as JclWideStrings.pas
//
// Revision 1.8  2004/08/01 11:40:23  marquardt
// move constructors/destructors
//
// Revision 1.7  2004/06/14 13:05:21  marquardt
// style cleaning ENDIF, Tabs
//
// Revision 1.6  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.5  2004/04/06 04:55:17  
// adapt compiler conditions, add log entry
//

end.