17 августа 2019 года    
Суббота | 17:05    
Главная
 Новости
Базы данных
Безопасность PC
Всё о компьютерах
Графика и дизайн
Интернет-технологии
Мобильные устройства
Операционные системы
Программирование
Программы
Связь
Сети
 Документация
Статьи
Самоучители
 Общение
Форум







Разделы / Программирование / Delphi

Полезные советы по работе с Windows API и Delphi VCL.

Секция 3 из 8 - Предыдущая - Следующая
Все секции - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8

#include <lmaccess.h>

void
InitLsaString(
    PLSA_UNICODE_STRING LsaString,
    LPWSTR String
    )
{
    DWORD StringLength;

    if (String == NULL) {
        LsaString->Buffer = NULL;
        LsaString->Length = 0;
        LsaString->MaximumLength = 0;
        return;
    }

    StringLength = wcslen(String);
    LsaString->Buffer = String;
    LsaString->Length = (USHORT) StringLength * sizeof(WCHAR);
    LsaString->MaximumLength=(USHORT)(StringLength+1) * sizeof(WCHAR);
}
//----------------------------------------------------------------------
NTSTATUS
OpenPolicy(
    LPWSTR ServerName,
    DWORD DesiredAccess,
    PLSA_HANDLE PolicyHandle
    )
{
    LSA_OBJECT_ATTRIBUTES ObjectAttributes;
    LSA_UNICODE_STRING ServerString;
    PLSA_UNICODE_STRING Server = NULL;

    //
    // Always initialize the object attributes to all zeroes.
    //
    ZeroMemory(&ObjectAttributes, sizeof(ObjectAttributes));

    if (ServerName != NULL) {
        //
        // Make a LSA_UNICODE_STRING out of the LPWSTR passed in
        //
        InitLsaString(&ServerString, ServerName);
        Server = &ServerString;
    }

    //
    // Attempt to open the policy.
    //
    return LsaOpenPolicy(
                Server,
                &ObjectAttributes,
                DesiredAccess,
                PolicyHandle
                );
}
//***************************************************************************//

Author>:
Sergey Andyk (Сергей Андык)
(2:5005/58.43)
asvzzz@chat.ru
.

Q>:
[API, NT] Как узнать SID юзера?
A>:
Из исходника getadmin:

BOOL
GetAccountSid(
    LPTSTR SystemName,
    LPTSTR AccountName,
    PSID *Sid
    )
{
    LPTSTR ReferencedDomain=NULL;
    DWORD cbSid=128;    // initial allocation attempt
    DWORD cbReferencedDomain=16; // initial allocation size
    SID_NAME_USE peUse;
    BOOL bSuccess=FALSE; // assume this function will fail

    __try {

    //
    // initial memory allocations
    //
    if((*Sid=HeapAlloc(
                    GetProcessHeap(),
                    0,
                    cbSid
                    )) == NULL) __leave;

    if((ReferencedDomain=(LPTSTR)HeapAlloc(
                    GetProcessHeap(),
                    0,
                    cbReferencedDomain
                    )) == NULL) __leave;

    //
    // Obtain the SID of the specified account on the specified system.
    //
    while(!LookupAccountName(
                    SystemName,         // machine to lookup account on
                    AccountName,        // account to lookup
                    *Sid,               // SID of interest
                    &cbSid,             // size of SID
                    ReferencedDomain,   // domain account was found on
                    &cbReferencedDomain,
                    &peUse
                    )) {
        if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
            //
            // reallocate memory
            //
            if((*Sid=HeapReAlloc(
                        GetProcessHeap(),
                        0,
                        *Sid,
                        cbSid
                        )) == NULL) __leave;

            if((ReferencedDomain=(LPTSTR)HeapReAlloc(
                        GetProcessHeap(),
                        0,
                        ReferencedDomain,
                        cbReferencedDomain
                        )) == NULL) __leave;
        }
        else __leave;
    }

    //
    // Indicate success.
    //
    bSuccess=TRUE;

    } // finally
    __finally {

    //
    // Cleanup and indicate failure, if appropriate.
    //

    HeapFree(GetProcessHeap(), 0, ReferencedDomain);

    if(!bSuccess) {
        if(*Sid != NULL) {
            HeapFree(GetProcessHeap(), 0, *Sid);
            *Sid = NULL;
        }
    }

    } // finally

    return bSuccess;
}
//***************************************************************************//

Author>:
Sergey Andyk (Сергей Андык)
(2:5005/58.43)
asvzzz@chat.ru
.

Q>:
[API, NT] Как зтот самый SID привести к текстовому виду(например для
загрузки HKEY_USERS)?
A>:
Смотри исходный текст:

// nearly straight from the SDK
BOOL Sid2Text( PSID ps, char *buf, int bufSize )
{
 PSID_IDENTIFIER_AUTHORITY psia;
 DWORD dwSubAuthorities;
 DWORD dwSidRev = SID_REVISION;
 DWORD i;
 int n, size;
 char *p;

 // Validate the binary SID.

 if ( ! IsValidSid( ps ) )
  return FALSE;

 // Get the identifier authority value from the SID.

 psia = GetSidIdentifierAuthority( ps );

 // Get the number of subauthorities in the SID.

 dwSubAuthorities = *GetSidSubAuthorityCount( ps );

 // Compute the buffer length.
 // S-SID_REVISION- + IdentifierAuthority- + subauthorities- + NULL

 size = 15 + 12 + ( 12 * dwSubAuthorities ) + 1;

 // Check input buffer length.
 // If too small, indicate the proper size and set last error.

 if ( bufSize < size )
 {
  SetLastError( ERROR_INSUFFICIENT_BUFFER );
  return FALSE;
 }

 // Add 'S' prefix and revision number to the string.

 size = wsprintf( buf, "S-%lu-", dwSidRev );
 p = buf + size;

 // Add SID identifier authority to the string.

 if ( psia->Value[0] != 0 || psia->Value[1] != 0 )
 {
  n = wsprintf( p, "0x%02hx%02hx%02hx%02hx%02hx%02hx",
  (USHORT) psia->Value[0], (USHORT) psia->Value[1],
  (USHORT) psia->Value[2], (USHORT) psia->Value[3],
  (USHORT) psia->Value[4], (USHORT) psia->Value[5] );
  size += n;
  p += n;
 }
 else
 {
  n = wsprintf( p, "%lu", ( (ULONG) psia->Value[5] ) +
  ( (ULONG) psia->Value[4] << 8 ) + ( (ULONG) psia->Value[3] << 16 ) +
  ( (ULONG) psia->Value[2] << 24 ) );
  size += n;
  p += n;
 }

 // Add SID subauthorities to the string.

 for ( i = 0; i < dwSubAuthorities; ++ i )
 {
  n = wsprintf( p, "-%lu", *GetSidSubAuthority( ps, i ) );
  size += n;
  p += n;
 }

 return TRUE;
}

//***************************************************************************//

Author>:
Sergey Andyk (Сергей Андык)
(2:5005/58.43)
asvzzz@chat.ru
.

Q>:
[API, NT] Как узнать какие привилегии есть у пользователя ?
A>:
Исходный текст прилагается:

#include <windows.h>
#include <stdio.h>
#pragma hdrstop

void main()
{
 HANDLE hToken;
 LUID setcbnameValue;
 TOKEN_PRIVILEGES tkp;
 DWORD errcod;
 LPVOID lpMsgBuf;
 LPCTSTR msgptr;

 UCHAR InfoBuffer[1000];
 PTOKEN_PRIVILEGES ptgPrivileges = (PTOKEN_PRIVILEGES) InfoBuffer;
 DWORD dwInfoBufferSize;
 DWORD dwPrivilegeNameSize;
 DWORD dwDisplayNameSize;
 UCHAR ucPrivilegeName[500];
 UCHAR ucDisplayName[500];
 DWORD dwLangId;
 UINT i;

 if ( ! OpenProcessToken( GetCurrentProcess(),
  TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY, &hToken ) )
 {
  puts( "OpenProcessToken" );
  return;
 }

 // ---------------------------------------------------------------------
 // enumerate currently held privs (NOTE: not *enabled* privs, just the
 // ones you _could_ enable as in the last part)

 GetTokenInformation( hToken, TokenPrivileges, InfoBuffer,
  sizeof InfoBuffer, &dwInfoBufferSize);

 printf( "Account privileges: \n\n" );
 for( i = 0; i < ptgPrivileges->PrivilegeCount; i ++ )
 {
  dwPrivilegeNameSize = sizeof ucPrivilegeName;
  dwDisplayNameSize = sizeof ucDisplayName;
  LookupPrivilegeName( NULL, &ptgPrivileges->Privileges[i].Luid,
   ucPrivilegeName, &dwPrivilegeNameSize );
  LookupPrivilegeDisplayName( NULL, ucPrivilegeName,
   ucDisplayName, &dwDisplayNameSize, &dwLangId );
  printf( "%40s (%s)\n", ucDisplayName, ucPrivilegeName );
 }

}

//****************************************************************************/
/

Author>:
Sergey Andyk (Сергей Андык)
(2:5005/58.43)
asvzzz@chat.ru
.

> --- changed in 8.0
Q>:
[API,NT] Как проверить, имеем ли мы административные привилегии в системе?
A>:
// Routine: check if the user has administrator provileges
// Was converted from C source by Akzhan Abdulin. Not properly tested.
type
 PTOKEN_GROUPS = TOKEN_GROUPS^;

function RunningAsAdministrator (): Boolean;
var
 SystemSidAuthority: SID_IDENTIFIER_AUTHORITY = SECURITY_NT_AUTHORITY;
 psidAdmin: PSID;
 ptg: PTOKEN_GROUPS = nil;
 htkThread: Integer; { HANDLE }
 cbTokenGroups: Longint; { DWORD }
 iGroup: Longint; { DWORD }
 bAdmin: Boolean;

begin
    Result := false;
    if not OpenThreadToken(GetCurrentThread(),      // get security token
                        TOKEN_QUERY,
                        FALSE,
                        htkThread) then
       if GetLastError() = ERROR_NO_TOKEN then
       begin
          if not OpenProcessToken(GetCurrentProcess(),
                               TOKEN_QUERY,
                               htkThread) then
          Exit;
       end
       else
          Exit;
    if GetTokenInformation(htkThread,            // get #of groups
                           TokenGroups,
                           nil,
                           0,
                           cbTokenGroups) then
       Exit;
    if GetLastError() <> ERROR_INSUFFICIENT_BUFFER then
       Exit;
    ptg := PTOKEN_GROUPS( getmem( cbTokenGroups ) );
    if not Assigned(ptg) then
       Exit;
    if not GetTokenInformation(htkThread,           // get groups
                            TokenGroups,
                            ptg,
                            cbTokenGroups,
                            cbTokenGroups) then
       Exit;
    if not AllocateAndInitializeSid(SystemSidAuthority,
                                 2,
                                 SECURITY_BUILTIN_DOMAIN_RID,
                                 DOMAIN_ALIAS_RID_ADMINS,
                                 0, 0, 0, 0, 0, 0,
                                 psidAdmin) then
       Exit;
    iGroup := 0;
    while iGroup < ptg^.GroupCount do // check administrator group
    begin
       if EqualSid(ptg^.Groups[iGroup].Sid, psidAdmin) then
       begin
          Result := TRUE;
          break;
       end;
       Inc( iGroup );
    end;
    FreeSid(psidAdmin);
end;

Author>:
Andy Nikolayev
an@megatel.msk.su
(2:5020/56)

Два метода в одном флаконе:

#include <windows.h>
#include <stdio.h>
#include <lm.h>
#pragma hdrstop

#pragma comment( lib, "netapi32.lib" )

// My thanks to Jerry Coffin (jcoffin@taeus.com)
// for this much simpler method.
bool jerry_coffin_method()
{
 bool result;
 DWORD rc;
 wchar_t user_name[256];
 USER_INFO_1 *info;
 DWORD size = sizeof( user_name );

 GetUserNameW( user_name, &size);

 rc = NetUserGetInfo( NULL, user_name, 1, (byte **) &info );
 if ( rc != NERR_Success )
  return false;

 result = info->usri1_priv == USER_PRIV_ADMIN;

 NetApiBufferFree( info );
 return result;
}



bool look_at_token_method()
{
 int found;
 DWORD i, l;
 HANDLE hTok;
 PSID pAdminSid;
 SID_IDENTIFIER_AUTHORITY ntAuth = SECURITY_NT_AUTHORITY;

 byte rawGroupList[4096];
 TOKEN_GROUPS& groupList = *( (TOKEN_GROUPS *) rawGroupList );

 if ( ! OpenThreadToken( GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok ) )
 {
  printf( "Cannot open thread token, trying process token [%lu].\n",
   GetLastError() );
  if ( ! OpenProcessToken( GetCurrentProcess(), TOKEN_QUERY, &hTok ) )
  {
   printf( "Cannot open process token, quitting [%lu].\n",
    GetLastError() );
   return 1;
  }
 }

 // normally, I should get the size of the group list first, but ...
 l = sizeof rawGroupList;
 if ( ! GetTokenInformation( hTok, TokenGroups, &groupList, l, &l ) )
 {
  printf( "Cannot get group list from token [%lu].\n",
   GetLastError() );
  return 1;
 }

 // here, we cobble up a SID for the Administrators group, to compare to.
 if ( ! AllocateAndInitializeSid( &ntAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,
  DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid ) )
 {
  printf( "Cannot create SID for Administrators [%lu].\n",
   GetLastError() );
  return 1;
 }

 // now, loop through groups in token and compare
 found = 0;
 for ( i = 0; i < groupList.GroupCount; ++ i )
 {
  if ( EqualSid( pAdminSid, groupList.Groups[i].Sid ) )
  {
   found = 1;
   break;
  }
 }

 FreeSid( pAdminSid );
 CloseHandle( hTok );
 return !!found;
}

int main()
{
 bool j, l;

 j = jerry_coffin_method();
 l = look_at_token_method();

 printf( "NetUserGetInfo(): The current user is %san Administrator.\n",
  j? "": "not " );
 printf( "Process token: The current user is %sa member of the Administrators
group.\n",
  l? "": "not " );

 return 0;
}

//****************************************************************************/
/

Author>:
Sergey Andyk (Сергей Андык)
(2:5005/58.43)
asvzzz@chat.ru
.

Q>:
[API] Как программно включить или выключить NumLock?
A>:
var
	abKeyState: array [0..255] of byte;
begin
	GetKeyboardState( Addr( abKeyState[ 0 ] ) );
	abKeyState[ VK_NUMLOCK ] := abKeyState[ VK_NUMLOCK ] or $01;
	SetKeyboardState( Addr( abKeyState[ 0 ] ) );

Author>:
Elijah Demin
(2:5030/916.15)
.

> --- added in v7.2
Q>:
[API, W32] Как использовать в своей программе API DirectSound и DirectSound3D?
A>:
======== Пример 1:

  Представляю вашему вниманию рабочий пример использования DirectSound на
Delphi + несколько полезных процедур. В этом примере создается один первичный
 SoundBuffer и 2 статических, вторичных; в них загружаются 2 WAV файла.
 Первичный буфер создается процедурой AppCreateWritePrimaryBuffer, а любой
 вторичный - AppCreateWritePrimaryBuffer. Так как вторичный буфер связан с WAV
 файлом, то при создании буфера нужно определить его параметры в соответствии
 со звуковым файлом, эти характеристики (Samples, Bits, IsStereo) задаются в
виде параметров процедуры. Time - время WAV'файл в секундах (округление в
сторону увеличения). При нажатии на кнопку происходит микширование из вторичных
буферов в первичный. AppWriteDataToBuffer позволяет записать в буфер
 PCM сигнал. Процедура CopyWAVToBuffer открывает WAV файл, отделяет заголовок,
 читает чанк 'data' и копирует его в буфер (при этом сначала считывается размер
данных, так как в некоторых WAV файлах существует текстовый довесок, и если его
не убрать, в динамиках возможен треск).

 PS. Если есть какие-нибудь вопросы, постараюсь на них ответить.

 >------------------------------ Begin
 >-----------------------------------<

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, DSound, MMSystem, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
   DirectSound          : IDirectSound;
   DirectSoundBuffer    : IDirectSoundBuffer;
   SecondarySoundBuffer : array[0..1] of IDirectSoundBuffer;
   procedure AppCreateWritePrimaryBuffer;
   procedure AppCreateWriteSecondaryBuffer(var Buffer: IDirectSoundBuffer;
                                          SamplesPerSec: Integer;
                                          Bits: Word;
                                          isStereo:Boolean;
                                          Time: Integer);
   procedure AppWriteDataToBuffer(Buffer: IDirectSoundBuffer;
                                 OffSet: DWord; var SoundData;
                                 SoundBytes: DWord);
   procedure CopyWAVToBuffer(Name: PChar; var Buffer: IDirectSoundBuffer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 if DirectSoundCreate(nil, DirectSound, nil) <> DS_OK then
  Raise Exception.Create('Failed to create IDirectSound object');
 AppCreateWritePrimaryBuffer;
 AppCreateWriteSecondaryBuffer(SecondarySoundBuffer[0],22050,8,False,10);
 AppCreateWriteSecondaryBuffer(SecondarySoundBuffer[1],22050,16,True,1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i: ShortInt;
begin
 if Assigned(DirectSoundBuffer) then DirectSoundBuffer.Release;
 for i:=0 to 1 do
 if Assigned(SecondarySoundBuffer[i]) then SecondarySoundBuffer[i].Release;
 if Assigned(DirectSound) then DirectSound.Release;
end;

procedure TForm1.AppWriteDataToBuffer;
var AudioPtr1,AudioPtr2     : Pointer;
    AudioBytes1,AudioBytes2 : DWord;
    h : HResult;
    Temp : Pointer;
begin
  H:=Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1,
              AudioPtr2, AudioBytes2, 0);
  if H = DSERR_BUFFERLOST  then
  begin
   Buffer.Restore;
   if Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1,
                  AudioPtr2, AudioBytes2, 0) <> DS_OK then
      Raise Exception.Create('Unable to Lock Sound Buffer');
  end else
  if H <> DS_OK then Raise Exception.Create('Unable to Lock Sound Buffer');
  Temp:=@SoundData;
  Move(Temp^, AudioPtr1^, AudioBytes1);
  if AudioPtr2 <> nil then
  begin
   Temp:=@SoundData; Inc(Integer(Temp), AudioBytes1);
   Move(Temp^, AudioPtr2^, AudioBytes2);
  end;
  if Buffer.UnLock(AudioPtr1, AudioBytes1,AudioPtr2, AudioBytes2) <> DS_OK
   then Raise Exception.Create('Unable to UnLock Sound Buffer');
end;

procedure TForm1.AppCreateWritePrimaryBuffer;
var BufferDesc  : DSBUFFERDESC;
    Caps        : DSBCaps;
    PCM         : TWaveFormatEx;
begin
 FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
 FillChar(PCM, SizeOf(TWaveFormatEx),0);
 with BufferDesc do
 begin
  PCM.wFormatTag:=WAVE_FORMAT_PCM;
  PCM.nChannels:=2;
  PCM.nSamplesPerSec:=22050;
  PCM.nBlockAlign:=4;
  PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
  PCM.wBitsPerSample:=16;
  PCM.cbSize:=0;
  dwSize:=SizeOf(DSBUFFERDESC);
  dwFlags:=DSBCAPS_PRIMARYBUFFER;
  dwBufferBytes:=0;
  lpwfxFormat:=nil;
 end;
 if DirectSound.SetCooperativeLevel(Handle,DSSCL_WRITEPRIMARY) <> DS_OK
  then Raise Exception.Create('Unable to set Coopeative Level');
 if DirectSound.CreateSoundBuffer(BufferDesc,DirectSoundBuffer,nil) <> DS_OK
  then Raise Exception.Create('Create Sound Buffer failed');
 if DirectSoundBuffer.SetFormat(PCM) <> DS_OK
  then Raise Exception.Create('Unable to Set Format ');
 if DirectSound.SetCooperativeLevel(Handle,DSSCL_NORMAL) <> DS_OK
 then Raise Exception.Create('Unable to set Coopeative Level');
 end;

procedure TForm1.AppCreateWriteSecondaryBuffer;
var BufferDesc  : DSBUFFERDESC;
    Caps        : DSBCaps;
    PCM         : TWaveFormatEx;
begin
 FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
 FillChar(PCM, SizeOf(TWaveFormatEx),0);
 with BufferDesc do
 begin
  PCM.wFormatTag:=WAVE_FORMAT_PCM;
  if isStereo then PCM.nChannels:=2 else PCM.nChannels:=1;
  PCM.nSamplesPerSec:=SamplesPerSec;
  PCM.nBlockAlign:=(Bits div 8)*PCM.nChannels;
  PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
  PCM.wBitsPerSample:=Bits;
  PCM.cbSize:=0;
  dwSize:=SizeOf(DSBUFFERDESC);
  dwFlags:=DSBCAPS_STATIC;
  dwBufferBytes:=Time*PCM.nAvgBytesPerSec;
  lpwfxFormat:=@PCM;
 end;
 if DirectSound.CreateSoundBuffer(BufferDesc,Buffer,nil) <> DS_OK
  then Raise Exception.Create('Create Sound Buffer failed');
end;

procedure TForm1.CopyWAVToBuffer;
var Data     : PChar;
    FName    : TFileStream;
    DataSize : DWord;
    Chunk    : String[4];
    Pos      : Integer;
begin
 FName:=TFileStream.Create(Name,fmOpenRead);
 Pos:=24;
 SetLength(Chunk,4);
 repeat
  FName.Seek(Pos, soFromBeginning);
  FName.Read(Chunk[1],4);
  Inc(Pos);
 until Chunk = 'data';
 FName.Seek(Pos+3, soFromBeginning);
 FName.Read(DataSize, SizeOf(DWord));
 GetMem(Data,DataSize);
 FName.Read(Data^, DataSize);
 FName.Free;
 AppWriteDataToBuffer(Buffer,0,Data^,DataSize);
 FreeMem(Data,DataSize);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 CopyWAVToBuffer('1.wav',SecondarySoundBuffer[0]);
 CopyWAVToBuffer('flip.wav',SecondarySoundBuffer[1]);

 if SecondarySoundBuffer[0].Play(0,0,0) <> DS_OK
  then ShowMessage('Can''t play the Sound');

 if SecondarySoundBuffer[1].Play(0,0,0) <> DS_OK
  then ShowMessage('Can''t play the Sound');
end;

end.

 >------------------------------- End
 >------------------------------------<

======== Пример 2:

 Представляю вашему вниманию очередной пример работы с DirectSound на Delphi.
В этом примере показан принцип работы с 3D буфером. Итак, процедуры
AppCreateWritePrimaryBuffer, AppWriteDataToBuffer, CopyWAVToBuffer я оставил
без изменения (см. письма с до этого). Процедура
AppCreateWriteSecondary3DBuffer является полным аналогом процедуры
AppCreateWriteSecondaryBuffer, за исключением флага DSBCAPS_CTRL3D, который
указывает на то, что со статическим вторичным буфером будет связан еще один
буфер - SecondarySound3DBuffer. Чтобы его инициализировать, а также установить
некоторые начальные значения (положение в пространстве, скорость и .т.д.)
вызывается процедура AppSetSecondary3DBuffer, в качестве параметров которой
передаются сам SecondarySoundBuffer и связанный с ним SecondarySound3DBuffer.
В этой процедуре SecondarySound3DBuffer инициализируется с помощью метода
QueryInterface c соответствующим флагом. Кроме того, здесь же устанавливается
положение источника звука в пространстве: SetPosition(Pos,1,1,0).
                                                        X,Y,Z

 Таким образом в начальный момент времени источник находится на высоте 1 м
(ось Y направлена вертикально вверх, а ось Z - "в экран").
Если смотреть сверху :

                  ^ Z
                  |
    А             |
                  |
                  O----------------> X

 Точка O (фактически вы) имеет координаты (0,0), источник звука А(-25,1).
Разумеется понятие "метр" весьма условно.

 При нажатии на кнопку в буфер SecondarySoundBuffer загружается звук
'xhe4.wav'. Это звук работающего винта вертолета, его длина (звука) ровно
3.99 с (а размер буфера ровно 4 с). Далее происходит микширование из вторичного
буфера в первичный с флагом DSBPLAY_LOOPING, что позволяет сделать многократно
повторяющийся звук; время в 0.01 с ухом практически не улавливается и
получается непрерывный звук летящего вертолета. После этого запускется таймер
(поле INTERVAL в Инспекторе Оъектов установлено в 1). Разумеется вам совсем
необязательно делать именно так, это просто пример. В процедуре Timer1Timer
просто меняется координата X с шагом 0.1.

 В итоге получаем летящий вертолет слева направо. Заодно можете проверить,
правильно ли у вас расположены колонки.

PS. Если есть вопросы, постараюсь на них ответить.

 >------------------------------ Begin
 >-----------------------------------<

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, DSound, MMSystem, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
   DirectSound            : IDirectSound;
   DirectSoundBuffer      : IDirectSoundBuffer;
   SecondarySoundBuffer   : IDirectSoundBuffer;
   SecondarySound3DBuffer : IDirectSound3DBuffer;
   procedure AppCreateWritePrimaryBuffer;
   procedure AppCreateWriteSecondary3DBuffer(var Buffer: IDirectSoundBuffer;
                                          SamplesPerSec: Integer;
                                          Bits: Word;
                                          isStereo:Boolean;
                                          Time: Integer);
   procedure AppSetSecondary3DBuffer(var Buffer: IDirectSoundBuffer;
                                     var _3DBuffer: IDirectSound3DBuffer);
   procedure AppWriteDataToBuffer(Buffer: IDirectSoundBuffer;
                                 OffSet: DWord; var SoundData;
                                 SoundBytes: DWord);
   procedure CopyWAVToBuffer(Name: PChar; var Buffer: IDirectSoundBuffer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var Result : HResult;
begin
 if DirectSoundCreate(nil, DirectSound, nil) <> DS_OK then
  Raise Exception.Create('Failed to create IDirectSound object');
 AppCreateWritePrimaryBuffer;
 AppCreateWriteSecondary3DBuffer(SecondarySoundBuffer,22050,8,False,4);
 AppSetSecondary3DBuffer(SecondarySoundBuffer,SecondarySound3DBuffer);
 Timer1.Enabled:=False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i: ShortInt;
begin
 if Assigned(DirectSoundBuffer) then DirectSoundBuffer.Release;
 if Assigned(SecondarySound3DBuffer) then SecondarySound3DBuffer.Release;
 if Assigned(SecondarySoundBuffer) then SecondarySoundBuffer.Release;
 if Assigned(DirectSound) then DirectSound.Release;
end;

procedure TForm1.AppCreateWritePrimaryBuffer;
var BufferDesc  : DSBUFFERDESC;
    Caps        : DSBCaps;
    PCM         : TWaveFormatEx;
begin
 FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
 FillChar(PCM, SizeOf(TWaveFormatEx),0);
 with BufferDesc do
 begin
  PCM.wFormatTag:=WAVE_FORMAT_PCM;
  PCM.nChannels:=2;
  PCM.nSamplesPerSec:=22050;
  PCM.nBlockAlign:=4;
  PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
  PCM.wBitsPerSample:=16;
  PCM.cbSize:=0;
  dwSize:=SizeOf(DSBUFFERDESC);
  dwFlags:=DSBCAPS_PRIMARYBUFFER;
  dwBufferBytes:=0;
  lpwfxFormat:=nil;
 end;
 if DirectSound.SetCooperativeLevel(Handle,DSSCL_WRITEPRIMARY) <> DS_OK
  then Raise Exception.Create('Unable to set Cooperative Level');
 if DirectSound.CreateSoundBuffer(BufferDesc,DirectSoundBuffer,nil) <> DS_OK
  then Raise Exception.Create('Create Sound Buffer failed');
 if DirectSoundBuffer.SetFormat(PCM) <> DS_OK
  then Raise Exception.Create('Unable to Set Format ');
 if DirectSound.SetCooperativeLevel(Handle,DSSCL_NORMAL) <> DS_OK
 then Raise Exception.Create('Unable to set Cooperative Level');
end;

procedure TForm1.AppCreateWriteSecondary3DBuffer;
var BufferDesc  : DSBUFFERDESC;
    Caps        : DSBCaps;
    PCM         : TWaveFormatEx;
begin
 FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
 FillChar(PCM, SizeOf(TWaveFormatEx),0);
 with BufferDesc do
 begin
  PCM.wFormatTag:=WAVE_FORMAT_PCM;
  if isStereo then PCM.nChannels:=2 else PCM.nChannels:=1;
  PCM.nSamplesPerSec:=SamplesPerSec;
  PCM.nBlockAlign:=(Bits div 8)*PCM.nChannels;
  PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
  PCM.wBitsPerSample:=Bits;
  PCM.cbSize:=0;
  dwSize:=SizeOf(DSBUFFERDESC);
  dwFlags:=DSBCAPS_STATIC or DSBCAPS_CTRL3D;
  dwBufferBytes:=Time*PCM.nAvgBytesPerSec;
  lpwfxFormat:=@PCM;
 end;
 if DirectSound.CreateSoundBuffer(BufferDesc,Buffer,nil) <> DS_OK
  then Raise Exception.Create('Create Sound Buffer failed');
end;

procedure TForm1.AppWriteDataToBuffer;
var AudioPtr1,AudioPtr2     : Pointer;
    AudioBytes1,AudioBytes2 : DWord;
    h : HResult;
    Temp : Pointer;
begin
  H:=Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1,
              AudioPtr2, AudioBytes2, 0);
  if H = DSERR_BUFFERLOST  then
  begin
   Buffer.Restore;
   if Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1,
                  AudioPtr2, AudioBytes2, 0) <> DS_OK then
      Raise Exception.Create('Unable to Lock Sound Buffer');
  end else
  if H <> DS_OK then Raise Exception.Create('Unable to Lock Sound Buffer');
  Temp:=@SoundData;
  Move(Temp^, AudioPtr1^, AudioBytes1);
  if AudioPtr2 <> nil then
  begin
   Temp:=@SoundData; Inc(Integer(Temp), AudioBytes1);
   Move(Temp^, AudioPtr2^, AudioBytes2);
  end;
  if Buffer.UnLock(AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2) <> DS_OK
   then Raise Exception.Create('Unable to UnLock Sound Buffer');
end;

procedure TForm1.CopyWAVToBuffer;
var Data     : PChar;
    FName    : TFileStream;
    DataSize : DWord;
    Chunk    : String[4];
    Pos      : Integer;
begin
 FName:=TFileStream.Create(Name,fmOpenRead);
 Pos:=24;
 SetLength(Chunk,4);
 repeat
  FName.Seek(Pos, soFromBeginning);
  FName.Read(Chunk[1],4);
  Inc(Pos);
 until Chunk = 'data';
 FName.Seek(Pos+3, soFromBeginning);
 FName.Read(DataSize, SizeOf(DWord));
 GetMem(Data,DataSize);
 FName.Read(Data^, DataSize);
 FName.Free;
 AppWriteDataToBuffer(Buffer,0,Data^,DataSize);
 FreeMem(Data,DataSize);
end;

var Pos : Single = -25;

procedure TForm1.AppSetSecondary3DBuffer;
begin
 if Buffer.QueryInterface(IID_IDirectSound3DBuffer, _3DBuffer) <> DS_OK then
   Raise Exception.Create('Failed to create IDirectSound3D object');
 if _3DBuffer.SetPosition(Pos,1,1,0) <> DS_OK then
   Raise Exception.Create('Failed to set IDirectSound3D Position');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 CopyWAVToBuffer('xhe4.wav',SecondarySoundBuffer);

 if SecondarySoundBuffer.Play(0,0,DSBPLAY_LOOPING) <> DS_OK
  then ShowMessage('Can''t play the Sound');

 Timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 SecondarySound3DBuffer.SetPosition(Pos,1,1,0);
 Pos:=Pos + 0.1;
end;

end.

 >------------------------------- End
 >------------------------------------<

Author>:
Sergey Melnikov
(2:5020/1065.18)
.

> --- changed in v7.2
Q>:
[API] Как зафиксировать один или несколько столбцов в TDBGrid с возможностью
навигации по этим столбцам?
A>:
Это маленькая вставка в Ваш наследник от TCustomDBGrid, которая решает данную
задачу.

=== Begin DBGRIDEX.PAS ===
// ----------------------------------------------------------------------------
-
destructor TDbGridEx.Destroy;
begin

  _HideColumnsValues.Free;
  _HideColumns.Free;

  inherited Destroy;
end;

// ----------------------------------------------------------------------------
constructor TDbGridEx.Create(Component : TComponent);
begin
  inherited Create(Component);

  FFreezeCols   := ?;

  _HideColumnsValues := TList.Create;
  _HideColumns       := TList.Create;
end;

// ----------------------------------------------------------------------------
procedure TDbGridEx.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_LEFT) then ColBeforeEnter(-1);
  if (Key = VK_RIGHT) then ColBeforeEnter(1);

  inherited;
end;

// ----------------------------------------------------------------------------
procedure TDbGridEx.SetFreezeColor(AColor : TColor);
begin
  InvalidateRow(0);
end;

// ----------------------------------------------------------------------------
procedure TDbGridEx.SetFreezeCols(AFreezeCols : Integer);
begin
  FFreezeCols := AFreezeCols;
  InvalidateRow(0);
end;

// ----------------------------------------------------------------------------
procedure TDbGridEx.ColEnter;
begin
  ColBeforeEnter(0);

  if Assigned(OnColEnter) then OnColEnter(Self);
end;

// ----------------------------------------------------------------------------
procedure TDbGridEx.ColBeforeEnter(ADelta : Integer);
var
  nIndex : Integer;

function ReadWidth : Integer;
var
  i : Integer;

begin
  i := _HideColumns.IndexOf(Columns[nIndex]);

  if i = -1
    then result := 120
    else result := Integer(_HideColumnsValues[i]);
end;

procedure SaveWidth;
var
  i : Integer;

begin
  i := _HideColumns.IndexOf(Columns[nIndex]);
  if i <> - 1 then
  begin
    _HideColumnsValues[i] := Pointer(Columns[nIndex].Width);
  end else
  begin
    _HideColumns.Add(Columns[nIndex]);
    _HideColumnsValues.Add(Pointer(Columns[nIndex].Width));
  end;
end;

begin
  for nIndex := 0 to Columns.Count - 1 do

Секция 3 из 8 - Предыдущая - Следующая

 Полезные советы по работе с Windows API и Delphi VCL.
Лента новостей


2006 (c) Copyright Hardline.ru