TIEmuStartUnit.pas 2.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394
  1. {
  2. TIGCC IDE
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. Copyright (C) 2006 Kevin Kofler
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2, or (at your option)
  8. any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software Foundation,
  15. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  16. }
  17. unit TIEmuStartUnit;
  18. interface
  19. uses
  20. MasterUnit,
  21. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  22. StdCtrls, ExtCtrls, ComObj, ActiveX, TiEmuOLELib_TLB;
  23. type
  24. TTIEmuStartForm = class(TForm)
  25. Label1: TLabel;
  26. CancelButton: TButton;
  27. FindTimer: TTimer;
  28. procedure FormShow(Sender: TObject);
  29. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  30. procedure FindTimerTimer(Sender: TObject);
  31. private
  32. ProcessHandle: THandle;
  33. public
  34. TiEmuInterface: ITiEmuOLE;
  35. end;
  36. implementation
  37. {$R *.DFM}
  38. uses
  39. UtilsWin;
  40. procedure TTIEmuStartForm.FormShow(Sender: TObject);
  41. var
  42. StartupInfo: TStartupInfo;
  43. ProcessInfo: TProcessInformation;
  44. begin
  45. FillChar (StartupInfo, SizeOf (StartupInfo), 0);
  46. StartupInfo.cb := SizeOf (StartupInfo);
  47. if CreateProcess (nil, PChar (TIEmuPath), nil, nil, False, CREATE_NEW_PROCESS_GROUP or DETACHED_PROCESS, nil, PChar (ExtractFilePath (TIEmuPath)), StartupInfo, ProcessInfo) then begin
  48. ProcessHandle := ProcessInfo.hProcess;
  49. CloseHandle (ProcessInfo.hThread);
  50. end else begin
  51. ShowDefaultMessageBox ('An error occurred while trying to start TiEmu.', 'Error', mtProgramError);
  52. ModalResult := mrAbort;
  53. end;
  54. end;
  55. procedure TTIEmuStartForm.FormClose(Sender: TObject;
  56. var Action: TCloseAction);
  57. begin
  58. if ProcessHandle <> 0 then
  59. CloseHandle (ProcessHandle);
  60. end;
  61. procedure TTIEmuStartForm.FindTimerTimer(Sender: TObject);
  62. var
  63. ExitCode: Cardinal;
  64. Unknown: IUnknown;
  65. OLEResult: HResult;
  66. begin
  67. if GetExitCodeProcess (ProcessHandle, ExitCode) then begin
  68. if ExitCode <> STILL_ACTIVE then begin
  69. ModalResult := mrAbort;
  70. Exit;
  71. end;
  72. end;
  73. OLEResult := GetActiveObject(CLASS_TiEmuOLE, nil, Unknown);
  74. if OLEResult = S_OK then begin
  75. OleCheck(Unknown.QueryInterface(ITiEmuOLE, TiEmuInterface));
  76. ModalResult := mrOK;
  77. end;
  78. end;
  79. end.