unit WindowsUtils;

interface

uses Forms, Classes, StdCtrls, Dialogs;

function GetFolder(const Root: Integer; const Caption: String; const Flags: Integer): String;
function GetFileVersion(const Filename: string): string;
function NewerVersion(const Ver1, Ver2: String): Boolean;
function MessageDlgEng(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Integer): Word;

const
  { New to Windows >= 2000 }
  BIF_NEWDIALOGSTYLE    = $0040;

  { defined in ShlObj.pas
    CSIDL_DESKTOP
    CSIDL_INTERNET
    CSIDL_PROGRAMS
    CSIDL_CONTROLS
    CSIDL_PRINTERS
    CSIDL_PERSONAL
    CSIDL_FAVORITES
    CSIDL_STARTUP
    CSIDL_RECENT
    CSIDL_SENDTO
    CSIDL_BITBUCKET
    CSIDL_STARTMENU
    CSIDL_DESKTOPDIRECTORY
    CSIDL_DRIVES
    CSIDL_NETWORK
    CSIDL_NETHOOD
    CSIDL_FONTS
    CSIDL_TEMPLATES
    CSIDL_COMMON_STARTMENU
    CSIDL_COMMON_PROGRAMS
    CSIDL_COMMON_STARTUP
    CSIDL_COMMON_DESKTOPDIRECTORY
    CSIDL_APPDATA
    CSIDL_PRINTHOOD
    CSIDL_ALTSTARTUP
    CSIDL_COMMON_ALTSTARTUP
    CSIDL_COMMON_FAVORITES
    CSIDL_INTERNET_CACHE
    CSIDL_COOKIES
    CSIDL_HISTORY }

implementation

uses Windows, ShellApi, ShlObj, SysUtils;

function GetFolder(const Root: Integer; const Caption: String; const Flags: Integer): String;
var
  Bi: TBrowseInfo;
  lpBuffer: PChar;
  pidlPrograms, pidlBrowse: PItemIDList;
  Temp: String;
begin
  if (not SUCCEEDED(SHGetSpecialFolderLocation(GetActiveWindow,
    Root, pidlPrograms))) then Exit;

  GetMem(lpBuffer, MAX_PATH);
  FillChar(Bi, SizeOf(Bi), 0);
  Bi.hwndOwner := GetActiveWindow;
  Bi.pidlRoot := pidlPrograms;
  Bi.pszDisplayName := lpBuffer;
  Bi.lpszTitle := PChar(Caption);
  Bi.ulFlags := Flags;
  Bi.lpfn := nil;
  Bi.lParam := 0;
  pidlBrowse := SHBrowseForFolder(Bi);

  if Assigned(pidlBrowse) and (SHGetPathFromIDList(pidlBrowse, lpBuffer)) then
    Temp := lpBuffer;

  FreeMem(lpBuffer);

  if Temp = EmptyStr then
    begin
      Result := EmptyStr;
      Exit;
    end;

  Result := IncludeTrailingPathDelimiter(Temp);
  Result := Temp;
end;

function GetFileVersion(const Filename: string): string;
var
  lpVerInfo: Pointer;
  rVerValue: PVSFixedFileInfo;
  dwInfoSize: Cardinal;
  dwValueSize: Cardinal;
  dwDummy: Cardinal;
  lpStrPath: PChar;
begin
  if Trim(Filename) = EmptyStr then lpstrPath := pchar(ParamStr(0))
  else lpStrPath := PChar(Filename);

  dwInfoSize := GetFileVersionInfoSize(lpStrPath, dwDummy);

  if dwInfoSize = 0
  then begin
    Result := EmptyStr;
    Exit;
  end;

  GetMem(lpVerInfo, dwInfoSize);
  GetFileVersionInfo(lpStrPath, 0, dwInfoSize, lpVerInfo);
  VerQueryValue(lpVerInfo, '\', Pointer(rVerValue), dwValueSize);

  with rVerValue^ do
  begin
    Result := IntTostr(dwFileVersionMS shr 16);
    Result := Result + '.' + IntTostr(dwFileVersionMS and $FFFF);
    Result := Result + '.' + IntTostr(dwFileVersionLS shr 16);
    Result := Result + '.' + IntTostr(dwFileVersionLS and $FFFF);
  end;
  FreeMem(lpVerInfo, dwInfoSize);
end;

function NewerVersion(const Ver1, Ver2: String): Boolean;
var v1, v2: array[1..4] of String;
    i,j: Integer;
begin
  if (Ver1 = EmptyStr) or (Ver2 = EmptyStr) then begin Result := False; Exit; end;
  v1[1] := EmptyStr;
  v1[2] := EmptyStr;
  v1[3] := EmptyStr;
  v1[4] := EmptyStr;
  j := 1;
  for i := 1 to Length(Ver1) do begin
    if Ver1[i]='.' then begin Inc(j); Continue; end;
    v1[j] := v1[j] + Ver1[i];
  end;
  v2[1] := EmptyStr;
  v2[2] := EmptyStr;
  v2[3] := EmptyStr;
  v2[4] := EmptyStr;
  j := 1;
  for i := 1 to Length(Ver2) do begin
    if Ver2[i]='.' then begin Inc(j); Continue; end;
    v2[j] := v2[j] + Ver2[i];
  end;

  Result := false;
  for i := 1 to 4 do begin
    try
      if v1[i] < v2[i] then Result := true;
    except
      Result := false;
    end;
  end;
end;

function MessageDlgEng(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Integer): Word;
var Form: TForm;
    i: Integer;
    Comp: TComponent;
begin
  Form := CreateMessageDialog(Msg, DlgType, Buttons);
  for i := 0 to Form.ComponentCount - 1 do begin
    Comp := Form.Components[i];
    if Comp is TButton then begin
      if (Comp as TButton).Name = 'Yes' then (Comp as TButton).Caption := '&Yes';
      if (Comp as TButton).Name = 'No' then (Comp as TButton).Caption := '&No';
      if (Comp as TButton).Name = 'OK' then (Comp as TButton).Caption := 'OK';
      if (Comp as TButton).Name = 'Cancel' then (Comp as TButton).Caption := 'Cancel';
      if (Comp as TButton).Name = 'Abort' then (Comp as TButton).Caption := '&Cancel';
      if (Comp as TButton).Name = 'Retry' then (Comp as TButton).Caption := '&Retry';
      if (Comp as TButton).Name = 'Ignore' then (Comp as TButton).Caption := '&Ignore';
      if (Comp as TButton).Name = 'All' then (Comp as TButton).Caption := '&All';
      if (Comp as TButton).Name = 'NoToAll' then (Comp as TButton).Caption := '&All no';
      if (Comp as TButton).Name = 'YesToAll' then (Comp as TButton).Caption := 'A&ll yes';
      if (Comp as TButton).Name = 'Help' then (Comp as TButton).Caption := '&Help';
    end;
  end;
  case DlgType of
     mtConfirmation: Form.Caption := 'Confirmation';
     mtError:        Form.Caption := 'Error';
     mtInformation:  Form.Caption := 'Information';
     mtWarning:      Form.Caption := 'Warning';
  end;
  Form.ShowModal;
  Result := Form.ModalResult;
end;

end.
