Interface 'IAudioEndpointVolume' läuft unter TurboDelphi aber nicht unter Delphi10.1?

[samso]

Ich glaube nicht das der Fehler durch den gezeigten Code hervorgerufen wird, sondern an einer anderen Stelle. Ich würde denken, dass an irgend einer Stelle Speicher überschrieben wird. Verdächtige Kandidaten sind move-Befehle insbesondere im Zusammenhang mit Strings (die nun Unicode sind). Zusätzlich wäre es ganz gut die Rückgabewerte der Funktionsaufrufe auszuwerten (und bei einem Fehler eine Exception auszulösen o.ä).

[t.roller]

Woher bekommt MuteStatus : boolean; seinen Wert?
Getmute liefert einen INTEGER-Wert zurück.

Ersetze MMDevAPI:

Delphi-Quellcode:

unit MMDevAPI; //20161125

interface

uses
//  Windows, ActiveX, ComObj;
  Winapi.Windows, Winapi.ActiveX, System.Win.ComObj;

const
  CLASS_IMMDeviceEnumerator             : TGUID = '{BCDE0395-E52F-467C-8E3D-C4579291692E}';
  IID_IMMDeviceEnumerator               : TGUID = '{A95664D2-9614-4F35-A746-DE8DB63617E6}';
  IID_IMMDevice                         : TGUID = '{D666063F-1587-4E43-81F1-B948E807363F}';
  IID_IMMDeviceCollection               : TGUID = '{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}';
  IID_IAudioEndpointVolume              : TGUID = '{5CDF2C82-841E-4546-9722-0CF74078229A}';
  IID_IAudioMeterInformation            : TGUID = '{C02216F6-8C67-4B5B-9D00-D008E73E0064}';
  IID_IAudioEndpointVolumeCallback      : TGUID = '{657804FA-D6AD-4496-8A60-352752AF4F89}';

  DEVICE_STATE_ACTIVE                   = $00000001;
  DEVICE_STATE_UNPLUGGED                = $00000002;
  DEVICE_STATE_NOTPRESENT               = $00000004;
  DEVICE_STATEMASK_ALL                  = $00000007;

type
  EDataFlow = TOleEnum;

const
  eRender                               = $00000000;
  eCapture                              = $00000001;
  eAll                                  = $00000002;
  EDataFlow_enum_count                  = $00000003;
               
type
  ERole = TOleEnum;

const
  eConsole                              = $00000000;
  eMultimedia                           = $00000001;
  eCommunications                       = $00000002;
  ERole_enum_count                      = $00000003;

type
  IAudioEndpointVolumeCallback = interface(IUnknown)
  ['{657804FA-D6AD-4496-8A60-352752AF4F89}']
  end;

  IAudioEndpointVolume = interface(IUnknown)
  ['{5CDF2C82-841E-4546-9722-0CF74078229A}']
    function RegisterControlChangeNotify(AudioEndPtVol: IAudioEndpointVolumeCallback): Integer; stdcall;
    function UnregisterControlChangeNotify(AudioEndPtVol: IAudioEndpointVolumeCallback): Integer; stdcall;
    function GetChannelCount(out PInteger): Integer; stdcall;
    function SetMasterVolumeLevel(fLevelDB: single; pguidEventContext: PGUID): Integer; stdcall;
    function SetMasterVolumeLevelScalar(fLevelDB: single; pguidEventContext: PGUID): Integer; stdcall;
    function GetMasterVolumeLevel(out fLevelDB: single): Integer; stdcall;
    function GetMasterVolumeLevelScaler(out fLevelDB: single): Integer; stdcall;
    function SetChannelVolumeLevel(nChannel: Integer; fLevelDB: double; pguidEventContext: PGUID): Integer; stdcall;
    function SetChannelVolumeLevelScalar(nChannel: Integer; fLevelDB: double; pguidEventContext: PGUID): Integer; stdcall;
    function GetChannelVolumeLevel(nChannel: Integer; out fLevelDB: double): Integer; stdcall;
    function GetChannelVolumeLevelScalar(nChannel: Integer; out fLevel: double): Integer; stdcall;
    function SetMute(bMute: Boolean; pguidEventContext: PGUID): Integer; stdcall;
    function GetMute(out bMute: Boolean): Integer; stdcall;
    function GetVolumeStepInfo(pnStep: Integer; out pnStepCount: Integer): Integer; stdcall;
    function VolumeStepUp(pguidEventContext: PGUID): Integer; stdcall;
    function VolumeStepDown(pguidEventContext: PGUID): Integer; stdcall;
    function QueryHardwareSupport(out pdwHardwareSupportMask): Integer; stdcall;
    function GetVolumeRange(out pflVolumeMindB: double; out pflVolumeMaxdB: double; out pflVolumeIncrementdB: double): Integer; stdcall;
  end;

  IAudioMeterInformation = interface(IUnknown)
  ['{C02216F6-8C67-4B5B-9D00-D008E73E0064}']
  end;

  IPropertyStore = interface(IUnknown)
  end;

  IMMDevice = interface(IUnknown)
  ['{D666063F-1587-4E43-81F1-B948E807363F}']
    function Activate(const refId: TGUID;
                      dwClsCtx: DWORD;
                      pActivationParams: PInteger;
                      out pEndpointVolume: IAudioEndpointVolume): Hresult; stdCall;
    function OpenPropertyStore(stgmAccess: DWORD; out ppProperties: IPropertyStore): Hresult; stdcall;
    function GetId(out ppstrId: PLPWSTR): Hresult; stdcall;
    function GetState(out State: Integer): Hresult; stdcall;
  end;


  IMMDeviceCollection = interface(IUnknown)
  ['{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}']
  end;

  IMMNotificationClient = interface(IUnknown)
  ['{7991EEC9-7E89-4D85-8390-6C703CEC60C0}']
  end;

  IMMDeviceEnumerator = interface(IUnknown)
  ['{A95664D2-9614-4F35-A746-DE8DB63617E6}']
    function EnumAudioEndpoints(dataFlow: EDataFlow; deviceState: SYSUINT; DevCollection: IMMDeviceCollection): Hresult; stdcall;
    function GetDefaultAudioEndpoint(EDF: SYSUINT; ER: SYSUINT; out Dev :IMMDevice ): Hresult; stdcall;
    function GetDevice(pwstrId: pointer; out Dev: IMMDevice): HResult; stdcall;
    function RegisterEndpointNotificationCallback(pClient: IMMNotificationClient): Hresult; stdcall;
  end;

implementation

end.

[himitsu]

"Boolean" (1 Byte) ist auch falsch, da BOOL dem LongBool (4 Byte) entspricht.
Und bei GetChannelCount hat sich auch ein Fehler eingeschlichen. GetChannelCount(out pnChannelCount: Integer)
Aber ist grundsätzlich erstmal egal, da solche Fehler sowohl in DX10, also auch in D2006 einen Fehler darstellen.

Ansonsten sehen die gezeigeten paar wenigen Codezeilen eigentlich OK aus.

[Zacherl]

Tippe auch auf einen Buffer-Overflow an anderer Stelle. Funktioniert das Interface in einem komplett neuen Projekt oder kracht es da auch?

[r29d43]

Thx @all erstmal.

Ich habe mal Zacherls Rat umgesetzt und ein neues Prog mit diesem Interface aufgesetzt. Erstes Ergebnis: Es kam zu keinen dieser besagten Exceptions mehr. Auch als ich anschließend mein Prob-Prog Stück für Stück in dieses neue integriert habe, lief erstmal noch alles glatt.

...Was also immerhin schonmal zeigt, dass Delphie 10.1 durchaus auch mit diesem Interface kann.

Erst als ich ganz zum Schluss auch noch die beiden Timer einbaute, stellten sich diese besagten Exceptions wieder ein. Und zwar dann, wenn ich in dieser TimerProc auf eine Feld-Variable der Hauptform zugreife, so wie ich das schon in Post 1 geschildert habe.

Vermutungen?

[Zacherl]

Zitat von r29d43:

Vermutungen?

Ist leider ohne den kompletten Source ein reines Ratespiel. Irgendwo wirst du über (Array/String/etc.)Bereichsgrenzen hinaus schreiben oder durch manuelle Pointer-Spielchen den Speicher korrumpieren.

[r29d43]

Ich habe das Prog jetzt nochmal neu aufgebaut - nur jetzt aus der anderen Richtung her aufgezogen. Nach der Installation des endpointVolume-Interfaces dann zuerst den Timer auf die Form gesetzt (bei dem ja im Versuch davor die Exceptions angefangen haben). Dann die Timer-Proc erstellt, von der aus, nach einer kleine Anweisung, dann eine weitere kleine Proc aufrufen wird. Und schon ab da tritt der Fehler auch hier immer wieder auf, also ohne ein weiteres Control auf der Form und mit nur einer weiteren Feld-Variablen (jenseits der drei, die ich für die Installation des Interfaces brauche).

Ich liste das Mini-Prog, das so natürlich keinerlei Sinn mehr ergibt, trotzdem noch mal auf. Eventuell will das ja mal jemand kurz gegenchecken. Aktuelles System auf dem ich das gerade ausprobiere ist Win7. Die Exception

---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt Project1.exe ist eine Exception der Klasse $C0000005 mit der Meldung 'access violation at 0x005c9d80: read of address 0x00000001' aufgetreten.
---------------------------
Anhalten Fortsetzen Hilfe
---------------------------

taucht bei mir jedesmal in dieser Proc "BlablaSub" auf.

Delphi-Quellcode:

unit unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ActiveX, MMDevApi, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
    endpointVolume: IAudioEndpointVolume;     // Interface-Pointer, Interface ist in MMDevApi definiert; ..wird im Prog dann als drittes ermittelt
    deviceEnumerator: IMMDeviceEnumerator;    // Interface-Pointer, Interface ist in MMDevApi definiert;  ..wird im Prog als erster ermittelt
    defaultDevice: IMMDevice;                 // Interface-Pointer, Interface ist in MMDevApi definiert;  ..wird im Prog als zweites ermittelt

    MuteStatus : boolean;
    procedure BlablaSub;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);
begin
  // Die drei ersten Anweisungen haben einen Pointer auf ein IAudioEndpointVolume-Interface zu ermitteln, über dessen Methoden dann alles geht

  // kreiert ein "IMMDeviceEnumerator"-Objekt (siehe MMDevApi-Unit unten), "deviceEnumerator" zeigt dann anschließend darauf
  CoCreateInstance(CLASS_IMMDeviceEnumerator, nil, CLSCTX_INPROC_SERVER, IID_IMMDeviceEnumerator, deviceEnumerator);
  // diese "GetDefaultAudioEndpoint"-Methode des "IMMDeviceEnumerator"-Objektes besorgt dann ein "IMMDevice"-Objekt (siehe MMDevApi-Unit etwa mitte), "defaultDevice" zeigt dann anschließend darauf
  deviceEnumerator.GetDefaultAudioEndpoint(eRender, eConsole, defaultDevice);
  // diese "Activate"-Methode des "IMMDevice"-Objektes besorgt dann ein "IAudioEndpointVolume"-Objekt (siehe MMDevApi-Unit etwa Anfang der Interface-Deklarationen), "endpointValume" zeigt dann anschließend darauf
  //_und mit den Methoden dieses "IAudioEndpointVolume"-Objektes, gepointet durch "endpointVolume", wird dann alles geschaltet
  defaultDevice.Activate(IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, nil, endpointVolume);

  // die nächsten 2 Zeilen weisen dem Timer zwar nur Defaulteinstellungen zu, sollen also genau das auch nur aussagen
  Timer1.Enabled := true;
  Timer1.Interval := 1000;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var momMuteStatus : boolean;
begin
  endpointVolume.GetMute(momMuteStatus);

  if momMuteStatus <> MuteStatus then
    BlablaSub;
end;

procedure TForm1.BlablaSub;
var aResult : integer;
begin
  aResult := endpointVolume.GetMute(MuteStatus);

end;

end.