{

This unit is part of MKVExtractGUI2 project
(C) Eugene Pashin, 2010-2011 and some Internet Delphi sources.
pashin@rambler.ru

}
unit utils;

interface

uses
  Forms, windows, classes, ShellApi, strUtils, sysUtils, mmsystem;

type
  THandleArray = array of THandle;
  PHandleArray = ^THandleArray;

function ExecuteConsoleApp(CommandLine: string): string; overload; // NON_UNICODE!

procedure ExecuteConsoleApp(var CommandLine: String; Output: TStringList; Errors: TStringList);
  overload;
procedure ExecuteWait(Cmd: string);

// Заполнить список окон потока.
procedure FillThreadWindowList(hThread: dword; Handles: PHandleArray);
// Callback-функция перебора окон потока.
function EnumThreadWndProc(hwnd: hwnd; lParam: lParam): BOOL; stdcall; forward;

function GetFileVersion(FileName: string): Cardinal;
function CardinalToVersionString(Ver: Cardinal; ExcludeMinorPart: boolean = False): string;

function PlayResource(Name: string): boolean;
function PointIntoRect(Point: TPoint; Rect: TRect): boolean;

function GetOSVer: real;

implementation

function GetOSVer: real;
var
  OSVersion: TOSVersionInfo;
begin
  OSVersion.dwOSVersionInfoSize:=SIZEOF(OSVersion);
  if GetVersionEx(OSVersion) then
  begin
    Result := OSVersion.dwMajorVersion + OSVersion.dwMinorVersion/10;
//      Result:= Format('%d.%d (%d.%s)',[OSVersion.dwMajorVersion,
//        OSVersion.dwMinorVersion,(OSVersion.dwBuildNumber and $FFFF),
//        OSVersion.szCSDVersion]);
  end;
end;

function ExecuteConsoleApp(CommandLine: string): string;
var
  sl1, sl2: TStringList;
  Buf1, Buf2: array [0 .. $FFFF] of AnsiChar;
begin
  sl1 := TStringList.Create;
  sl2 := TStringList.Create;
  ExecuteConsoleApp(CommandLine, sl1, sl2);
  Result := sl1.Text;

  // в 7-ке с кодировкой нормально
  // а в XP вывод получается в OEM

  if GetOsVer() < 6  then
  begin
    buf1 := '';
    buf2 := '';
    StrPCopy(buf1, sl1.Text);
    OemToAnsi(buf1, buf2); // obsolete
    Result := buf2; // конвертит к WideString-у?
  end;

  sl1.Free;
  sl2.Free;
end;

procedure ExecuteConsoleApp(var CommandLine: String; Output: TStringList; Errors: TStringList);
var
  sa: TSECURITYATTRIBUTES;
  si: TSTARTUPINFO;
  pi: TPROCESSINFORMATION;
  hPipeOutputRead: THandle;
  hPipeOutputWrite: THandle;
  hPipeErrorsRead: THandle;
  hPipeErrorsWrite: THandle;
  Res, bTest: boolean;
  szBuffer: array [0 .. 256] of AnsiChar;
  dwNumberOfBytesRead: dword;
  Stream: TMemoryStream;
begin
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := true;
  sa.lpSecurityDescriptor := nil;
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
  CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
  ZeroMemory(@si, sizeof(si));
  ZeroMemory(@pi, sizeof(pi));
  si.cb := sizeof(si);
  si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  si.wShowWindow := SW_HIDE;
  si.hStdInput := 0;
  si.hStdOutput := hPipeOutputWrite;
  si.hStdError := hPipeErrorsWrite;

  (* Remember that if you want to execute an app with no parameters you nil the
    second parameter and use the first, you can also leave it as is with no
    problems. *)
  Res := CreateProcess(nil, PChar(CommandLine), nil, nil, true,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, si, pi);

  // Procedure will exit if CreateProcess fail
  if not Res then
  begin
    CloseHandle(hPipeOutputRead);
    CloseHandle(hPipeOutputWrite);
    CloseHandle(hPipeErrorsRead);
    CloseHandle(hPipeErrorsWrite);
    Exit;
  end;
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeErrorsWrite);

  // Read output pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeOutputRead, szBuffer, sizeof(szBuffer), dwNumberOfBytesRead, nil);
      if not bTest then
        break;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Output.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  // Read error pipe
  Stream := TMemoryStream.Create;
  try
    while true do
    begin
      bTest := ReadFile(hPipeErrorsRead, szBuffer, sizeof(szBuffer), dwNumberOfBytesRead, nil);
      if not bTest then
        break;
      Stream.Write(szBuffer, dwNumberOfBytesRead);
    end;
    Stream.Position := 0;
    Errors.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  WaitForSingleObject(pi.hProcess, INFINITE);
  CloseHandle(pi.hProcess);
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorsRead);
end;

{
procedure RunDosInMemo(DosApp: String; Memo: );
const
  ReadBuffer = 2400;
var
  Security: TSECURITYATTRIBUTES;
  ReadPipe, WritePipe: THandle;
  start: TSTARTUPINFO;
  ProcessInfo: TPROCESSINFORMATION;
  Buffer: PChar;
  BytesRead: dword;
  Apprunning: dword;
begin
  With Security do
  begin
    nLength := sizeof(TSECURITYATTRIBUTES);
    bInheritHandle := true;
    lpSecurityDescriptor := nil;
  end;
  if CreatePipe(ReadPipe, WritePipe, @Security, 0) then
  begin
    Buffer := AllocMem(ReadBuffer + 1);
    FillChar(start, sizeof(start), #0);
    start.cb := sizeof(start);
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;

    if CreateProcess(nil, PChar(DosApp), @Security, @Security, true, NORMAL_PRIORITY_CLASS, nil,
      nil, start, ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
        Application.ProcessMessages;
      until (Apprunning <> WAIT_TIMEOUT);
      Repeat
        BytesRead := 0;
        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        OemToAnsi(Buffer, Buffer);
        AMemo.Text := AMemo.Text + String(Buffer);
      until (BytesRead < ReadBuffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;
}

procedure ExecuteWait(Cmd: string);
var
  ShExecInfo: TShellExecuteInfo;
begin
  FillChar(ShExecInfo, sizeof(ShExecInfo), 0);
  with ShExecInfo do
  begin
    cbSize := sizeof(ShExecInfo);
    fMask := SEE_MASK_NOCLOSEPROCESS;
    lpFile := PChar(Cmd);
    lpVerb := 'open';
    nShow := SW_SHOW;
  end;
  if ShellExecuteEx(@ShExecInfo) then
    WaitForSingleObject(ShExecInfo.hProcess, INFINITE);
end;

//

procedure FillThreadWindowList(hThread: dword; Handles: PHandleArray);
begin
  EnumThreadWindows(hThread, @EnumThreadWndProc, lParam(Handles));
end;

function EnumThreadWndProc(hwnd: hwnd; lParam: lParam): BOOL; stdcall;
var
  WindowClassName: string;
  WindowClassNameLength: Integer;
  HA: PHandleArray;
begin
  // Calback-функция вызывается до тех пор, пока не кончатся окна или
  // callback-функция не вернет False.
  Result := true;
  HA := PHandleArray(lParam);
  // Длина MAX_PATH выбрана случайно, ее должно хватить в подавляющем большинстве случаев.
  SetLength(WindowClassName, MAX_PATH);
  WindowClassNameLength := GetClassName(hwnd, PChar(WindowClassName), MAX_PATH);
  SetLength(HA^, Length(HA^) + 1);
  HA^[Length(HA^) - 1] := hwnd;
  // WindowList.Add(LeftStr(WindowClassName, WindowClassNameLength));
  // Получим дочерние окна.
  EnumChildWindows(hwnd, @EnumThreadWndProc, lParam);
end;

function GetFileVersion(FileName: string): Cardinal;
var
  Info: Pointer;
  InfoSize: dword;
  FileInfo: PVSFixedFileInfo;
  FileInfoSize: dword;
  Tmp: dword;
  Major1, Major2, Minor1, Minor2: word;
begin
  Result := 0;
  InfoSize := GetFileVersionInfoSize(PChar(FileName), Tmp);

  if InfoSize = 0 then
    // Файл не содержит информации о версии
  else
  begin
    GetMem(Info, InfoSize);
    try
      GetFileVersionInfo(PChar(FileName), 0, InfoSize, Info);
      VerQueryValue(Info, '\', Pointer(FileInfo), FileInfoSize);
      Major1 := FileInfo.dwFileVersionMS shr 16;
      Major2 := FileInfo.dwFileVersionMS and $0000FFFF;
      Minor1 := FileInfo.dwFileVersionLS shr 16;
      Minor2 := FileInfo.dwFileVersionLS and $0000FFFF;
      // actually they are WORD, but in this project will be BYTE
      Result := (Major1 shl 24) + (Major2 shl 16) + (Minor1 shl 8) + Minor2;
    finally
      FreeMem(Info, FileInfoSize);
    end;
  end;
end;

function CardinalToVersionString(Ver: Cardinal; ExcludeMinorPart: boolean = False): string;
var
  Ms, Ls: word;
begin
  Ms := HiWord(Ver);
  Ls := LoWord(Ver);
  if ExcludeMinorPart then
    Result := Format('%d.%d', [HiByte(Ms), LoByte(Ms)])
  else
    Result := Format('%d.%d.%d.%d', [HiByte(Ms), LoByte(Ms), HiByte(Ls), LoByte(Ls)]);
end;

function PlayResource(Name: string): boolean;
var
  FindHandle, ResHandle: THandle;
  ResPtr: Pointer;
begin
  FindHandle := FindResource(HInstance, PChar(Name), RT_RCDATA);
  if FindHandle <> 0 then
  begin
    ResHandle := LoadResource(HInstance, FindHandle);
    if ResHandle <> 0 then
      try
        ResPtr := LockResource(ResHandle);
        if ResPtr <> nil then
          try
            SndPlaySound(ResPtr, snd_ASync or snd_Memory);
          finally
            UnlockResource(ResHandle);
          end;
      finally
        FreeResource(FindHandle);
      end;
  end;
end;

function PointIntoRect(Point: TPoint; Rect: TRect): boolean;
begin
  Result := (Point.x >= Rect.Left) and (Point.x <= Rect.Right) and (Point.y >= Rect.Top) and
    (Point.y <= Rect.Bottom);
end;

end.
