» Вопросы по Delphi (до версии 2009) - часть 6

R3Pa4eK
Удалите из юзес Forms и StdCtrls, но я сомневаюсь, что это сильно поможет. Большего эффекта можно добиться только отказавшись от ImageEn.

R3Pa4eK
а в ресурсе ISLogo.res что?

Varenik
Version Info и все...

R3Pa4eK
Я тут подумал: чем подход ImageEn отличается от вашего предыдущего? Только одним: вы пытались рисовать прямо на чужом окне, а ImageEn создает свое в нужном месте, и рисует уже на нем. Вам нужно повторить этот фокус и тогда вы сможете сделать очень маленькую длл-ку, которая нормально рисует картинки. Пример: http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1411

Скажите, а есть ли функции для преобразования путей вида
Код: ..\..\_FlightsCommon\FS9\Addon Scenery\Alps 19m by Taburet

Совершенно потерялся в вопросе конвертации массива байтов (представляющих ascii-коды) в строку.

В этом коде

Код:
buff: array of Byte;
PCh: PChar;
s: String;
ldat, ld: Integer;
...
ldat := sizeof(nameitem.Len);
BglF.Read(buff, ldat);
nameitem.Len := DWORD(&buff);

ldat := nameitem.Len - sizeof(nameitem.Id) - sizeof(nameitem.Len);
ld := ldat - 1;
BglF.Read(buff, ldat);
Pch := PChar(@buff[Low(buff)]);
s := '';
SetString(s, PCh, ld);

DmitryKz, что-то вы тут на извращались
1) что такое BglF, это TFileStream?
2) где происходит инициализация buff ?
3) прочитать строчку можно без всяких таких танцев, тем более длина ее известна

Цитата:

Pch := PChar(@buff[Low(buff)]);
s := '';
SetString(s, PCh, ld);

my610
Вы совершенно правы, по поводу извращений. Решил прекратить с ними и нашёл естественное:

Код: String(PChar(@buff));

Многоуважаемые гуру, а есть ли стандартная функция, делающая ксор или ор для двордов наподобие?


Код: procedure SetExStyle(dwExStyle: DWORD; bexStyle: Boolean);
begin
if bexStyle then
dwRet := dwRet or dwExStyle
else
dwRet := dwRet xor dwExStyle;
end;

Здесь есть люди знающие DirectShow на Delphi?
Есть пару мелких вопросов. Отзовитесь в ПМ.
Спасибо.

Maks150988
что такое "стандартная"?

Maks150988
А вы проверяли результат побитовой операции с операндами типа двойное слово?
Можно, впрочем, через целочисельное деление и остаток деления смастерить ).

Имеется файл (png), который занят чужой программой. Мне нужно его удалить. Как это сделать программно?

R3Pa4eK
Попросите систему удалить его при перезагрузке: http://weseetips.com/2008/05/19/how-to-mark-your-file-for-deletion-after-next-reboot/

Frodo_Torbins
Мне это не подходит. В моем случае нужно узнать хэндл файла и закрыть его. Как узнать хэндл я знаю, а вот как закрыть хз.

R3Pa4eK
По-моему для этого нужно создавать поток в процессе, который держит хендл, и закрывать его из этого потока. Такие действия конечно могут вызвать подозрения у антивирей, да и обход системы безопасности винды тоже потребуется.
Вообще вы немного неверный топик выбрали для обсуждения таких вопросов.

Frodo_Torbins
А можно изменить права доступа к файлу? То-есть сделать так, чтобы его нельзя было скопировать.

R3Pa4eK
Цитата:

Мне это не подходит. В моем случае нужно узнать хэндл файла и закрыть его. Как узнать хэндл я знаю, а вот как закрыть хз.

DuplicateHandle с флагом DUPLICATE_CLOSE_SOURCE не?
я пологаю вы через ZwQuerySystemInformation хэндл получаете?

my610
Имеется такой код для получения хэндла:
[more=Код]
type
NT_STATUS = Cardinal;
PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;
SYSTEM_HANDLE_INFORMATION = packed record
ProcessId: DWORD;
ObjectTypeNumber: Byte;
Flags: Byte;
Handle: Word;
pObject: Pointer;
GrantedAccess: DWORD;
end;

PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX;
SYSTEM_HANDLE_INFORMATION_EX = packed record
NumberOfHandles: dword;
Information: array [0..0] of SYSTEM_HANDLE_INFORMATION;
end;

PFILE_NAME_INFORMATION = ^FILE_NAME_INFORMATION;
FILE_NAME_INFORMATION = packed record
FileNameLength: ULONG;
FileName: array [0..MAX_PATH - 1] of WideChar;
end;

PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
IO_STATUS_BLOCK = packed record
Status: NT_STATUS;
Information: DWORD;
end;

PGetFileNameThreadParam = ^TGetFileNameThreadParam;
TGetFileNameThreadParam = packed record
hFile: THandle;
Data: array [0..MAX_PATH - 1] of Char;
Status: NT_STATUS;
end;

function NtQuerySystemInformation(ASystemInformationClass: DWORD;
ASystemInformation: Pointer; ASystemInformationLength: DWORD;
AReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';

function NtQueryInformationFile(FileHandle: THandle;
IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;
Length: DWORD; FileInformationClass: DWORD): NT_STATUS;
stdcall; external 'ntdll.dll';

implementation





const
STATUS_SUCCESS = NT_STATUS($00000000);
STATUS_INFO_LENGTH_MISMATCH = NT_STATUS($C0000004);
FileNameInformation = 9;
SystemHandleInformation = 16;

function GetInfoTable(ATableType: DWORD): Pointer;
var
dwSize: DWORD;
pPtr: Pointer;
begin
dwSize := $10000;
pPtr:=nil;
repeat
inc(dwSize,dwSize);
ReallocMem(pPtr, dwSize);
until NtQuerySystemInformation(ATableType, pPtr, dwSize, nil)<>STATUS_INFO_LENGTH_MISMATCH;
Result := pPtr;
end;

function GetFileNameThread(lpParameters: Pointer): DWORD; stdcall;
var
FileNameInfo: FILE_NAME_INFORMATION;
IoStatusBlock: IO_STATUS_BLOCK;
pThreadParam: PGetFileNameThreadParam;
begin
ZeroMemory(@FileNameInfo, SizeOf(FILE_NAME_INFORMATION));
pThreadParam := PGetFileNameThreadParam(lpParameters);
Result := NtQueryInformationFile(pThreadParam^.hFile, @IoStatusBlock,
@FileNameInfo, MAX_PATH * 2, FileNameInformation);
if Result = STATUS_SUCCESS then
begin
pThreadParam^.Status := STATUS_SUCCESS;
WideCharToMultiByte(CP_ACP, 0,
@FileNameInfo.FileName[0], IoStatusBlock.Information,
@pThreadParam^.Data[0],
MAX_PATH, nil, nil);
end;
ExitThread(Result);
end;

function GetFileNameFromHandle(hFile: THandle): String;
var
lpExitCode: DWORD;
pThreadParam: TGetFileNameThreadParam;
hThread: THandle;
begin
Result := '';
ZeroMemory(@pThreadParam, SizeOf(TGetFileNameThreadParam));
pThreadParam.hFile := hFile;
hThread := CreateThread(nil, 0, @GetFileNameThread, @pThreadParam, 0, PDWORD(nil)^);
if hThread <> 0 then begin
case WaitForSingleObject(hThread, 100) of
WAIT_OBJECT_0:
begin
GetExitCodeThread(hThread, lpExitCode);
if lpExitCode = STATUS_SUCCESS then
Result := pThreadParam.Data;
end;
WAIT_TIMEOUT:
TerminateThread(hThread, 0);
end;
CloseHandle(hThread);
end;
end;

function GetFileHandle(SubFileName:string):THandle;
var
hFile: THandle;
pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
I: Integer;
ObjectTypeNumber1: Byte;
FilePath: String;
MyProcID:Cardinal;
begin
result:=0;
ObjectTypeNumber1 := 0;
hFile := CreateFile('NUL', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE then begin
pHandleInfo := GetInfoTable(SystemHandleInformation);
if pHandleInfo <> nil then begin;
MyProcID:=GetCurrentProcessId;
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 do
with pHandleInfo^.Information[I] do begin
if Handle = hFile then
if ProcessId = MyProcID then
begin
ObjectTypeNumber1 := ObjectTypeNumber;
Break;
end;
end;
CloseHandle(hFile);
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 do begin
with pHandleInfo^.Information[I] do begin
if ObjectTypeNumber = ObjectTypeNumber1 then begin
if ProcessId=MyProcID then begin
FilePath := GetFileNameFromHandle(Handle);
if (FilePath <> '') and (pos(SubFileName,FilePath)>0) then begin
result:=Handle;
break;
end;
end;
end;
end;
end;
end;
end;
end;
[/more]

Добавлено:
my610
Вот [more=так]
function UnLockFile(FileName: AnsiString): bool; stdcall;
var
fn, newfn: THandle;
_new: PHandle;
begin
fn:= GetFileHandle(FileName);
Result:= DuplicateHandle(fn, newfn,
GetCurrentProcess, 0,
0, true, DUPLICATE_CLOSE_SOURCE);
end;
[/more] не катит

R3Pa4eK, попробуйте примерно так:

Код:
............
if (FilePath <> '') and (pos(SubFileName,FilePath)>0) then begin
result:=Handle;
                
                 hProcess:= OpenProcess(PROCESS_DUP_HANDLE, True, pHandleInfo^.Information[I].ProcessId);
                 if (hProcess <> 0) then try

                    if DuplicateHandle(hProcess,
                                     pHandleInfo^.Information[I].Handle,
                                     GetCurrentProcess,
                                     @hFile,
                                     0,
                                     True,
                                     DUPLICATE_CLOSE_SOURCE) then
                    CloseHandle(hFile);
                finally
                    CloseHandle(hProcess);
                end;                
break;
end;

my610
Не работает..

R3Pa4eK, какая система, что за процесс с какими правами, и под какой учетной записью работает?
использую почти подобный код, под админом с WinXP до Win7 проблем не возникало, единственное в семерке есть некоторые тонкости, которые надо учитывать, ну и если процесс системный, то нужны привилегии отладчика получать

my610
Win7, файл изображения (png), который используется библиотекой под названием botva2.dll. Работаю под учеткой админа. [more=Вот]
library BSp2ll;

uses
Windows, AclAPI, AccCtrl, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
NT_STATUS = Cardinal;
PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;
SYSTEM_HANDLE_INFORMATION = packed record
ProcessId: DWORD;
ObjectTypeNumber: Byte;
Flags: Byte;
Handle: Word;
pObject: Pointer;
GrantedAccess: DWORD;
end;

PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX;
SYSTEM_HANDLE_INFORMATION_EX = packed record
NumberOfHandles: dword;
Information: array [0..0] of SYSTEM_HANDLE_INFORMATION;
end;

PFILE_NAME_INFORMATION = ^FILE_NAME_INFORMATION;
FILE_NAME_INFORMATION = packed record
FileNameLength: ULONG;
FileName: array [0..MAX_PATH - 1] of WideChar;
end;

PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
IO_STATUS_BLOCK = packed record
Status: NT_STATUS;
Information: DWORD;
end;

PGetFileNameThreadParam = ^TGetFileNameThreadParam;
TGetFileNameThreadParam = packed record
hFile: THandle;
Data: array [0..MAX_PATH - 1] of Char;
Status: NT_STATUS;
end;


function NtQuerySystemInformation(ASystemInformationClass: DWORD;
ASystemInformation: Pointer; ASystemInformationLength: DWORD;
AReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';

function NtQueryInformationFile(FileHandle: THandle;
IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;
Length: DWORD; FileInformationClass: DWORD): NT_STATUS;
stdcall; external 'ntdll.dll';

const
STATUS_SUCCESS = NT_STATUS($00000000);
STATUS_INVALID_INFO_CLASS = NT_STATUS($C0000003);
STATUS_INFO_LENGTH_MISMATCH = NT_STATUS($C0000004);
STATUS_INVALID_DEVICE_REQUEST = NT_STATUS($C0000010);
ObjectNameInformation = 1;
FileDirectoryInformation = 1;
FileNameInformation = 9;
SystemProcessesAndThreadsInformation = 5;
SystemHandleInformation = 16;


type
TFree = procedure;

var
DLLHandle: THandle;
Free: TFree;

procedure LibSetFileAttribs(FileName: pchar); stdcall;
begin
SetFileSecurity(PChar(FileName), SACL_SECURITY_INFORMATION, nil);
SetFileAttributes(PChar(FileName), fmOpenRead+fmShareExclusive+$00004000+$00002000+$00001000+$00000100+$00000020+$00000010+$00000800+$00000400+$00000200+$0000004+FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
end;

procedure LibSetDirAttribs(DirName: PChar); stdcall;
begin
SetFileSecurity(PChar(DirName), SACL_SECURITY_INFORMATION, nil);
SetFileAttributes(PChar(DirName), fmShareExclusive+$00004000+$00002000+$00001000+$00000020+$00000010+$00000800+$00000400+$00000200+$0000004+FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
end;

procedure RemoveFileTree(Path: AnsiString); stdcall;
var
Found: currency;
SearchRec: TSearchRec;
FileName: ansistring;
begin
Found:= FindFirst(Path + '\*.*', faAnyFile, SearchRec);
while Found = 0 do
begin
if ((SearchRec.Attr and faDirectory) = faDirectory)
then
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..')
then RemoveFileTree(Path+'\'+SearchRec.Name)
else
else
begin
FileName:= Path+'\'+SearchRec.Name+#0;
DeleteFile(PChar(FileName));
end;
Found:= FindNext(SearchRec);
end;
SysUtils.FindClose(SearchRec);
RemoveDir(Path);
end;

function GetInfoTable(ATableType: DWORD): Pointer;
var
dwSize: DWORD;
pPtr: Pointer;
begin
dwSize := $10000;
pPtr:=nil;
repeat
inc(dwSize,dwSize);
ReallocMem(pPtr, dwSize);
until NtQuerySystemInformation(ATableType, pPtr, dwSize, nil)<>STATUS_INFO_LENGTH_MISMATCH;
Result := pPtr;
end;

function GetFileNameThread(lpParameters: Pointer): DWORD; stdcall;
var
FileNameInfo: FILE_NAME_INFORMATION;
IoStatusBlock: IO_STATUS_BLOCK;
pThreadParam: PGetFileNameThreadParam;
begin
ZeroMemory(@FileNameInfo, SizeOf(FILE_NAME_INFORMATION));
pThreadParam := PGetFileNameThreadParam(lpParameters);
Result := NtQueryInformationFile(pThreadParam^.hFile, @IoStatusBlock,
@FileNameInfo, MAX_PATH * 2, FileNameInformation);
if Result = STATUS_SUCCESS then
begin
pThreadParam^.Status := STATUS_SUCCESS;
WideCharToMultiByte(CP_ACP, 0,
@FileNameInfo.FileName[0], IoStatusBlock.Information,
@pThreadParam^.Data[0],
MAX_PATH, nil, nil);
end;
ExitThread(Result);
end;

function GetFileNameFromHandle(hFile: THandle): String;
var
lpExitCode: DWORD;
pThreadParam: TGetFileNameThreadParam;
hThread: THandle;
begin
Result := '';
ZeroMemory(@pThreadParam, SizeOf(TGetFileNameThreadParam));
pThreadParam.hFile := hFile;
hThread := CreateThread(nil, 0, @GetFileNameThread, @pThreadParam, 0, PDWORD(nil)^);
if hThread <> 0 then begin
case WaitForSingleObject(hThread, 100) of
WAIT_OBJECT_0:
begin
GetExitCodeThread(hThread, lpExitCode);
if lpExitCode = STATUS_SUCCESS then
Result := pThreadParam.Data;
end;
WAIT_TIMEOUT:
TerminateThread(hThread, 0);
end;
CloseHandle(hThread);
end;
end;

function GetFileHandle(SubFileName: ansistring):THandle; stdcall;
var
hFile: THandle;
pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
I: Integer;
ObjectTypeNumber1: Byte;
FilePath: AnsiString;
MyProcID: Cardinal;
hProcess: DWORD;
begin
result:=0;
ObjectTypeNumber1 := 0;
hFile := CreateFile('NUL', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE then begin
pHandleInfo := GetInfoTable(SystemHandleInformation);
if pHandleInfo <> nil then begin;
MyProcID:=GetCurrentProcessId;
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 do
with pHandleInfo^.Information[I] do begin
if Handle = hFile then
if ProcessId = MyProcID then
begin
ObjectTypeNumber1 := ObjectTypeNumber;
Break;
end;
end;
CloseHandle(hFile);
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 do begin
with pHandleInfo^.Information[I] do begin
if ObjectTypeNumber = ObjectTypeNumber1 then begin
if ProcessId=MyProcID then begin
FilePath := GetFileNameFromHandle(Handle);
if (FilePath <> '') and (pos(SubFileName,FilePath)>0) then begin
result:=Handle;

hProcess:= OpenProcess(PROCESS_DUP_HANDLE, True, pHandleInfo^.Information[I].ProcessId);
if (hProcess <> 0) then try

if DuplicateHandle(hProcess,
pHandleInfo^.Information[I].Handle,
GetCurrentProcess,
@hFile,
0,
True,
DUPLICATE_CLOSE_SOURCE) then
CloseHandle(hFile);
finally
CloseHandle(hProcess);
end;
break;
end;
end;
end;
end;
end;
end;
end;
end;

procedure LibGdipShutdown(DirName: AnsiString); stdcall;
begin
try
DLLHandle := LoadLibrary ('botva2.dll');

if DLLHandle <> 0 then
begin
@Free := getProcAddress (DLLHandle, 'gdipShutdown');
end;
if addr (Free) <> nil then
begin
Free;
end;
finally end;
FreeLibrary (DLLHandle);
RemoveFileTree(DirName);
end;

exports LibSetFileAttribs;
exports GetFileHandle;
exports LibGdipShutdown;
exports LibSetDirAttribs;
exports RemoveFileTree;

begin
end.
[/more] весь код dll.

R3Pa4eK
А Process Explorer в колонке Integrity для вашего процесса что показывает?

Frodo_Torbins
Вы это о чем?

R3Pa4eK, погодите что то я не понял, вы загружаете дилку botva2.dll в своей программе?

my610
Да.

R3Pa4eK, тогда следующие вопросы:
- дилка ваша
- как происходит загрузка либы
- если дилка ваша, то корректно ли высвобождаются ресурсы и закрываются дескрипторы в ней

my610

Цитата:

дилка ваша

botva2.dll - нет. Либа хтуоса.

Цитата:

- как происходит загрузка либы

Статически.

Помогите -такая задача есть ветка в реестре
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4D36E972-E325-11CE-BFC1-08002bE10318}

В ней много подключей,(0001, 0002, 0003 и т.д) но в одном из них есть строковый параметр NetworkAddress с значением 001635A790B9

Как его найти?