Обсуждение программирования на Delphi в конференции ru.delphi

Привет Вам, Maks.





SetWindowTheme - можно даже только для своего окна. Эффект рулёзный. Также
посмотри на OpenThemeData и на DrawThemeBackGroundEx.





Видимо SystemParametersInfo или через IShellMenu::XXX, но ни то ни другое
для менюшки "Пуск" лично не пробовал.





Что значит "те же"? Работать с таскбаром удобно через ITaskBarList::XXX
или через ShellNotifyIcon. Если интересует именно внешний вид, то
SystemParametersInfo.

З.Ы. Это вопросы не по эхотагу совсем, ага.

Hу вот и всё. Я рад, если Вам понравилось.
* Origin: Земля - приют на миг, а жизнь - чудесный вздор! (2:5022/81.16)


Привет Вам, aleXander.








В WMI есть такой класс Win32_FileSpecification. В нём определены в
частности и поля для CRC и т.д. Вот в сторону WMI и следует копать, особенно в
сторону Windows Installer'a 2.0 и выше. В нём эта функциональность уже
реализована и не худшим образом.

Hу вот и всё. Я рад, если Вам понравилось.
* Origin: Земля - приют на миг, а жизнь - чудесный вздор! (2:5022/81.16)


Hello everybody.

Прокомментируйте нижеследующий модуль работы с чтением из трубы.
Работает, но где-то здесь вроде ошибка?
И конструкция

while true do begin
PipeFromDemod:=tPipeFromDemod.Create(...
PipeFromDemod.Free;
end;
Тоже вызывает ошибку, хотя по алгоритму не должна.


unit Pipe;

interface

uses
Windows, Classes, SysUtils,
Dialogs,

Security,
TypeArrayOfByte;


const
cMaxDataFromDemodSize=$FFFF;

type
tPipeFromDemod=class(tThread)
FPipeName: string;
FPipeHandle: tHandle;
FKadrProcessorHandle: tHandle;
FWM_Kadr: THandle;
FEvent: tHandle;
FEventQuit: tHandle; //event on termination
FEventOnQuit: tHandle; //event on termination
FEvents: array[1..2] of THandle;
FpData: pArrayofByte;
FpSending: pArrayofByte;
procedure Execute; override;

public
constructor Create(APipeName: string; AKadrProcessorHandle: tHandle;
AWM_Kadr: THandle);
destructor Destroy; override;
procedure Terminate;
end;

implementation

// tPipeFromDemod

constructor tPipeFromDemod.Create(APipeName: string; AKadrProcessorHandle:
tHandle; AWM_Kadr: THandle);
var
sa: SECURITY_ATTRIBUTES;
begin
inherited Create(true);
FKadrProcessorHandle:=AKadrProcessorHandle;
FWM_Kadr:=AWM_Kadr;
FPipeName:=APipeName;

sa:=CreateSecurityAll;

FPipeHandle:=CreateNamedPipe(PChar(FPipeName),
PIPE_ACCESS_INBOUND or //данные идут только от клиента к серверу
PIPE_ACCESS_DUPLEX or //убрать потом
FILE_FLAG_OVERLAPPED, //Overlapped режим
PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or //данные читаются из
пайпа как поток сообзений
PIPE_WAIT, //блокирующий режим
PIPE_UNLIMITED_INSTANCES, //максимальное количество экземпляров пайпа
$FFFF, $FFFF, //рамеры буферов чтения записи
NMPWAIT_USE_DEFAULT_WAIT,
[@] sa); //указатель на дескриптор безопасности

FreeMem(sa.lpSecurityDescriptor);

if FPipeHandle=INVALID_HANDLE_VALUE then
raise Exception.Create('CreateNamedPipe: '+SysErrorMessage(GetLastError));

FEvent:=CreateEvent(nil, //no SA
true, //manual reset
true, //initial state is signaled
nil); //no name

if FEvent = 0 then
raise Exception.Create('CreateEvent: '+SysErrorMessage(GetLastError));

FEventQuit:=CreateEvent(nil, //no SA
true, //manual reset
false, //initial state is nonsignaled
nil); //no name

if FEventQuit = 0 then
raise Exception.Create('CreateEvent: '+SysErrorMessage(GetLastError));

FEvents[1]:=FEvent;
FEvents[2]:=FEventQuit;

FEventOnQuit:=CreateEvent(nil, //no SA
true, //manual reset
false, //initial state is nonsignaled
nil); //no name


GetMem(FpData, cMaxDataFromDemodSize);
FreeOnTerminate:=True;
Resume;
end;

destructor tPipeFromDemod.Destroy;
var
dwWait: dword;
begin
SetEvent(FEventQuit);
dwWait:=WaitForSingleObject(FEventOnQuit, 5000);
case dwWait of
WAIT_OBJECT_0: begin
// ShowMessage('WAIT_TIMEOUT 0')
end;
WAIT_TIMEOUT: begin
ShowMessage('WAIT_TIMEOUT 1')
end;
end;

DisconnectNamedPipe(FPipeHandle);
CloseHandle(FPipeHandle);
CloseHandle(FEvent);
CloseHandle(FEventQuit);
FreeMem(FpData);
if Assigned(FpSending) then
FreeMem(FpSending);

CloseHandle(FEventOnQuit);
inherited;
end;

procedure tPipeFromDemod.Execute;
var
ovl: TOverlapped;
le: DWORD;
dwWait: DWORD;
fSuccess: boolean;
cbRet: DWORD;
lpNumberOfBytesRead: dword;
begin
while not Terminated do begin
sleep(1);
DisconnectNamedPipe(FPipeHandle);
FillChar(ovl, sizeof(ovl), 0);
Ovl.hEvent:=FEvent;

if not ConnectNamedPipe(FPipeHandle, [@] ovl) then begin
le:=GetLastError;
case le of
ERROR_IO_PENDING: begin
dwWait:=WaitForMultipleObjects(2, PWOHandleArray( [@] FEvents), false,
INFINITE);
case dwWait of
WAIT_OBJECT_0: begin
fSuccess:=GetOverlappedResult(FPipeHandle, ovl, cbRet, false);
if not fSuccess then continue;
end;
WAIT_OBJECT_0+1: begin
Terminate;
end;
end;
end;
ERROR_PIPE_CONNECTED: begin

end;
else begin
Terminate;
end;
end;
end else begin
continue;
// Terminate;
end;

while not Terminated do begin
sleep(1);
if not ReadFile(FPipeHandle, FpData^, $FFFF, lpNumberOfBytesRead, [@] ovl)
then begin
le:=GetLastError;
case le of
ERROR_IO_PENDING: begin
dwWait:=WaitForMultipleObjects(2, PWOHandleArray( [@] FEvents), false,
INFINITE);
case dwWait of
WAIT_OBJECT_0: begin
fSuccess:=GetOverlappedResult(FPipeHandle, ovl,
lpNumberOfBytesRead, false);
if not fSuccess then break;
end;
WAIT_OBJECT_0+1: begin
Terminate;
break;
end;
end;
end;
else begin
//pipe is broken or some errors
//need to reconnect
break;
end;
end;
end;

GetMem(FpSending, lpNumberOfBytesRead);
Move(FpData^, FpSending^, lpNumberOfBytesRead);
PostMessage(FKadrProcessorHandle,
FWM_Kadr,
integer(lpNumberOfBytesRead), integer(FpSending));
FpSending:=nil;
end;
end;
end;
SetEvent(FEventOnQuit);
end;

procedure tPipeFromDemod.Terminate;
var
dwWait: dword;
isTerminated: boolean;
begin
isTerminated:=Terminated;
inherited Terminate;
if not isTerminated then begin
SetEvent(FEventQuit);

dwWait:=WaitForSingleObject(FEventOnQuit, 5000);
case dwWait of
WAIT_OBJECT_0: begin
// ShowMessage('WAIT_TIMEOUT 0')
end;
WAIT_TIMEOUT: begin
ShowMessage('WAIT_TIMEOUT 1')
end;
end;
end;
end;

end.


Lexa

* Origin: Буратино - ты сам себе злобный (2:5061/122.12)




Hi,

Мне нужны супер контролы. Супер они потому, что должны
одновременно поддерживать Windows XP Themes (то есть
XP-ишные скины) и работать нормально с Unicode.
Конкретнее, нужен комбобокс. Перерыл сайт Torry - неудачно...
Те контролы, что я нашел, не поддерживают WinXP skins.
Очень желательно, чтобы были бесплатные. Если таких не знаете,
говорите те которые Вам известны, пусть даже и платные.
Hо если кто-то знает бесплатные,все равно не поленитесь сюда
пожалуйста сообщить!

xof

* Origin: Demos online service (2:5020/400)


Buenas Dias All!

Ищется фpиваpный компонент для 7ой Delphi, шифpyющий данные по алгоpитмy DES.
Киньте линком плиз?

Multo Fortune!

* Origin: [Welcome 2 the Butterfly's Cave!] (2:466/44.9)






DES.

Библиотека DEC. www.inspired.sk/delphi/components/component.php?ID=55

Алексей.


* Origin: BiComTel (2:5020/400)












Hичего с Global особенного химичить не надо. Просто задаешь имя mutex-а в
виде "Global\..." и всего-то. И он будет один на всех юзеров. Читайте
справку по CreateMutex в Platform SDK Documentation.

Что касается всяких файликов, создаваемых в каталоге программы, сие есть
ересь и безграмотность. Ибо вовсе не факт что программа может писать в свой
каталог.


* Origin: South Ural Network (2:5010/70)









Рекомендую также рассмотреть способ отправки через MAPI, т.е. с
использованием почтовой программы зарегистрированной в системе.


* Origin: South Ural Network (2:5010/70)




А подскажите как из Дельфи определить имя принтера в виндах?


* Origin: Alkar Teleport News Server (2:5020/400)


Здравствуй, Сергей.

07 Oct 05, Сергей Бородин писал(а) к All:



uses Printers;
....
ShowMessage(Printer.Printers.Text);

mad
* Origin: carpe diem (2:468/57.205)