Секция 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 - Предыдущая - Следующая
© faqs.org.ru
