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

RuPurple

Цитата:

А где можно найти информацию про WM_HSCROLL, WM_VSCROLL, SB_LINEDOWN, SB_LINEUP ?

_http://msdn.microsoft.com/ru-ru/

Цитата:

в обработчике FormShow

я делал для того, что если картинка больше размера ScrollBox- показались полосы прокрутки при условии что image.autosize :=true

Господа подскажите, можно ли написать такую функцию, которая берет массив и обрабатывает его независимо от того какого он типа (real или integer)?

DokPZ

Цитата:

можно ли написать такую функцию

Можно. (array of const) и TypeInfo в помощь.
А с generics (Delphi 2009 и выше) функция элементарна.

Подскажите...создаю файл:
AssignFile(F, Extractfilepath(application.exename)+'name.log');

Как создать файл с именем равным текущей дате?

GRom V
А всправке что то типа DateToStr посмотреть слабо?

V1s1ter

Цитата:

А всправке что то типа DateToStr посмотреть слабо?

У меня в семерке справка чет не открывается...по этому и спросил...




Добавлено:
Но все разобрался уже
AssignFile(F, Extractfilepath(application.exename)+(DateToStr(Date)+'.log'));

GRom V

Цитата:

У меня в семерке справка чет не открывается...по этому и спросил...

У гугля спроси, там надо вначале апдейт поставить, чтобы хлпшники открывались, а потом если будет ругаться на индекс, то еще один апдейт. Просто текст ошибки в поиск и все потом открывается нормально.

GRom V
В дополнение к ShIvADeSt, могу chm справку кинуть, она мне чего больше нравится.

Как сохранить в BLOB поле (MySQL через BDE) форматированный текст из RichEdit'а. В частности используя TQuery. На каком-то ресурсе что-то такое было (больше не смог его отыскать, как ни старался), там сначала потоком данные из RichEdit сохранялись в параметр запроса, т.е. Query.Params... и потом уже осуществлялась подстановка. Пытался методом проб и ошибок сделать подобное, ничего не получилось.
Ну вот например
Сразу скажу, что в низу ересь наиочевиднейшая, но от безысходности уже даже не знаешь что писать:


Код: Query2.SQL.Add('insert into lab_work ');
Query2.SQL.Add('set work = :w_stream');
Query2.Prepare;
Query2.Params.AddParam(Query2.Params.CreateParam(ftBlob, 'w_stream', ptInput));
Stream:=TStringStream.Create(Query2.ParamByName('work_stream').AsBlob);
EditW.RichEdit.Lines.SaveToStream(Stream);
Stream.Free;
Query2.Open;

Может у кого есть пример как передать параметры из Dll в exe через PostMessage, зная Thandle exe? Ну и как их там обработать. Спасибо.

По идеи это несколько разные вещи: PostMessage идёт через хенды окон (форм), через хенд процесса сообщение не передать. Поэтому я не уверен, что такой пример найдёться.

Попробуйте другой способ, к примеру:
Они в одном процессе:
- Вызывать из exe функцию dll и передавать ей хенд окна с обработчиком. Эта функция запишет в глобальную переменную этот хенд и ваша dll будет её использовать
- Сделайте CallBack (Функцию обратного вызова)
Они в разных процессах:
- Искать из библиотеки окно (форму) по тексту заголовка через FindWindow
- Использовать другие средства передачи данных и синхронизации: использовать спроэцированные в память файлы и именнованные события

Molniev

Цитата:

По идеи это несколько разные вещи: PostMessage идёт через хенды окон (форм), через хенд процесса сообщение не передать.

Если у процесса одно окно, то можно перебрать все окна, получить для каждого айдишник процесса, сравнить с нашим хэндлом, послать PostMessage. Но есть способ лучше Регаем собственный тип сообщения. Делаем бродкаст с нашим сообщением, оно гарантированно прилетит тому кто его ловит.

Всем привет. Мне нужно распарсить m3u плейлист. Сделано в цикле.

[more=Тыдыдых!!!]


Код:

function GetPlayListM3U(pszPath: WideString): TPLSItems;
const
EXTM3U: WideString = '#EXTM3U';
EXTINF: WideString = '#EXTINF:';
IsUTF8: Array [Boolean] of Integer = (CP_ACP, CP_UTF8);
var
hf : HFILE;
dwRet : DWORD;
hGlob : HGLOBAL;
pData : Pointer;
dwBytesRead: DWORD;
bRet : Boolean;
pszUTF8 : AnsiString;
pszWork : WideString;
pszText : WideString;
idPos : Integer;
idItem : Integer;
idDot : Integer;
begin

SetLength(Result, 0);

hf := CreateFileW(LPWSTR(pszPath), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if (hf <> INVALID_HANDLE_VALUE) then
try

dwRet := GetFileSize(hf, nil);

if (dwRet <> 0) then
begin

hGlob := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, dwRet);
if (hGlob <> 0) then
try

pData := GlobalLock(hGlob);
if (pData <> nil) then
try

bRet := ReadFile(hf, pData^, dwRet - 1, dwBytesRead, nil);
if bRet then
begin

pszUTF8 := LPTSTR(pData);
bRet := (pszUTF8[1] = #$EF) and (pszUTF8[2] = #$BB) and (pszUTF8[3] = #$BF);
if bRet then
Delete(pszUTF8, 1, 3);

dwRet := MultiByteToWideChar(IsUTF8[bRet], 0, LPTSTR(pszUTF8),
Length(pszUTF8), nil, 0);
SetLength(pszWork, dwRet);
MultiByteToWideChar(IsUTF8[bRet], 0, LPTSTR(pszUTF8), Length(pszUTF8),
LPWSTR(pszWork), dwRet);

idItem := 0;
pszWork := #10 + pszWork + #10;
while (lstrlenW(LPWSTR(pszWork)) > 0) do
begin

idPos := Pos(#10, pszWork);
if (idPos > 1) then
begin

pszText := TrimW(Copy(pszWork, 1, idPos - 1));

dwRet := lstrcmpiW(LPWSTR(EXTM3U), LPWSTR(pszText));
if (dwRet <> 0) then
begin

Inc(idItem);
SetLength(Result, idItem);

dwRet := Pos(EXTINF, pszText);
if (dwRet <> 0) then
begin
IdDot := Pos(',', pszText);
Result[idItem].pszText := Copy(pszText, IdDot + 1, MaxInt);
end
else
if (dwRet = 0) then
Result[idItem].pszTextEx := pszText;

MessageBoxW(0, LPWSTR( 'Item='+'~' + IntToStrW(idItem)+'~' + Result[idItem].pszText + Result[idItem].pszTextEx), nil, MB_OK);

end;

end;
Delete(pszWork, 1, idPos);

end;

end;

finally
GlobalUnlock(HGLOBAL(pData));
end;

finally
GlobalFree(hGlob);
end;

end;

finally
CloseHandle(hf);
end;

end;

Может потому что dwRet = 0?
Брейкпойнты на верхние строки и смотри, что куда записалось.

ShIvADeSt
Вопрос снят. Сделал так. Через Pos немного удобнее, благо нативно, да и без приведения к LPWSTR/LPTSTR обходится вслучае lstrcmp.
[more=Далее]



unit PlayList;

interface

uses
Windows, F_SysUtils;

type
TPLSItem = packed record
pszTitle: WideString;
pszURL : WideString;
end;
TPLSType = (ptUnknown, ptM3U, ptM3U8, ptPLS);
TPLSSave = (psM3U, psM3U8, psPLS);
TPLSItems = Array of TPLSItem;

function GetPlayListType(pszPath: WideString): TPLSType;
function GetPlayListM3U(pszPath: WideString): TPLSItems;

implementation

type
TDynArray = Array of WideString;

//

function GetPlayListType(pszPath: WideString): TPLSType;
var
pszText: WideString;
begin

pszText := ExtractFileExtW(pszPath);
CharLowerBuffW(LPWSTR(pszText), Length(pszText));

if (Pos('.m3u', pszText) > 0) then
Result := ptM3U
else
if (Pos('.m3u8', pszText) > 0) then
Result := ptM3U8
else
if (Pos('.pls', pszText) > 0) then
Result := ptPLS
else
Result := ptUnknown;

end;

//

function GetPlayListData(pszPath: WideString): TDynArray;
const
IsUTF8: Array [Boolean] of Integer = (CP_ACP, CP_UTF8);
var
hf : HFILE;
dwRet : DWORD;
hGlob : HGLOBAL;
pData : Pointer;
dwBytesRead: DWORD;
bRet : Boolean;
pszAnsi : AnsiString;
pszText : WideString;
iPosEof : Integer;
begin

SetLength(Result, 0);

hf := CreateFileW(LPWSTR(pszPath), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if (hf <> INVALID_HANDLE_VALUE) then
try

dwRet := GetFileSize(hf, nil);
if (dwRet <> 0) then
begin

hGlob := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, dwRet);
if (hGlob <> 0) then
try

pData := GlobalLock(hGlob);
if (pData <> nil) then
try

bRet := ReadFile(hf, pData^, dwRet - 1, dwBytesRead, nil);
if bRet then
begin

pszAnsi := LPTSTR(pData);
bRet := (pszAnsi[1] = #$EF) and (pszAnsi[2] = #$BB) and
(pszAnsi[3] = #$BF);
if bRet then
Delete(pszAnsi, 1, 3);

dwRet := MultiByteToWideChar(IsUTF8[bRet], 0, LPTSTR(pszAnsi),
Length(pszAnsi), nil, 0);
SetLength(pszText, dwRet);
MultiByteToWideChar(IsUTF8[bRet], 0, LPTSTR(pszAnsi),
Length(pszAnsi), LPWSTR(pszText), dwRet);

pszText := #10 + pszText + #10;
while (Length(pszText) > 0) do
begin

iPosEof := Pos(#10, pszText);
bRet := (iPosEof > 1) and (Length(pszText) > 0);
if bRet then
begin

SetLength(Result, Length(Result) + 1);
Result[High(Result)] := Copy(pszText, 1, iPosEof - 1);

end;
Delete(pszText, 1, iPosEof);

end;

end;

finally
GlobalUnlock(HGLOBAL(pData));
end;

finally
GlobalFree(hGlob);
end;

end;

finally
CloseHandle(hf);
end;

end;

//

function GetPlayListM3U(pszPath: WideString): TPLSItems;
const
EXTM3U: WideString = '#EXTM3U';
EXTINF: WideString = '#EXTINF:';
var
OutPls: TDynArray;
idItem: Integer;
iPosEx: Integer;
begin

SetLength(Result, 0);

OutPls := GetPlayListData(pszPath);
if (Length(OutPls) > 0) then
begin

for idItem := Low(OutPls) to High(OutPls) do
begin

iPosEx := Pos(EXTM3U, OutPls[idItem]);
if (iPosEx <> 1) then
begin

iPosEx := Pos(EXTINF, OutPls[idItem]);
if (iPosEx = 1) then
begin

SetLength(Result, Length(Result) + 1);
iPosEx := Pos(#44, OutPls[idItem]);
Result[High(Result)].pszTitle := TrimW(Copy(OutPls[idItem],
iPosEx + 1, Length(OutPls[idItem]) - iPosEx - 1));

end
else
begin

Result[High(Result)].pszURL := TrimW(OutPls[idItem]);

end;

end;

end;

end;

end;

end.



[/more]

Если у кого-то есть какие-то замечания к коду - прошу комментарии, хочется удостовериться что код лишен неожиданных изъянов.

Кто знает в RichEdit'е есть какой-либо указатель на текущую строку или позицию? Не могу избавиться от следующей проблемы:

Если залить в компонент сначала форматированный текст последние строки которого будут иметь какое-то стилевое оформление (будь то выравнивание или подчеркивание с курсивом), то потом это же оформление распространяется на последующий текст (т.е. если потом еще добавить текст в RichEdit то к нему применится это самое оформление).

Подскажите как этого избежать? Спасибо.

Сохранять свойство Font компонента RichEdit. Сохранили в другую переменную, "залить", приравняли свойство Font сохраненной переменной. Вот и все вроде.

Цитата:

Сохранять свойство Font компонента RichEdit. Сохранили в другую переменную, "залить", приравняли свойство Font сохраненной переменной. Вот и все вроде.

Проблема в том, что я не могу никак найти где в RichEdit'е есть свойство или метод с помощью которого определятся положение указателя на место, с которым будут производиться следующие действия. Я имею ввиду как сказать проге делать какие-то определенные манипуляции с текстом именно (к примеру) в 25 строке от начала документа.

Цитата:

Я имею ввиду как сказать проге делать какие-то определенные манипуляции с текстом именно (к примеру) в 25 строке от начала документа.

Если мне не изменяет память, то у рич едита есть возможность перейти к любой строке и символу в тексте. То есть встаешь у начала нужного текста, потом выделяешь сколько надо символов (SelLength вроде бы) и потом уже к выделению применяешь стили текста.

KorolCOOL

Цитата:

Я имею ввиду как сказать проге делать какие-то определенные манипуляции с текстом именно (к примеру) в 25 строке от начала документа.

вроде так
[more]
Код: [no]
with ARichEdit do
begin
SelStart := SendMessage(Handle, EM_LINEINDEX, ARow - 1, 0);
SelLength := Length(Lines[ARow - 1]);
SelAttributes.Color := ...;
SelLength := 0;
end;
[/no]

[more]

Код:
function cof(f1,f2:pansichar):real;
var
h: THandle;
data,data2: array of char;
len: Cardinal;
dummy,dummy1,min,n: Cardinal;
i: Integer;
begin
h:=CreateFile(f1, GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
len:=GetFileSize(h, nil);
SetLength(data, len);
ReadFile(h, data[0], len, dummy, nil);
CloseHandle(h);
{--------------------------}
h:=CreateFile(f2, GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
len:=GetFileSize(h, nil);
SetLength(data2, len);
ReadFile(h, data2[0], len, dummy1, nil);
CloseHandle(h);
{--------------------------}
n:=0;
if dummy<dummy1 then min:=dummy else min:=dummy1;
for i:=28 to min-1 do
if data[i]=data2[i] then inc(n);
{--------------------------}
cof:=n;

end;




procedure TForm1.Button1Click(Sender: TObject);
type
tAlf=array[1..3] of char;
const
d=3;
alf:tAlf=('a','&#225;','&#226;');
all:tAlf=('a','b','v');
var
s:string;
i,j:integer;
res:array[1..3] of real;
max:real;
a,b:pansichar;

begin
// cof start --------------------------
opendialog1.Execute;
{&#207;&#240;&#229;&#238;&#225;&#240;&#224;&#231;&#238;&#226;&#224;&#237;&#232;&#229; &#226; PAnsiChar}
s:=opendialog1.FileName;
for i:=1 to length(s) do
a:=addr(s[i]);
{=}


for i:=1 to d do begin
{&#207;&#240;&#229;&#238;&#225;&#240;&#224;&#231;&#238;&#226;&#224;&#237;&#232;&#229; &#226; PAnsiChar}
b:='';
s:='db/'+all[i]+'.wav';
for j:=1 to length(s) do
b:=addr(s[i]);
{= 'db/'+all[i]+'.wav'}
res[i]:=cof(b,a);{тут ошибка range check error}
//cof end -----------------------------

max:=res[1];
for j:=1 to d do
if res[j]>max then max:=res[i];

for j:=1 to d do
if res[j]=max then break;

edit1.Text:=alf[j];
end;
end;
end.

andrey777k

Цитата:

Все большие куски кода (более 5 строк) оформляем в тег [morе] дабы уменьшить размер поста.

ошибка не "тут", а в функции cof
надо проверять результат CreateFile и GetFileSize, может они завершены с ошибкой и скорее всего ошибка в SetLength(data{2}, len); из-за неправильного размера

Всем привет! Вот решил написать библиотеку для вставки .png изображения. Использую pngimage .

[more=Код библиотеки]
library ISLogoDraw;

uses
Windows, pngimage;

var
png: TPNGObject;

procedure logo_repaint(Handle:HWND; logo: string; Left, Top, Width, Height: Integer); stdcall;
begin
png := TPNGObject.Create;
with png do begin
//Parent:= Handle;
LoadFromFile(logo);
//Width := 12;
//Height := 12;
end
end;

procedure logo_free(); stdcall;
begin
png.Free;
end;

exports logo_repaint;
exports logo_free;

begin
end.
[/more]

Но на тех строчках (которые закомментированные) выбивает ошибку. Не могу понять, что я делаю не так.

И еще:
У меня Делфи вообще ничего не понимает OnClick, Left, Height он не знает. В var пишу lebel: TLabel; он ошибку выбивает. Что это такое?
И как добавить Version Info в библиотеку?

R3Pa4eK
Ну, если я правильно понял, то: Project - Options - VersionInfo.
Также вот процедура, возвращает строку с версией твоей проги:
[more]
function FileVersion(AFileName: string): string;
var
szName: array[0..255] of Char;
P: Pointer;
Value: Pointer;
Len: UINT;
GetTranslationString: string;
FFileName: PChar;
FValid: boolean;
FSize: DWORD;
FHandle: DWORD;
FBuffer: PChar;
begin
try
FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
FValid := False;
FSize := GetFileVersionInfoSize(FFileName, FHandle);
if FSize > 0 then
try
GetMem(FBuffer, FSize);
FValid := GetFileVersionInfo(FFileName, FHandle, FSize, FBuffer);
except
FValid := False;
raise;
end;
Result := '';
if FValid then
VerQueryValue(FBuffer, '\VarFileInfo\Translation', p, Len)
else
p := nil;
if P <> nil then
GetTranslationString := IntToHex(MakeLong(HiWord(Longint(P^)),
LoWord(Longint(P^))), 8);
if FValid then
begin
StrPCopy(szName, '\StringFileInfo\' + GetTranslationString +
'\FileVersion');
if VerQueryValue(FBuffer, szName, Value, Len) then
Result := StrPas(PChar(Value));
end;
finally
try
if FBuffer <> nil then
FreeMem(FBuffer, FSize);
except
end;
try
StrDispose(FFileName);
except
end;
end;
end;
[/more]

Люди!!! Уже всю голову сломал! В делфи играю совсем недавно, поэтому прошу не пинать!
Помогите плизЗ!
На форму кинул два таймера, в приведенном ниже коде, проблема с Form1.BTimer2.enabled:=true
Он зараза не врубается
главное
Form1.BTimer1.enabled:=true; работает, а верхний ниФиГа!!!
Вроде все правильно, а не пашет!!! Что не так???
И еще прикол - если я кидаю на форму третий таймер, и вгоняю его вместо Form1.BTimer2, но не удаляю Form1.BTimer2, то третий работает!??

Создал поток:
TNewThread1 = class(TThread)
private
{ Private declarations }
procedure checkproc;
protected
procedure Execute;
override;
end;

{$R *.dfm}
{TNewThread}

procedure TNewThread1.Execute;
begin while true do begin
synchronize(checkproc);
sleep(1000);
end;
end;

procedure TNewThread1.checkproc;
begin
if EXE_Running('notepad.exe', False) then
Form1.BTimer2.enabled:=true
else
Form1.BTimer2.enabled:=false;

if EXE_Running('wordpad.exe', False) then begin
Form1.BTimer1.enabled:=true;

procedure TForm1.FormCreate(Sender: TObject);
begin
NewThread1:=TNewThread1.Create(true);
NewThread1.FreeOnTerminate:=true;
NewThread1.Priority:=tpLower;
NewThread1.Resume;

GRom V
Единственное что приходит в голову, так это то что EXE_Running постоянно возвращает False. Другие ошибки по такому небольшому количеству кода не определить.

Цитата:

EXE_Running постоянно возвращает False.

нет!!!
Если вместо таймера пишу showmessage('test'); - сообщение вылазит, следовательно с
EXE_Running проблем нет!
А вот таймер не врубается!

Имеется 5 dll'ок . Таскать их за собой не удобно, по-этому хочу спросить, как можно все эти dll'ки запихнуть в одну, и вызывать их функции через нее?

GRom V
Выложи весь тестовый проект, я посмотрю.

Как можно запустить файл и ожидать его завершения, но чтобы программа была активной?
Вот моя наработка:
[more]
library InnoExec;

uses
Windows, SysUtils;

var
_QUIT: Boolean;

{$R *.res}

const
MAX_PATH = 260;
TH32CS_SNAPPROCESS = $00000002;
INVALID_HANDLE_VALUE = -1;
PROCESS_TERMINATE = $0001;
_PM_REMOVE = 1;
STARTF_USESHOWWINDOW = 1;
NORMAL_PRIORITY_CLASS = $00000020;

type
TProcessEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ProcessID: DWORD;
th32DefaultHeapID: DWORD;
th32ModuleID: DWORD;
cntThreads: DWORD;
th32ParentProcessID: DWORD;
pcPriClassBase: Longint;
dwFlags: DWORD;
szExeFile: array[0..MAX_PATH] of Char;
end;

_TMsg = record
hWnd: HWND;
msg: Word;
wParam: Word;
lParam: LongWord;
Time: TFileTime;
pt: TPoint;
end;

TProcessInformation = record
hProcess: THandle;
hThread: THandle;
dwProcessId: DWORD;
dwThreadId: DWORD;
end;

TStartupInfo = record
cb: DWORD;
lpReserved: Longint;
lpDesktop: Longint;
lpTitle: PChar;
dwX: DWORD;
dwY: DWORD;
dwXSize: DWORD;
dwYSize: DWORD;
dwXCountChars: DWORD;
dwYCountChars: DWORD;
dwFillAttribute: DWORD;
dwFlags: DWORD;
wShowWindow: Word;
cbReserved2: Word;
lpReserved2: Byte;
hStdInput: THandle;
hStdOutput: THandle;
hStdError: THandle;
end;

function _CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle;
external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';
function _Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;
external 'Process32First@kernel32.dll stdcall';
function _Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;
external 'Process32Next@kernel32.dll stdcall';
function _OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle;
external 'OpenProcess@kernel32.dll stdcall';
function _TerminateProcess(hProcess: THandle; uExitCode: UINT): BOOL;
external 'TerminateProcess@kernel32.dll stdcall';
function _CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function _PeekMessage(var lpMsg: _TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax,
wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function _TranslateMessage(const lpMsg: _TMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function _DispatchMessage(const lpMsg: _TMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';
function _CreateProcess(lpApplicationName: PChar; lpCommandLine: PChar; lpProcessAttributes, lpThreadAttributes: DWORD;
bInheritHandles: BOOL; dwCreationFlags: DWORD;
lpEnvironment: PChar; lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL;
external 'CreateProcessA@kernel32.dll stdcall';
/////////////////////////////////////////////////////////////////

procedure _Application_ProcessMessages;
var
Msg: _TMsg;
begin
if not _PeekMessage(Msg, 0, 0, 0, _PM_REMOVE) then
Exit;
_TranslateMessage(Msg);
_DispatchMessage(Msg);
end;

function _KillProcess(ProcessID: DWORD): Boolean;
var
hProcess: THandle;
begin
hProcess:= _OpenProcess(PROCESS_TERMINATE, False, ProcessID);
Result:= _TerminateProcess(hProcess, 0);
_CloseHandle(hProcess);
end;

function _ArrayCharToString(ArrayChar: array of Char): string;
var
i: Integer;
str: string;
begin
for i:= 0 to MAX_PATH do
if (ArrayChar[i]) <> #0 then
str:= str + ArrayChar[i]
else Break;
Result:= str;
end;

function _ProcIsRunning(Process: string; ProcessID: DWORD): Boolean;
var
Snap: THandle;
pe32: TProcessEntry32;
begin
Result:= False;
if Pos('\', Process) > 0 then Process:= ExtractFileName(Process);
Snap:= _CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snap = INVALID_HANDLE_VALUE then Exit;
pe32.dwSize:= SizeOf(pe32);
if _Process32First(Snap, pe32) then
while _Process32Next(Snap, pe32) do
begin
if pe32.th32ProcessID = ProcessID then
if (LowerCase(_ArrayCharToString(pe32.szExeFile)) = LowerCase(Process)) then
begin
Result:= True;
Break;
end;
if _QUIT then Break;
_Application_ProcessMessages;
end;
_CloseHandle(Snap);
end;

function _StartProc(const Filename, Params, WorkingDir: string; const ShowCmd: Word;
TerminateChild: Boolean): Boolean;
var
PI: TProcessInformation;
SI: TStartupInfo;
ProcessId: DWORD;
ProcessName: string;
CmdLine: string;
begin
_QUIT:= False;
CmdLine:= '"' + Filename + '" ' + Params;
SI.cb:= SizeOf(SI);
SI.dwFlags:= STARTF_USESHOWWINDOW;
SI.wShowWindow:= ShowCmd;
try
Result:= _CreateProcess('', PChar(CmdLine), 0, 0, False, NORMAL_PRIORITY_CLASS,
'', PChar(WorkingDir), SI, PI);
except
end;
if Result then
begin
ProcessName:= ExtractFileName(Filename);
ProcessId:= PI.dwProcessId;
_CloseHandle(PI.hProcess);
_CloseHandle(PI.hThread);
while _ProcIsRunning(ProcessName, ProcessID) do;
if _QUIT and TerminateChild then _KillProcess(ProcessID);
end;
end;

function CreateProgressInInnoSetup(const Filename, Params, WorkingDir: string;
const ShowCmd: Word; TerminateChild: Boolean): Boolean;
begin
Result:= _StartProc(Filename, Params, WorkingDir, ShowCmd, TerminateChild);
end;

Только при загрузке dll'ки выбивает ошибку. Что тут не так?
exports CreateProgressInInnoSetup;

begin
end.
[/more]

Только при загрузке dll'ки выбивает ошибку. Что тут не так?