WebSVN – aysalia – Diff – /trunk/Aysalia DOS/Source/AyDos.dpr


program AyDos;
 
// Aysalia DOS Launcher
// Revision 2018-12-07
// (C) 2018 Daniel Marschall, ViaThinkSoft
 
// This launcher does launch DOSBox with the correct *.conf file,
// centers the window and changes the window title and icon at runtime.
 
uses
  SysUtils,
  ShellAPI,
  Windows,
  Messages;
 
{$R *.RES}
 
const
  DOSBOX_EXE = 'DOSBox.exe';
 
var
  hPsApiDll: Cardinal = 0;
  hIcon: THandle = 0;
  bCeneredOnce: boolean = false;
 
(*
function GetModuleFileNameEx(inProcess: THandle; inModule: THandle;
      Filename: PChar; size: DWord): DWord; stdcall;
      external 'psapi.dll' name 'GetModuleFileNameExA';
*)
{$IFDEF UNICODE}
function GetModuleFileNameEx(inProcess: THandle; inModule: THandle; Filename: PWideChar; size: DWord): Integer;
type
  TGetModuleFileNameExFunc = function (inProcess: THandle; inModule: THandle; Filename: PWideChar; size: DWord): DWord; stdcall;
var
  funcGetModuleFileNameEx: TGetModuleFileNameExFunc;
begin
  if hPsApiDll <> 0 then
  begin
    @funcGetModuleFileNameEx := GetProcAddress(hPsApiDll, 'GetModuleFileNameExW');
    if Assigned(funcGetModuleFileNameEx) then
      result := funcGetModuleFileNameEx(inProcess, inModule, Filename, size)
    else
      result := -1;
  end
  else result := -2;
end;
{$ELSE}
function GetModuleFileNameEx(inProcess: THandle; inModule: THandle; Filename: PAnsiChar; size: DWord): Integer;
type
  TGetModuleFileNameExFunc = function (inProcess: THandle; inModule: THandle; Filename: PAnsiChar; size: DWord): DWord; stdcall;
var
  funcGetModuleFileNameEx: TGetModuleFileNameExFunc;
begin
  if hPsApiDll <> 0 then
  begin
    @funcGetModuleFileNameEx := GetProcAddress(hPsApiDll, 'GetModuleFileNameExA');
    if Assigned(funcGetModuleFileNameEx) then
      result := funcGetModuleFileNameEx(inProcess, inModule, Filename, size)
    else
      result := -1;
  end
  else result := -2;
end;
{$ENDIF}
 
procedure ChangeTitleAndIcon(hWnd: Thandle);
var
  Title: array[0..255] of Char;
const
  TargetWinWidth = 640;
  TargetWinHeight = 480;
resourcestring
  AyDosTitle = 'Aysalia DOS';
  AyDos1Title = 'Aysalia DOS 1';
  AyDos2Title = 'Aysalia DOS 2';
begin
  ZeroMemory(@Title, sizeof(Title));
  GetWindowText(hWnd, @Title, sizeof(Title)-1);
 
  // Center window (once)
  if (Title = 'DOSBox') and not bCeneredOnce then
  begin
    MoveWindow(hWnd, GetSystemMetrics(SM_CXSCREEN) div 2 - TargetWinWidth div 2,
                     GetSystemMetrics(SM_CYSCREEN) div 2 - TargetWinHeight div 2,
                     TargetWinWidth,
                     TargetWinHeight,
                     true);
    bCeneredOnce := true;
  end;
 
  // Change window title
  if Pos('AYDOS1', Title) > 0 then
    SetWindowText(hWnd, PChar(AyDos1Title))
  else if Pos('AYDOS2', Title) > 0 then
    SetWindowText(hWnd, PChar(AyDos2Title))
  else if Pos('AYDOS', Title) > 0 then
    SetWindowText(hWnd, PChar(AyDosTitle));
 
  // Change window and taskbar icon
  if hIcon > 0 then
  begin
    // Change both icons to the same icon handle.
    SendMessage(hWnd, WM_SETICON, ICON_SMALL, hIcon);
    SendMessage(hWnd, WM_SETICON, ICON_BIG, hIcon);
 
    // This will ensure that the application icon gets changed too.
    SendMessage(GetWindow(hWnd, GW_OWNER), WM_SETICON, ICON_SMALL, hIcon);
    SendMessage(GetWindow(hWnd, GW_OWNER), WM_SETICON, ICON_BIG, hIcon);
  end;
end;
 
function EnumWindowsProc(Handle: hWnd; dummy: DWORD): BOOL; stdcall;
var
  Title: array[0..255] of Char;
  WinFileName: array[0..MAX_PATH] of Char;
var
  PID: DWORD;
  hProcess: THandle;
  Len: Integer;
begin
  Result := True;
  ZeroMemory(@WinFileName, sizeof(WinFileName));
  GetWindowThreadProcessId(Handle, @PID);
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, PID);
  Len := GetModuleFileNameEx(hProcess, 0, WinFileName, sizeof(WinFileName)-1);
  if Len > 0 then
  begin
    // GetModuleFileNameEx is available on newer operating systems;
    // it ensures that we find the correct window by checking its EXE filename.
    if SameText(WinFileName, ExtractFilePath(ParamStr(0)) + DOSBOX_EXE) then
    begin
      Result := False; // stop enumeration
      ChangeTitleAndIcon(Handle);
    end;
  end
  else if Len < 0 then
  begin
    // At Win9x, there is no psapi.dll, so we try it the old fashioned way,
    // finding the window by parts of its title
    ZeroMemory(@Title, sizeof(Title));
    GetWindowText(Handle, Title, sizeof(Title)-1);
    if IsWindowVisible(Handle) then
    begin
      if (title = 'DOSBox') or ((Pos('DOSBox ',   title) > 0) and
                                (Pos('Cpu speed', title) > 0)) then
      begin
        Result := False; // stop enumeration
        ChangeTitleAndIcon(Handle);
      end;
    end;
  end;
end;
 
function ShellExecuteWait(hWnd: HWND; Operation, FileName, Parameters,
  Directory: PChar; ShowCmd: Integer): DWord;
var
  Info: TShellExecuteInfo;
  pInfo: PShellExecuteInfo;
begin
  pInfo := @Info;
  with Info do
  begin
    cbSize       := SizeOf(Info);
    fMask        := SEE_MASK_NOCLOSEPROCESS;
    wnd          := hWnd;
    lpVerb       := Operation;
    lpFile       := FileName;
    lpParameters := PChar(Parameters + #0);
    lpDirectory  := PChar(Directory);
    nShow        := ShowCmd;
    hInstApp     := 0;
  end;
  ShellExecuteEx(pInfo);
 
  repeat
    result := WaitForSingleObject(Info.hProcess, 10);
    EnumWindows(@EnumWindowsProc, 0);
  until (result <> WAIT_TIMEOUT);
end;
 
function Main: Integer;
var
  sFile: string;
begin
  ShellExecuteWait(0, 'open', DOSBOX_EXE, '-noconsole -conf DOSBox.conf',
    PChar(ExtractFilePath(ParamStr(0))), SW_NORMAL);
 
  sFile := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))) + 'stdout.txt';
  if FileExists(sFile) then DeleteFile(PChar(sFile));
 
  sFile := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))) + 'stderr.txt';
  if FileExists(sFile) then DeleteFile(PChar(sFile));
 
  result := 0;
end;
 
begin
  hPsApiDll := LoadLibrary('psapi.dll');
  try
    hIcon := LoadIcon(hInstance, 'MainIcon');
    ExitCode := Main;
  finally
    FreeLibrary(hPsApiDll);
    hPsApiDll := 0;
  end;
end.
 

Rev 24	Rev 26
1	program AyDos;	1	program AyDos;
2		2
3	// Aysalia DOS Launcher	3	// Aysalia DOS Launcher
4	// Revision 2018-12-07	4	// Revision 2018-12-07
5	// (C) 2018 Daniel Marschall, ViaThinkSoft	5	// (C) 2018 Daniel Marschall, ViaThinkSoft
6		6
7	// This launcher does launch DOSBox with the correct *.conf file,	7	// This launcher does launch DOSBox with the correct *.conf file,
8	// centers the window and changes the window title and icon at runtime.	8	// centers the window and changes the window title and icon at runtime.
9		9
10	uses	10	uses
11	SysUtils,	11	SysUtils,
12	ShellAPI,	12	ShellAPI,
13	Windows,	13	Windows,
14	Messages;	14	Messages;
15		15
16	{$R *.RES}	16	{$R *.RES}
17		17
18	const	18	const
19	DOSBOX_EXE = 'DOSBox.exe';	19	DOSBOX_EXE = 'DOSBox.exe';
20		20
21	var	21	var
22	hPsApiDll: Cardinal = 0;	22	hPsApiDll: Cardinal = 0;
23	hIcon: THandle = 0;	23	hIcon: THandle = 0;
24	bCeneredOnce: boolean = false;	24	bCeneredOnce: boolean = false;
25		25
26	(*	26	(*
27	function GetModuleFileNameEx(inProcess: THandle; inModule: THandle;	27	function GetModuleFileNameEx(inProcess: THandle; inModule: THandle;
28	Filename: PChar; size: DWord): DWord; stdcall;	28	Filename: PChar; size: DWord): DWord; stdcall;
29	external 'psapi.dll' name 'GetModuleFileNameExA';	29	external 'psapi.dll' name 'GetModuleFileNameExA';
30	*)	30	*)
31	{$IFDEF UNICODE}	31	{$IFDEF UNICODE}
32	function GetModuleFileNameEx(inProcess: THandle; inModule: THandle; Filename: PWideChar; size: DWord): Integer;	32	function GetModuleFileNameEx(inProcess: THandle; inModule: THandle; Filename: PWideChar; size: DWord): Integer;
33	type	33	type
34	TGetModuleFileNameExFunc = function (inProcess: THandle; inModule: THandle; Filename: PWideChar; size: DWord): DWord; stdcall;	34	TGetModuleFileNameExFunc = function (inProcess: THandle; inModule: THandle; Filename: PWideChar; size: DWord): DWord; stdcall;
35	var	35	var
36	funcGetModuleFileNameEx: TGetModuleFileNameExFunc;	36	funcGetModuleFileNameEx: TGetModuleFileNameExFunc;
37	begin	37	begin
38	if hPsApiDll <> 0 then	38	if hPsApiDll <> 0 then
39	begin	39	begin
40	@funcGetModuleFileNameEx := GetProcAddress(hPsApiDll, 'GetModuleFileNameExW');	40	@funcGetModuleFileNameEx := GetProcAddress(hPsApiDll, 'GetModuleFileNameExW');
41	if Assigned(funcGetModuleFileNameEx) then	41	if Assigned(funcGetModuleFileNameEx) then
42	result := funcGetModuleFileNameEx(inProcess, inModule, Filename, size)	42	result := funcGetModuleFileNameEx(inProcess, inModule, Filename, size)
43	else	43	else
44	result := -1;	44	result := -1;
45	end	45	end
46	else result := -2;	46	else result := -2;
47	end;	47	end;
48	{$ELSE}	48	{$ELSE}
49	function GetModuleFileNameEx(inProcess: THandle; inModule: THandle; Filename: PAnsiChar; size: DWord): Integer;	49	function GetModuleFileNameEx(inProcess: THandle; inModule: THandle; Filename: PAnsiChar; size: DWord): Integer;
50	type	50	type
51	TGetModuleFileNameExFunc = function (inProcess: THandle; inModule: THandle; Filename: PAnsiChar; size: DWord): DWord; stdcall;	51	TGetModuleFileNameExFunc = function (inProcess: THandle; inModule: THandle; Filename: PAnsiChar; size: DWord): DWord; stdcall;
52	var	52	var
53	funcGetModuleFileNameEx: TGetModuleFileNameExFunc;	53	funcGetModuleFileNameEx: TGetModuleFileNameExFunc;
54	begin	54	begin
55	if hPsApiDll <> 0 then	55	if hPsApiDll <> 0 then
56	begin	56	begin
57	@funcGetModuleFileNameEx := GetProcAddress(hPsApiDll, 'GetModuleFileNameExA');	57	@funcGetModuleFileNameEx := GetProcAddress(hPsApiDll, 'GetModuleFileNameExA');
58	if Assigned(funcGetModuleFileNameEx) then	58	if Assigned(funcGetModuleFileNameEx) then
59	result := funcGetModuleFileNameEx(inProcess, inModule, Filename, size)	59	result := funcGetModuleFileNameEx(inProcess, inModule, Filename, size)
60	else	60	else
61	result := -1;	61	result := -1;
62	end	62	end
63	else result := -2;	63	else result := -2;
64	end;	64	end;
65	{$ENDIF}	65	{$ENDIF}
66		66
67	procedure ChangeTitleAndIcon(hWnd: Thandle);	67	procedure ChangeTitleAndIcon(hWnd: Thandle);
68	var	68	var
69	Title: array[0..255] of Char;	69	Title: array[0..255] of Char;
70	const	70	const
71	TargetWinWidth = 640;	71	TargetWinWidth = 640;
72	TargetWinHeight = 480;	72	TargetWinHeight = 480;
73	resourcestring	73	resourcestring
74	AyDosTitle = 'Aysalia DOS';	74	AyDosTitle = 'Aysalia DOS';
75	AyDos1Title = 'Aysalia DOS I';	75	AyDos1Title = 'Aysalia DOS 1';
76	AyDos2Title = 'Aysalia DOS II';	76	AyDos2Title = 'Aysalia DOS 2';
77	begin	77	begin
78	ZeroMemory(@Title, sizeof(Title));	78	ZeroMemory(@Title, sizeof(Title));
79	GetWindowText(hWnd, @Title, sizeof(Title)-1);	79	GetWindowText(hWnd, @Title, sizeof(Title)-1);
80		80
81	// Center window (once)	81	// Center window (once)
82	if (Title = 'DOSBox') and not bCeneredOnce then	82	if (Title = 'DOSBox') and not bCeneredOnce then
83	begin	83	begin
84	MoveWindow(hWnd, GetSystemMetrics(SM_CXSCREEN) div 2 - TargetWinWidth div 2,	84	MoveWindow(hWnd, GetSystemMetrics(SM_CXSCREEN) div 2 - TargetWinWidth div 2,
85	GetSystemMetrics(SM_CYSCREEN) div 2 - TargetWinHeight div 2,	85	GetSystemMetrics(SM_CYSCREEN) div 2 - TargetWinHeight div 2,
86	TargetWinWidth,	86	TargetWinWidth,
87	TargetWinHeight,	87	TargetWinHeight,
88	true);	88	true);
89	bCeneredOnce := true;	89	bCeneredOnce := true;
90	end;	90	end;
91		91
92	// Change window title	92	// Change window title
93	if Pos('AYDOS1', Title) > 0 then	93	if Pos('AYDOS1', Title) > 0 then
94	SetWindowText(hWnd, PChar(AyDos1Title))	94	SetWindowText(hWnd, PChar(AyDos1Title))
95	else if Pos('AYDOS2', Title) > 0 then	95	else if Pos('AYDOS2', Title) > 0 then
96	SetWindowText(hWnd, PChar(AyDos2Title))	96	SetWindowText(hWnd, PChar(AyDos2Title))
97	else	97	else if Pos('AYDOS', Title) > 0 then
98	SetWindowText(hWnd, PChar(AyDosTitle));	98	SetWindowText(hWnd, PChar(AyDosTitle));
99		99
100	// Change window and taskbar icon	100	// Change window and taskbar icon
101	if hIcon > 0 then	101	if hIcon > 0 then
102	begin	102	begin
103	// Change both icons to the same icon handle.	103	// Change both icons to the same icon handle.
104	SendMessage(hWnd, WM_SETICON, ICON_SMALL, hIcon);	104	SendMessage(hWnd, WM_SETICON, ICON_SMALL, hIcon);
105	SendMessage(hWnd, WM_SETICON, ICON_BIG, hIcon);	105	SendMessage(hWnd, WM_SETICON, ICON_BIG, hIcon);
106		106
107	// This will ensure that the application icon gets changed too.	107	// This will ensure that the application icon gets changed too.
108	SendMessage(GetWindow(hWnd, GW_OWNER), WM_SETICON, ICON_SMALL, hIcon);	108	SendMessage(GetWindow(hWnd, GW_OWNER), WM_SETICON, ICON_SMALL, hIcon);
109	SendMessage(GetWindow(hWnd, GW_OWNER), WM_SETICON, ICON_BIG, hIcon);	109	SendMessage(GetWindow(hWnd, GW_OWNER), WM_SETICON, ICON_BIG, hIcon);
110	end;	110	end;
111	end;	111	end;
112		112
113	function EnumWindowsProc(Handle: hWnd; dummy: DWORD): BOOL; stdcall;	113	function EnumWindowsProc(Handle: hWnd; dummy: DWORD): BOOL; stdcall;
114	var	114	var
115	Title: array[0..255] of Char;	115	Title: array[0..255] of Char;
116	WinFileName: array[0..MAX_PATH] of Char;	116	WinFileName: array[0..MAX_PATH] of Char;
117	var	117	var
118	PID: DWORD;	118	PID: DWORD;
119	hProcess: THandle;	119	hProcess: THandle;
120	Len: Integer;	120	Len: Integer;
121	begin	121	begin
122	Result := True;	122	Result := True;
123	ZeroMemory(@WinFileName, sizeof(WinFileName));	123	ZeroMemory(@WinFileName, sizeof(WinFileName));
124	GetWindowThreadProcessId(Handle, @PID);	124	GetWindowThreadProcessId(Handle, @PID);
125	hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, PID);	125	hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, PID);
126	Len := GetModuleFileNameEx(hProcess, 0, WinFileName, sizeof(WinFileName)-1);	126	Len := GetModuleFileNameEx(hProcess, 0, WinFileName, sizeof(WinFileName)-1);
127	if Len > 0 then	127	if Len > 0 then
128	begin	128	begin
129	// GetModuleFileNameEx is available on newer operating systems;	129	// GetModuleFileNameEx is available on newer operating systems;
130	// it ensures that we find the correct window by checking its EXE filename.	130	// it ensures that we find the correct window by checking its EXE filename.
131	if SameText(WinFileName, ExtractFilePath(ParamStr(0)) + DOSBOX_EXE) then	131	if SameText(WinFileName, ExtractFilePath(ParamStr(0)) + DOSBOX_EXE) then
132	begin	132	begin
133	Result := False; // stop enumeration	133	Result := False; // stop enumeration
134	ChangeTitleAndIcon(Handle);	134	ChangeTitleAndIcon(Handle);
135	end;	135	end;
136	end	136	end
137	else if Len < 0 then	137	else if Len < 0 then
138	begin	138	begin
139	// At Win9x, there is no psapi.dll, so we try it the old fashioned way,	139	// At Win9x, there is no psapi.dll, so we try it the old fashioned way,
140	// finding the window by parts of its title	140	// finding the window by parts of its title
141	ZeroMemory(@Title, sizeof(Title));	141	ZeroMemory(@Title, sizeof(Title));
142	GetWindowText(Handle, Title, sizeof(Title)-1);	142	GetWindowText(Handle, Title, sizeof(Title)-1);
143	if IsWindowVisible(Handle) then	143	if IsWindowVisible(Handle) then
144	begin	144	begin
145	if (title = 'DOSBox') or ((Pos('DOSBox ', title) > 0) and	145	if (title = 'DOSBox') or ((Pos('DOSBox ', title) > 0) and
146	(Pos('Cpu speed', title) > 0)) then	146	(Pos('Cpu speed', title) > 0)) then
147	begin	147	begin
148	Result := False; // stop enumeration	148	Result := False; // stop enumeration
149	ChangeTitleAndIcon(Handle);	149	ChangeTitleAndIcon(Handle);
150	end;	150	end;
151	end;	151	end;
152	end;	152	end;
153	end;	153	end;
154		154
155	function ShellExecuteWait(hWnd: HWND; Operation, FileName, Parameters,	155	function ShellExecuteWait(hWnd: HWND; Operation, FileName, Parameters,
156	Directory: PChar; ShowCmd: Integer): DWord;	156	Directory: PChar; ShowCmd: Integer): DWord;
157	var	157	var
158	Info: TShellExecuteInfo;	158	Info: TShellExecuteInfo;
159	pInfo: PShellExecuteInfo;	159	pInfo: PShellExecuteInfo;
160	begin	160	begin
161	pInfo := @Info;	161	pInfo := @Info;
162	with Info do	162	with Info do
163	begin	163	begin
164	cbSize := SizeOf(Info);	164	cbSize := SizeOf(Info);
165	fMask := SEE_MASK_NOCLOSEPROCESS;	165	fMask := SEE_MASK_NOCLOSEPROCESS;
166	wnd := hWnd;	166	wnd := hWnd;
167	lpVerb := Operation;	167	lpVerb := Operation;
168	lpFile := FileName;	168	lpFile := FileName;
169	lpParameters := PChar(Parameters + #0);	169	lpParameters := PChar(Parameters + #0);
170	lpDirectory := PChar(Directory);	170	lpDirectory := PChar(Directory);
171	nShow := ShowCmd;	171	nShow := ShowCmd;
172	hInstApp := 0;	172	hInstApp := 0;
173	end;	173	end;
174	ShellExecuteEx(pInfo);	174	ShellExecuteEx(pInfo);
175		175
176	repeat	176	repeat
177	result := WaitForSingleObject(Info.hProcess, 10);	177	result := WaitForSingleObject(Info.hProcess, 10);
178	EnumWindows(@EnumWindowsProc, 0);	178	EnumWindows(@EnumWindowsProc, 0);
179	until (result <> WAIT_TIMEOUT);	179	until (result <> WAIT_TIMEOUT);
180	end;	180	end;
181		181
182	function Main: Integer;	182	function Main: Integer;
183	var	183	var
184	sFile: string;	184	sFile: string;
185	begin	185	begin
186	ShellExecuteWait(0, 'open', DOSBOX_EXE, '-noconsole -conf DOSBox.conf',	186	ShellExecuteWait(0, 'open', DOSBOX_EXE, '-noconsole -conf DOSBox.conf',
187	PChar(ExtractFilePath(ParamStr(0))), SW_NORMAL);	187	PChar(ExtractFilePath(ParamStr(0))), SW_NORMAL);
188		188
189	sFile := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))) + 'stdout.txt';	189	sFile := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))) + 'stdout.txt';
190	if FileExists(sFile) then DeleteFile(PChar(sFile));	190	if FileExists(sFile) then DeleteFile(PChar(sFile));
191		191
192	sFile := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))) + 'stderr.txt';	192	sFile := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))) + 'stderr.txt';
193	if FileExists(sFile) then DeleteFile(PChar(sFile));	193	if FileExists(sFile) then DeleteFile(PChar(sFile));
194		194
195	result := 0;	195	result := 0;
196	end;	196	end;
197		197
198	begin	198	begin
199	hPsApiDll := LoadLibrary('psapi.dll');	199	hPsApiDll := LoadLibrary('psapi.dll');
200	try	200	try
201	hIcon := LoadIcon(hInstance, 'MainIcon');	201	hIcon := LoadIcon(hInstance, 'MainIcon');
202	ExitCode := Main;	202	ExitCode := Main;
203	finally	203	finally
204	FreeLibrary(hPsApiDll);	204	FreeLibrary(hPsApiDll);
205	hPsApiDll := 0;	205	hPsApiDll := 0;
206	end;	206	end;
207	end.	207	end.
208		208

Subversion Repositories aysalia

aysalia/trunk/Aysalia DOS/Source/AyDos.dpr – Rev 24 → 26