Subversion Repositories aysalia

Rev

Rev 10 | Rev 19 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

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