Ответ на вопрос № 80887

Доброго времени суток.
Пытаюсь сделать программу, которая автоматически могла бы менять источник звука по умолчанию. Реализацию в Delphi я к сожалению не нашел, но нашел реализацию на VC++, ссылка на ресурс:
Код HTML:
http://eretik.omegahg.com/art/07.html
Пытаюсь перенести код из С++ на Delphi, но на последней функции застрял
Код моего проекта:
Код:

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ActiveX, OleServer, StdVCL, MMSystem,ShlObj, StdCtrls;

const
CLSID_MMDeviceEnumerator : TGUID = '{BCDE0395-E52F-467C-8E3D-C4579291692E}';
Class_PolicyConfigClient:TGUID ='{870af99c-171d-4f9e-af0d-e63df40c2bc9}';
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}';
IID_IMMNotificationClient : TGUID = '{7991EEC9-7E89-4D85-8390-6C703CEC60C0}';
IID_IPropertyStore: TGUID = '{886D8EEB-8CF2-4446-8D02-CDBA1DBDCF99}';

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)
[IID_IAudioEndpointVolumeCallback]
end;

IAudioEndpointVolume = interface(IUnknown)
[IID_IAudioEndpointVolume]
end;

IAudioMeterInformation = interface(IUnknown)
[IID_IAudioMeterInformation]
end;

IPropertyStore = interface(IUnknown)
end;

IMMDevice = interface(IUnknown)
[IID_IMMDevice]
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: PWideChar): HRESULT; stdcall;
end;

IMMDeviceCollection = interface(IUnknown)
[IID_IMMDeviceCollection]
function GetCount(out pcDevices: UINT): HRESULT; stdcall;
function Item(nDevice: UINT; out ppDevice: IMMDevice): HRESULT; stdcall;
end;

IMMNotificationClient = interface(IUnknown)
[IID_IMMNotificationClient]
end;

IMMDeviceEnumerator = interface(IUnknown)
[IID_IMMDeviceEnumerator]
function EnumAudioEndpoints(dataFlow: EDataFlow; deviceState: SYSUINT; out DevCollection: IMMDeviceCollection): HRESULT; stdcall;
end;

IPolicyConfig = interface(IUnknown)
['{f8679f50-850a-41cf-9c72-430f290290c8}']
function SetDefaultEndpoint (wszDeviceID:PWideChar; ERole:ERole):Hresult; stdcall;
end;

type
TForm2 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var
AudioEndpoints:IMMDeviceEnumerator;
Collection:IMMDeviceCollection;
Device:IMMDevice;

Proper:IPropertyStore;

Id_Dev:PWideChar;

Def_Dev_Ch:IPolicyConfig;
begin
CoCreateInstance (CLSID_MMDeviceEnumerator,nil,CLSCTX_INPROC_SERVER,IID_IMMDeviceEnumerator,AudioEndpoints);
AudioEndpoints.EnumAudioEndpoints(eAll, DEVICE_STATE_ACTIVE, &Collection);

Collection.Item(0,Device);
Device.GetId(Id_Dev);

if Succeeded(CoCreateInstance (Class_PolicyConfigClient,nil,CLSCTX_INPROC_SERVER,IPolicyConfig,Def_Dev_Ch)) then
begin
if Succeeded(Def_Dev_Ch.SetDefaultEndpoint(Id_Dev,eMultimedia)) then
begin
showmessage ('eMultimedia');
end;
end;
end;

end.

Дело в том, чот инициализация всех указателей происходит нормально, ID устройства (для примера выбираю первое) получаю верное, но при попытке выполнить Def_Dev_Ch.SetDefaultEndpoint(Id_De v,eMultimedia) появляется ошибка: raise exception class eaccessviolation with message 'Access violation at address 73a44fbb in module 'audioses.dll' Write of address 00000001', причем ошибка записи в память меняется в зависимости от роли, которую я указываю (при консольной роли ошибки не появляется, но я думаю что это из-за того, что eConsole = $00000000;, при роли eMultimedia запись 00000001, при eCommunications запись в адрес 00000002).
Прошу помочь мне с этой проблемой, объяснить где я накасячил.
Заранее огромное спасибо!

	"Knowledge itself is power" F.Bacon
Поиск \| Карта сайта \| Помощь \| О проекте \| ТТХ