Вызов процедуры другого файла

procedure TForm1.FormCreate(Sender: TObject);
begin
  h := findWindow(nil, PChar('Kassa v' + Ver(Application.ExeName)));
  if h <> 0 then
  begin
    ShowWindow(h, SW_SHOW);
    SetForegroundWindow(h);
    h1 := FindWindowEx(h, 0, 'reloadclick', 0); // ???
    Sendmessage(h1, ?, ?, ?); //  ???
    Halt;
  end;
...
end;

program MyProgram1;
 
uses
  Forms, Windows, Messages, Sysutils, aTypes, MiniReg,
  Unit1 in 'Unit1.pas' {Form1};
 
var
  Wnd:hWnd;
  aCopyData: TCopyDataStruct;
  buff:array[0..511] of char; // Буфер для передачи строки
  s,s2,s3:string;
  i:integer;
  pexit:boolean;
  v:dword;
 
{$R *.RES}
 
begin
  // Поиск окна уже запущенного экземпляра проигрывателя
  pexit:=false; // Сбросить флаг выхода из программы
 
  v:=0;
  RegGetDword(HKEY_CURRENT_USER , 'Software\MyProgParams\RunOne',    v); // Проверка, разрешён ли повторный запуск
  if boolean(v) then begin
    // Поиск окна ранее запущенного проигрывателя
    s3:='MyProgName v1.2';
    Wnd := GetWindow(findwindow('TForm1',nil), gw_HWndFirst); // Поиск класса окна
    while (Wnd <> 0) and (not pexit) do begin // Перебор окон
      if (Wnd <> Application.Handle) and // Если это не наше окно
          (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) then begin // И получен текст окна
        GetWindowText(Wnd, buff, sizeof(buff)); // Получить текст окна
        s:=string(buff); // Дальше муть по проверке соответствия названия найденного окна
        s2:=''; 
        if Length(s)>=Length(s3) then // Этот бред надо переписать однозначно
          for i:=length(s)-Length(s3)+1 to length(s) do
            s2:=s2+s[i];
//        setlength(s,19);
        if s2=s3 then // Если нашли окно, то установить флаг выхода из программы
          pexit:=true;
      end;
      if not pexit then
        Wnd:=GetWindow(Wnd,gw_hWndNext);
    end;{}
 
    if Wnd>0 then begin // Если нашли класс окна программы, то
      if ParamStr(1)<>'' then begin // Если есть параметр командной строки, то
        // передать эту строку найденному экземпляру и завершить программу
        aCopyData.dwData := 0;
        aCopyData.cbData := StrLen(PChar(ParamStr(1))) + 1;
        aCopyData.lpData := PChar(ParamStr(1));
        SendMessage(Wnd, WM_COPYDATA, 0, Longint(@aCopyData));
      end;
      Sleep(50);
      SetForeGroundWindow(Wnd); // Это лучше делать уже при получении сообщения, а не здесь
    end;
    if pexit then
      Exit;
  end;
 
  // Если не найдено экземпляра, то далее работаем как обычно
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

type
  TForm1 = class(TForm)
...
    procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
...
  private
  public
  end;
...
 
procedure TForm1.WMCopyData(var Msg: TWMCopyData);
var
  sText: array[0..255] of Char;
begin
  // generate text from parameter
  // anzuzeigenden Text aus den Parametern generieren
  StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
  // write received text
  // Empfangenen Text ausgeben
  
  // Здесь выполняем нужные действия
end;

type
  TForm1 = class(TForm)
...
    procedure WMUser(var M:tmessage); message WM_USER; // WM_USER message
...
  private
  public
  end;
...
 
procedure TForm1.WMUser(var M:tmessage);
begin
// Выдаёт ответ по состоянию.
  if dword(m.LParam) = 104 then // Статус. Число придумано самостоятельно.
    m.Result := bPlayerStatus; // Здесь возвращаем ответ, который может использоваться
// отправившей сообщение программой как подтверждение выполнения команды
end;

program Project1;
 
uses
  Windows, Winapi.Messages, SysUtils, Vcl.Forms,
  Unit2 in 'Unit2.pas' {Form2};
 
{$R *.res}
 
var
  ApplicationLabel: PWideChar = 'DefailtExeName';
 
  LabelWndProc: Integer = -1;
 
  PrevWnd: TFNWndProc = Nil;
  MutexH: THandle = 0;
  Recipients: DWORD;
 
function WndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  if Msg = LabelWndProc then
  begin
    Application.Restore;
    Application.BringToFront;
    exit(0);
  end
  else if Msg = WM_DESTROY then
  begin
 
    if MutexH > 0 then
      ReleaseMutex(MutexH);
 
    SetWindowLong(Application.Handle, GWL_WNDPROC, LONG_PTR(PrevWnd));
  end;
 
  Result := CallWindowProc(PrevWnd, Handle, Msg, wParam, lParam);
end;
 
begin
  ApplicationLabel := PWideChar(ExtractFileName(Application.ExeName));
 
  MutexH := OpenMutex(MUTEX_ALL_ACCESS, False, ApplicationLabel);
 
  LabelWndProc := RegisterWindowMessage(ApplicationLabel);
 
  if MutexH = 0 then
  begin
    MutexH := CreateMutex(Nil, False, ApplicationLabel);
 
    PrevWnd := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, LONG_PTR(@WndProc)));
 
  end
  else
  begin
    Recipients := BSM_APPLICATIONS;
    BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @Recipients, LabelWndProc, 0, 0);
 
    Application.Terminate;
    exit;
  end;
 
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm2, Form2);
  Application.Run;
 
end.

unit uSingleInstance;
 
//***************************************************************************
//**  Single Instance - Allows run only one instance of application        **
//***************************************************************************
//**                                                                       **
//**  File:      uSingleInstance.pas                                       **
//**                                                                       **
//**  Version:   1.3.0                                                     **
//**                                                                       **
//**  Date:      07.07.2020 (coronavirus time)                             **
//**                                                                       **
//**  Author:    Ing. Tomas Halabala - REGULACE.ORG                        **
//**                                                                       **
//**  License:   This component is freeware.                               **
//**                                                                       **
//**             Tato komponenta je distribuovбna jako freeware.           **
//**                                                                       **
//**             Autor neodpovнdб za ћбdnй pшнpadnй љkody zpщsobenй        **
//**             pouћнvбnнm tйto komponenty.                               **
//**                                                                       **
//**  Disclaimer:THE SOFTWARE AND ANY RELATED DOCUMENTATION IS PROVIDED    **
//**             "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR   **
//**             IMPLIED, INCLUDING, WITHOUT LIMITATION, THE IMPLIED       **
//**             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR   **
//**             PURPOSE, OR NONINFRINGEMENT. AUTHOR DOES NOT WARRANT,     **
//**             GUARANTEE, OR MAKE ANY REPRESENTATIONS REGARDING THE USE, **
//**             OR THE RESULTS OF THE USE, OF THE SOFTWARE IN TERMS OF    **
//**             CORRECTNESS, ACCURACY, RELIABILITY, OR OTHERWISE.         **
//**             THE ENTIRE RISK ARISING OUT OF USE OR PERFORMANCE         **
//**             OF THE SOFTWARE REMAINS WITH YOU.                         **
//**                                                                       **
//**  E-mail:    tomas.halabala@regulace.org                               **
//**                                                                       **
//**  Webpages:  http://www.regulace.org                                   **
//**                                                                       **
//***************************************************************************
 
// Verevkin доработал слегка напильником (+07 июл 2020)
 
interface
 
{$REGION 'uses'}
uses
  SysUtils, Winapi.Windows, VCL.Forms, Classes;
{$ENDREGION 'uses'}
 
{$REGION 'TSingleInstance = class(TComponent)'}
type
  TRequestEvent = function (Sender: TObject; AUserData: Pointer): Boolean of object;
 
  TSingleInstance = class(TComponent)
  private
    LOnSecondRun:     TNotifyEvent;
    LOnBeforeRestart: TRequestEvent;
    FUserData:        Pointer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
    // methods
    function Restart(const ACmdLineParams: string = ''): int32;
  public
    // properties
    property UserData: Pointer read FUserData write FUserData;
  published
    // events
    property OnSecondRun:     TNotifyEvent read LOnSecondRun write LOnSecondRun;
    property OnBeforeRestart: TRequestEvent read LOnBeforeRestart write LOnBeforeRestart;
  end;
{$ENDREGION}
 
procedure Register;
 
implementation
 
//{$R uSingleInstance.dres}
 
var
  InstanceName: string;
  PIName:       PChar;
  MsgHandle:    HWND;
  AppWndProc:   Pointer;
  RunTime:      Boolean;
  Iam:          TSingleInstance;
  hMutex:       NativeUInt;
 
{$REGION 'service routines'}
procedure Register;
begin
  RegisterComponents('Разное', [TSingleInstance]);
end;
 
function MyWindowProc(WindowHandle: hWnd; TheMessage: LongInt; ParamW: LongInt; ParamL: LongInt): LongInt stdcall;
begin
  if TheMessage = int32(MsgHandle)
    then begin
           if Assigned(Iam.LOnSecondRun)
             then Iam.LOnSecondRun(Iam)
             else if Assigned(Application.MainForm)
                    then Application.MainForm.Show();
 
           Exit(0);
         end;
 
  Result:= CallWindowProc(AppWndProc, WindowHandle, TheMessage, ParamW, ParamL);
end;
{$ENDREGION}
 
{$REGION 'TSingleInstance'}
constructor TSingleInstance.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  if RunTime
    then begin
           MsgHandle:=  RegisterWindowMessage(PIName);
           AppWndProc:= Pointer(SetWindowLong(Application.Handle,
                                              GWL_WNDPROC,
                                              LongInt(@MyWindowProc)));
         end;
 
  Iam:= Self;
end;
 
destructor TSingleInstance.Destroy;
begin
  if RunTime
    then SetWindowLong(Application.Handle,
                       GWL_WNDPROC,
                       LongInt(AppWndProc));
 
  inherited Destroy;
end;
 
function TSingleInstance.Restart(const ACmdLineParams: string): int32;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  // event (function)
  if Assigned(LOnBeforeRestart)
    then if not LOnBeforeRestart(Self, FUserData)
           then exit(0); // cancelled by result of event
 
  // close a mutex
  Assert(hMutex <> 0);// must be non-zero!
  if not CloseHandle(hMutex)
    then exit(GetLastError()); // по ошибке
 
  // restart application
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb:= SizeOf(StartupInfo);
 
  if CreateProcess(PChar(InstanceName),                   // имя исполняемого модуля
                   PChar(ACmdLineParams),                 // строка параметров запускаемой программы
                   nil,                                   // структура SECURITY_ATTRIBUTES процесса
                   nil,                                   // структура SECURITY_ATTRIBUTES потока
                   true,                                  // флаг наследования текущего процесса
                   NORMAL_PRIORITY_CLASS,                 // флаги способов создания процесса
                   nil,                                   // указатель на блок среды
                   nil,                                   // текущий диск и каталог
                   StartupInfo,                           // структура STARTUPINFO
                   ProcessInfo)                           // структура PROCESS_INFORMATION
    then begin
           result:= 0;
           Application.Terminate(); // close self-application
         end
    else result:= GetLastError();
end;
{$ENDREGION}
 
{$REGION 'initialization'}
initialization
  RunTime:= not Assigned(Application.MainForm);
 
  if RunTime
    then begin
           InstanceName:= ExtractFileName(Paramstr(0));
           PIName:= PChar(InstanceName);
           hMutex:= CreateMutex(nil, false, PIName);
 
           // if second instance:
           if GetLastError() = ERROR_ALREADY_EXISTS
             then begin
                    var BroadcastMessageResult: PDWORD_PTR:= nil;
                    SendMessageTimeout(HWND_BROADCAST,
                                       RegisterWindowMessage(PIName), 0, 0,
                                       SMTO_ERRORONEXIT OR SMTO_ABORTIFHUNG,
                                       600, BroadcastMessageResult);
                    Halt(0);
                  end;
         end;
{$ENDREGION}
 
end.

Recipients: DWORD;

ApplicationLabel := PAnsiChar(AnsiString(ExtractFileName(Application.ExeName)));