handle := WinExec(…);
if handle >= 32 then
while GetModuleUsage(handle) > 0 do Delay(nn);
else raise …
(AM): Чтобы выяснить, работает ли программа, используйте GetProcessTimes(), параметр lpExitTime.
(Win32) Для принудительного завершения процесса — TerminateProcess.
(Win16) (RR): Надо послать программе сообщение WM_QUIT:
Handle := Winexec(App, 0);
PostMessage(Handle, WM_QUIT, 0, 0);
Открытие выбранного файла в работающем приложении
Пангин Дмитрий Викторович прислал письмо следующего содержания:
При программировании MDI-приложений возникает следующая задача: Если пользователь кликнул на файле, тип которого поддерживается создаваемым приложением, то, если приложение уже запущено, не нужно запускать новую копию приложения, а нужно открыть выбранный файл в уже работающем приложении. Я сделал это так (возможно есть более красивое решение):
\ В файле проекта:
var
i: integer;
hMainForm:hwnd;
copyDataStruct:TCopyDataStruct;
ParamString:string;
WParam,LParam:integer;
begin
\ ищем главное окно приложения, вместо Caption - nil,
\ поскольку к заголовку главного окна может добавиться заголовок MDIChild
\ (нужно позаботиться об уникальности имени класса главной формы)
hMainForm:= FindWindow('TMainForm', nil);
if hMainForm = 0 then begin
Application.Initialize;
Application.CreateForm(TFrmMain, frmMain);
for i:=1 to ParamCount do TMainForm(Application.MainForm).OpenFile(ParamStr(i));
Application.Run;
end
else begin
ParamString:='';
for i:=1 to ParamCount do begin
\ запихиваем все параметры в одну строку с разделителями ?13
ParamString:=ParamString+ParamStr(i)+ #13;
end;
\ создаем запись типа TCopyDataStruct
CopyDataStruct.lpData:=PChar(ParamString);
CopyDataStruct.cbData:=Length(ParamString);
CopyDataStruct.dwData:=0;
WParam:=Application.Handle;
LParam:=Integer(@CopyDataStruct);
\ отсылаем сообщение WM_COPYDATA главному окну открытого приложения
SendMessage(hMainForm,WM_CopyData,WParam,LParam);
Application.Terminate;
end;
end.
\ Обработчик сообщения WM_COPYDATA
procedure TMainForm.CopyData(var Msg: TWMCopyData);
var
ParamStr:string;
CopyDataStructure:TCopyDataStruct;
i:integer;
len:integer;
begin
CopyDataStructure:= Msg.CopyDataStruct^;
ParamStr:='';
len:= CopyDataStructure.cbData;
for i:=0 to len-1 do begin
ParamStr:=ParamStr+(PChar(CopyDataStructure.lpData)+i)^;
end;
i:=0;
while not(Length(ParamStr)=0) do begin
if isDelimiter(#13,ParamStr,i) then begin
OpenFile(Copy(ParamStr,0,i-1));
ParamStr:=Copy(ParamStr,i+1,Length(ParamStr)-i-1);
end;
inc(i);
end;
inherited;
end;
Убиваем активное приложение
The_Sprite прислал письмо следующего содержания:
Данная функция позволяет завершить выполнение любой активной программы по её classname или заголовку окна.
Совместимость: Все версии Delphi
Исходный код функции
procedure KillProgram(Classname : string; WindowTitle : string);
const
PROCESS_TERMINATE = $0001;
var
ProcessHandle : THandle;
ProcessID: Integer;
TheWindow : HWND;
begin
TheWindow := FindWindow(Classname, WindowTitle);
GetWindowThreadProcessID(TheWindow, @ProcessID);
ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId);
TerminateProcess(ProcessHandle, 4);
end;
Комментарии
Xianguang Li=(22 Октября 2000) В Delphi 5, при компиляции получается следующая ошибка:
Incompatible types: 'String' and 'PChar'.
После изменения выражения
TheWindow := FindWindow(ClassName, WindowTitle)
на
TheWindow := FindWindow(PChar(ClassName), PChar(WindowTitle))
Нормально откомпилировалось.
И ещё: если мы не знаем ClassName или WindowTitle программы, которую мы хотим убить, то мы не сможем её завершить. Причина в том, что нельзя вызвать функцию в виде:
KillProgram(nil, WindowTitle)
или
KillProgram(ClassName, nil)
Компилятор не позволяет передать nil в переменную типа String.
Итак, я изменил объявление
KillProgram(ClassName: string; WindowTitle: string)
на
KillProgram(ClassName: PChar; WindowTitle: PChar),
вот теперь функция действительно может завершить любое приложение, если вы не знаете ClassName или WindowTitle этого приложения.
Pascal
Объекты
Проблема циклических ссылок
У меня имеется объект A и объект B, и им обоим нужно вызывать методы друг друга…
Объявите абстрактный базовый класс, определяющий интерфейс класса для того, чтобы другие классы могли его видеть. Используйте виртуальные абстрактные методы и свойства. Затем объявите другие классы подклассами базового класса (при необходимости). Данный метод существенно поможет в структурировании вашего приложения.
Mike Scott.
Создание множества экземпляров
Delphi 1
list:=Tlist.create;
For i:= 1 to 1000 do begin
SSObject:=TSSObject.create;
{поместите куда-нибудь ссылку на созданный объект - например, в Tlist}
list.add(SSObject);
end;
Параметры
Передача функции как параметра
Delphi 1
В нашем случае лучшим решением будет использование процедурного типа. Допустим, что DllFunction() на входе хочет получить определенную функцию, поясним это на примере кода:
type TMyFuncType = function: integer;
var MyFunc : TMyFuncType;
function foo: integer;
begin
result := 1;
end;
begin
MyFunc := foo;
DllFunction(longint(MyFunc));
Вы можете это сделать и так:
DllFunction(longint(@foo));
Все же я не уверен в вопросах корректности использования таким образом в вызовах DLL памяти (для меня пока неясна работа с памятью, находящейся в другом сегменте), как в этом примере, так что возможно для корректной работы вам придется объявить foo с директивой far, экспортировать ее в модуле, или что-то еще.
Также, в зависимости от того, как написана DllFunction(), вы можете в вызове подразумевать приведение типа:
function DllFunction(p: TMyFuncType): Integer; far; external 'mydll';
В этом случае вам не нужна будет переменная MyFunc или оператор @.
В Delphi/Pascal вы можете передавать функции как параметры. Тем не менее, чтобы этим воспользоваться, необходимо для компилятора установить тип. Попробуйте следующий код (я реально его компилил и тестировал):
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private { Private declarations }
public { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
IntFunc = function: integer;
function DllFunction(iFunc: IntFunc): integer; far;
begin
DllFunction := iFunc; {Обратите внимание на то, что это вызов функции}
end;
function iFoo: integer; far;
begin
iFoo := 1;
end;
procedure TestIFunc;
var
i: integer;
begin
i := DllFunction(iFoo);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TestIFunc;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
end.
