Читать онлайн «Советы по Delphi. Версия 1.4.3 от 1.1.2001». Страница 8

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 этого приложения.

У меня имеется объект A и объект B, и им обоим нужно вызывать методы друг друга…

Объявите абстрактный базовый класс, определяющий интерфейс класса для того, чтобы другие классы могли его видеть. Используйте виртуальные абстрактные методы и свойства. Затем объявите другие классы подклассами базового класса (при необходимости). Данный метод существенно поможет в структурировании вашего приложения.

list:=Tlist.create;

For i:= 1 to 1000 do begin

 SSObject:=TSSObject.create;

 {поместите куда-нибудь ссылку на созданный объект - например, в Tlist}

 list.add(SSObject);

end;

В нашем случае лучшим решением будет использование процедурного типа. Допустим, что 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.