{

   This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
{$D-}
unit Ufunction;

interface

uses
  Windows, Forms, sysutils, ShellAPI, Graphics,
  comobj, ShlObj, CommCtrl, Classes, ActiveX;

  function GetModuleDir: string;
  function GetAppDirectory:string;
  function GetWindowsDir:string;
  function GetSystemImageList(Large: boolean): HImageList;
  function GetSystemPath(Folder: Integer): string;
  function GetIconIndex(const APath: string; Attrs: DWORD): integer;
  function GetIconIndex2(const APath: string; Attrs: DWORD): integer;
  procedure SplitString(str:string;var returnStr:TStringList;splitchar:char);
  function Get_FileSize(sFileToExamine: string):integer;
  function DateConvert(s:string):string;
  function AdvSelectDirectory(hOwn: HWND; const Caption: string; const Root: WideString;
    var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
    AllowCreateDirs: Boolean = True): Boolean;
  function ConvertSize(value:string):string;

  function HexToTColor(S : string): TColor;
  function ColorToHTML(AColor:TColor):string;
  function compactstring(s:widestring;size:integer):string;
  function makeuniqfilename(s:string):string;
  function ExecuteFile(filename:string; visible:boolean): Boolean;
  function GetVersion: string;
  function difftime(timestamp:tdatetime):integer;
  procedure DrawTransparentBitmap(DC: HDC; hBmp: HBITMAP; xStart, yStart: Integer;
     cTransparentColor: COLORREF);
  function IsActiveDeskTopOn: Boolean;
  function ChangeWallpaper(aFile: String): Boolean;
  function GetOperatingSystem: Integer;
  function GetShellPath(nfolder:integer):string;

const
  { operating system (OS)constants }
  cOsUnknown = -1;
  cOsWin95 = 0;
  cOsWin98 = 1;
  cOsWinME = 2;
  cOsWin98SE = 3;
  cOsWinNT = 4;
  cOsWin2000 = 5;
  cOsXP = 6;
  cOsWin2003 = 7;
  cOsVista = 8;
  cOsWin2008 = 9;
  cOsWindows7 = 10;

implementation

function GetAppDirectory:string;
begin
  result:=ExtractFilePath(Application.ExeName);
end;

function GetWindowsDir:string;
var
  Buf: array[0..MAX_PATH] of char;
begin
  windows.GetWindowsDirectory(Buf, MAX_PATH);
  result:=string(buf)+'\';
end;

function ConvertSize(value:string):string;
var
 s,d:double;
begin
try
  s:=strtofloat(value);
  if s > 1000000 then begin
     d := (s / 1000000);
     result:=formatfloat('##.#', d) + ' M';
  end else if s > 1000 then begin
     d := (s / 1000);
     result:=formatfloat('##.#', d) + ' Kb';
  end else begin
     result:=floattostr(s) + ' b';
  end;
except
  result:= '0 b';
end;
end;

function GetSystemPath(Folder: Integer): string;
var
  PIDL: PItemIDList;
  Path: LPSTR;
  AMalloc: IMalloc;
begin
  Path := StrAlloc(MAX_PATH);
  SHGetSpecialFolderLocation(Application.Handle, Folder, PIDL);
  if SHGetPathFromIDList(PIDL, Path) then
    Result := Path;
  SHGetMalloc(AMalloc);
  AMalloc.Free(PIDL);
  StrDispose(Path);
  if Result[length(Result)]<>'\' then Result:=Result+'\';
end;

procedure SplitString(str:string;var returnStr:TStringList;splitchar:char);
var
 p1:integer;
 y:string;
begin

 p1:=pos(splitchar,str);
 while p1>0 do
 begin
    y:=copy(str,1,p1-1);
    returnStr.Add(y);
    delete(str,1,p1);
    p1:=pos(splitchar,str);
 end;
 if str <> '' then returnStr.Add(str);

end;

function GetSystemImageList(Large: boolean): HImageList;
var
  SFI: TSHFileInfo;
begin
  // SHGetFileInfo puts the requested information in the SFI variable, but it
  // also can return the handle of the system image list.  We just pass an
  // empty file because we aren't interested in it, only the returned handle.
  if Large then
    Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
      SHGFI_SYSICONINDEX or SHGFI_LARGEICON)
  else
    Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
      SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
end;

function GetIconIndex(const APath: string; Attrs: DWORD): integer;
var
  SFI: TSHFileInfo;
begin
  if FileExists(APath) or DirectoryExists(APath) then
    // If the file or directory exists, just let Windows figure out it's attrs.
    SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo),
      SHGFI_SYSICONINDEX)
  else
    // File doesn't exist, so Windows doesn't know what to do with it.  We have
    // to tell it by passing the attributes we want, and specifying the
    // SHGFI_USEFILEATTRIBUTES flag so that the function knows to use them.
    SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
      SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  Result := SFI.iIcon;
end;

function GetIconIndex2(const APath: string; Attrs: DWORD): integer;
var
  SFI: TSHFileInfo;
begin
    SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
      SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  Result := SFI.iIcon;
end;

function Get_FileSize(sFileToExamine: string):integer;
var
  FileHandle: THandle;
  FileSize: LongWord;
begin
  //a- Get file size
  FileHandle := CreateFile(PChar(sFileToExamine),
    GENERIC_READ,
    0, {exclusive}
    nil, {security}
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL,
    0);
  FileSize := GetFileSize(FileHandle, nil);
  Result := FileSize;
  CloseHandle(FileHandle);
end;

function DateConvert(s:string):string;
var
 s2:string;
 DateTime :TDatetime;
// FormatSettings:TFormatSettings;
begin

  s2:=copy(s,6,3);
  delete(s,6,3);
  delete(s2,1,1);
  if strtoint(s2)>80 then s2:='19'+s2
  else s2:='20'+s2;
  s:=s2+'-'+s;

//  GetLocaleFormatSettings(LOCALE_USER_DEFAULT, FormatSettings);
  DateTime:=StrToDateTime(s); //,FormatSettings);
  result:=sysutils.FormatDateTime('yyyy-mm-dd ampm h:nn',DateTime);

end;

function AdvSelectDirectory(hOwn: HWND; const Caption: string; const Root: WideString;
  var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
  AllowCreateDirs: Boolean = True): Boolean;
  // callback function that is called when the dialog has been initialized
  //or a new directory has been selected 

  // Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder
  //ein neues Verzeichnis selektiert wurde 
  function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; 
    stdcall; 
  var 
    PathName: array[0..MAX_PATH] of Char; 
  begin 
    case uMsg of 
      BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
      // include the following comment into your code if you want to react on the 
      //event that is called when a new directory has been selected 
      // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis 
      //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde 
      {BFFM_SELCHANGED: 
      begin 
        SHGetPathFromIDList(PItemIDList(lParam), @PathName); 
        // the directory "PathName" has been selected
        // das Verzeichnis "PathName" wurde selektiert
      end;} 
    end; 
    Result := 0; 
  end;
var
  WindowList: Pointer; 
  BrowseInfo: TBrowseInfo; 
  Buffer: PChar; 
  RootItemIDList, ItemIDList: PItemIDList; 
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder; 
  Eaten, Flags: LongWord; 
const 
  // necessary for some of the additional expansions
  // notwendig fur einige der zusatzlichen Erweiterungen 
  BIF_USENEWUI = $0040; 
  BIF_NOCREATEDIRS = $0200; 
begin 
  Result := False; 
  if not DirectoryExists(Directory) then
    Directory := ''; 
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0); 
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin 
    Buffer := ShellMalloc.Alloc(MAX_PATH); 
    try 
      RootItemIDList := nil; 
      if Root <> '' then 
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(hOwn, nil,
          POleStr(Root), Eaten, RootItemIDList, Flags);
      end; 
      OleInitialize(nil); 
      with BrowseInfo do 
      begin
        hwndOwner := hOwn;
        pidlRoot := RootItemIDList; 
        pszDisplayName := Buffer; 
        lpszTitle := PChar(Caption); 
        // defines how the dialog will appear:
        // legt fest, wie der Dialog erscheint: 
        ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or 
          BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or 
          BIF_NOCREATEDIRS * Ord(not AllowCreateDirs); 
        lpfn    := @SelectDirCB;
        if Directory <> '' then 
          lParam := Integer(PChar(Directory)); 
      end; 
      WindowList := DisableTaskWindows(0); 
      try 
        ItemIDList := ShBrowseForFolder(BrowseInfo); 
      finally 
        EnableTaskWindows(WindowList); 
      end; 
      Result := ItemIDList <> nil; 
      if Result then 
      begin 
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

function StringToTColor(S : string) : TColor;
var
 I:Integer;
 List:TStringList;
begin
  List := TStringList.Create;
  TRY
    List.CommaText := S;
    if List.Count < 3 then
       Result := clBlack
    else
    begin
       Result:=StrToInt(List[2]) Shl 16 Or
       StrToInt(List[1]) Shl 8 Or
       StrToInt(List[0]);
    end;
  FINALLY
    List.Free;
  END;
end;

function ColorToHTML(AColor:TColor):string;
begin

  AColor:=ColorToRGB(AColor);
  Result:=Format('#%.2x%.2x%.2x',[(AColor) and $FF,
                                  (AColor shr  8) and $FF,
                                  (AColor shr 16) and $FF]);
end;

function HexToInt(HexStr: String): Int64;
var
  RetVar: Int64;
  I: byte;
begin
  HexStr := UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then Delete(HexStr,length(HexStr),1);
  RetVar := 0;

  for I := 1 to length(HexStr) do
  begin
    RetVar := RetVar shl 4;
    if HexStr[i] in ['0'..'9'] then
      RetVar := RetVar + (byte(HexStr[i]) - 48)
    else if HexStr[i] in ['A'..'F'] then
      RetVar := RetVar + (byte(HexStr[i]) - 55)
    else
    begin
      Retvar := 0;
      Break;
    end;
  end;

  Result := RetVar;
end;

function HexToTColor(S : string): TColor;
var
 a:string;
begin
  result:=clBlack;
  if S[1] <> '#' then exit;
  delete(S,1,1);
  if length(S) <> 6 then exit;
  a := inttostr(HexToInt(copy(S,1,2))) + ',' +
  inttostr(HexToInt(copy(S,3,2))) + ',' +
  inttostr(HexToInt(copy(S,5,2)));
  result:=StringToTColor(a);
end;

function compactstring(s:widestring;size:integer):string;
var
  len:integer;
  s1,s2:string;
begin
  len:=length(s);
  if len<=size then begin
    result:=s;
    exit;
  end;
  s1:=copy(s,1,size div 2);
  s2:=copy(s,len-(size div 2),(size div 2)+1);
  result:=s1+'...'+s2;
end;


function makeuniqfilename(s:string):string;
var
  s1,s2,s3:string;
  k:integer;
begin
  s1:=sysutils.ExtractFilePath(s);
  s2:=sysutils.ExtractFileName(s);
  s2:=sysutils.ChangeFileExt(s2,'');
  s3:=sysutils.ExtractFileExt(s);

  k:=1;
  while sysutils.FileExists(s) do begin
    s:=s1+format('%s[%d]%s',[s2,k,s3]);
    inc(k);
  end;
  result:=s;
end;

function ExecuteFile(filename:string; visible:boolean): Boolean;
var
  SUInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  s:string;
begin
  FillChar(SUInfo, SizeOf(SUInfo), #0);
  with SUInfo do begin
     cb := SizeOf(SUInfo);
     dwFlags := STARTF_USESHOWWINDOW;
     if visible then
        wShowWindow := SW_NORMAL
     else
        wShowWindow := SW_HIDE;
//     s:=sysutils.ExtractFilePath(filename);
     createprocess(nil, PChar(filename), nil, nil, False,
        CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
        SUInfo, ProcInfo);
  end;
end;

function GetVersion: string;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
begin
  Result := '';
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  if VerInfoSize = 0 then Exit;
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ 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(VerInfo, VerInfoSize);
end;

function difftime(timestamp:tdatetime):integer;
var
  diff:TDateTime;
  Hour, Min, Sec, MSec: Word;
begin
  diff:=now-timestamp;
  DecodeTime(diff, Hour, Min, Sec, MSec);
  result:=(trunc(diff)*24*60)+(hour*60)+min;
end;

function GetModuleDir: string;
var
  szFileName: array[0..MAX_PATH] of Char;
begin
  FillChar(szFileName, SizeOf(szFileName), #0);
  GetModuleFileName(hInstance, szFileName, MAX_PATH);
  Result := szFileName;
  Result:= sysutils.ExtractFilePath(result);
  if (length(result)>0) and (result[length(result)]<>'\') then
    result:=result+'\';
end;

procedure DrawTransparentBitmap(DC: HDC; hBmp: HBITMAP; xStart, yStart: Integer;
  cTransparentColor: COLORREF);
var
  bm: BITMAP;
  cColor: COLORREF;
  bmAndBack, bmAndObject, bmAndMem, bmSave: HBITMAP;
  bmBackOld, bmObjectOld, bmMemOld, bmSaveOld: HBITMAP;
  hdcMem, hdcBack, hdcObject, hdcTemp, hdcSave: HDC;
  ptSize: TPOINT;
begin
  hdcTemp := CreateCompatibleDC(DC);
  SelectObject(hdcTemp, hBmp);  // Select the bitmap
  GetObject(hBmp, SizeOf(BITMAP), @bm);
  ptSize.x := bm.bmWidth;       // Get width of bitmap
  ptSize.y := bm.bmHeight;      // Get height of bitmap
  DPtoLP(hdcTemp, ptSize, 1);   // Convert from device to logical points
  // Create some DCs to hold temporary data.
  hdcBack := CreateCompatibleDC(DC);
  hdcObject := CreateCompatibleDC(DC);
  hdcMem := CreateCompatibleDC(DC);
  hdcSave := CreateCompatibleDC(DC);
  // Create a bitmap for each DC. DCs are required for a number of GDI functions.
  // Monochrome DC
  bmAndBack := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
  // Monochrome DC
  bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
  bmAndMem := CreateCompatibleBitmap(DC, ptSize.x, ptSize.y);
  bmSave := CreateCompatibleBitmap(DC, ptSize.x, ptSize.y);
  // Each DC must select a bitmap object to store pixel data.
  bmBackOld := SelectObject(hdcBack, bmAndBack);
  bmObjectOld := SelectObject(hdcObject, bmAndObject);
  bmMemOld := SelectObject(hdcMem, bmAndMem);
  bmSaveOld := SelectObject(hdcSave, bmSave);
  // Set proper mapping mode.
  SetMapMode(hdcTemp, GetMapMode(DC));
  // Save the bitmap sent here, because it will be overwritten.
  BitBlt(hdcSave, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);
  // Set the background color of the source DC to the color
  // contained in the parts of the bitmap that should be transparent
  cColor := SetBkColor(hdcTemp, cTransparentColor);
  // Create the object mask for the bitmap by performing a BitBlt
  // from the source bitmap to a monochrome bitmap.
  BitBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);
  // Set the background color of the source DC back to the original color.
  SetBkColor(hdcTemp, cColor);
  // Create the inverse of the object mask.
  BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, NOTSRCCOPY);
  // Copy the background of the main DC to the destination.
  BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, DC, xStart, yStart, SRCCOPY);
  // Mask out the places where the bitmap will be placed.
  BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);
  // Mask out the transparent colored pixels on the bitmap.
  BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
  // XOR the bitmap with the background on the destination DC.
  BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCPAINT);
  // Copy the destination to the screen.
  BitBlt(DC, xStart, yStart, ptSize.x, ptSize.y, hdcMem, 0, 0, SRCCOPY);
  // Place the original bitmap back into the bitmap sent here.
  BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcSave, 0, 0, SRCCOPY);
  // Delete the memory bitmaps.
  DeleteObject(SelectObject(hdcBack, bmBackOld));
  DeleteObject(SelectObject(hdcObject, bmObjectOld));
  DeleteObject(SelectObject(hdcMem, bmMemOld));
  DeleteObject(SelectObject(hdcSave, bmSaveOld));
  // Delete the memory DCs.
  DeleteDC(hdcMem);
  DeleteDC(hdcBack);
  DeleteDC(hdcObject);
  DeleteDC(hdcSave);
  DeleteDC(hdcTemp);
end;

function IsActiveDeskTopOn: Boolean;
var
  h: HWND; 
begin 
  h := FindWindow('Progman', nil); 
  h := FindWindowEx(h, 0, 'SHELLDLL_DefView', nil);
  h := FindWindowEx(h, 0, 'Internet Explorer_Server', nil); 
  Result := h <> 0;
end;

function ChangeWallpaper(aFile: String): Boolean;
const
  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  hObj: IUnknown;
  ADesktop: IActiveDesktop;
  wstr: PWideChar;
begin
  hObj     := CreateComObject(CLSID_ActiveDesktop);
  ADesktop := hObj as IActiveDesktop;
  wstr := AllocMem(MAX_PATH);
  try
    StringToWideChar(aFile, wstr, MAX_PATH);
    ADesktop.SetWallpaper(wstr, 0);
    ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
  finally
    FreeMem(wstr);
  end;
end;

{$IFDEF CONDITIONALEXPRESSIONS}
  {$IF Defined(TOSVersionInfoEx)}
    {$DEFINE TOSVERSIONINFOEX_DEFINED}
  {$IFEND}
{$ENDIF}
{$IFNDEF TOSVERSIONINFOEX_DEFINED}

type
  POSVersionInfoEx = ^TOSVersionInfoEx;
  TOSVersionInfoEx = packed record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion     : DWORD;
    dwMinorVersion     : DWORD;
    dwBuildNumber      : DWORD;
    dwPlatformId       : DWORD;
    szCSDVersion       : array [0..127] of AnsiChar;
    wServicePackMajor  : Word;
    wServicePackMinor  : Word;
    wSuiteMask         : Word;
    wProductType       : Byte;
    wReserved          : Byte;
  end;

const
  VER_SERVER_NT                       = $80000000;
  {$EXTERNALSYM VER_SERVER_NT}
  VER_WORKSTATION_NT                  = $40000000;
  {$EXTERNALSYM VER_WORKSTATION_NT}
  VER_SUITE_SMALLBUSINESS             = $00000001;
  {$EXTERNALSYM VER_SUITE_SMALLBUSINESS}
  VER_SUITE_ENTERPRISE                = $00000002;
  {$EXTERNALSYM VER_SUITE_ENTERPRISE}
  VER_SUITE_BACKOFFICE                = $00000004;
  {$EXTERNALSYM VER_SUITE_BACKOFFICE}
  VER_SUITE_COMMUNICATIONS            = $00000008;
  {$EXTERNALSYM VER_SUITE_COMMUNICATIONS}
  VER_SUITE_TERMINAL                  = $00000010;
  {$EXTERNALSYM VER_SUITE_TERMINAL}
  VER_SUITE_SMALLBUSINESS_RESTRICTED  = $00000020;
  {$EXTERNALSYM VER_SUITE_SMALLBUSINESS_RESTRICTED}
  VER_SUITE_EMBEDDEDNT                = $00000040;
  {$EXTERNALSYM VER_SUITE_EMBEDDEDNT}
  VER_SUITE_DATACENTER                = $00000080;
  {$EXTERNALSYM VER_SUITE_DATACENTER}
  VER_SUITE_SINGLEUSERTS              = $00000100;
  {$EXTERNALSYM VER_SUITE_SINGLEUSERTS}
  VER_SUITE_PERSONAL                  = $00000200;
  {$EXTERNALSYM VER_SUITE_PERSONAL}
  VER_SUITE_BLADE                     = $00000400;
  {$EXTERNALSYM VER_SUITE_BLADE}
  VER_SUITE_EMBEDDED_RESTRICTED       = $00000800;
  {$EXTERNALSYM VER_SUITE_EMBEDDED_RESTRICTED}
  VER_SUITE_SECURITY_APPLIANCE        = $00001000;
  {$EXTERNALSYM VER_SUITE_SECURITY_APPLIANCE}

const
  VER_NT_WORKSTATION              = $0000001;
  {$EXTERNALSYM VER_NT_WORKSTATION}
  VER_NT_DOMAIN_CONTROLLER        = $0000002;
  {$EXTERNALSYM VER_NT_DOMAIN_CONTROLLER}
  VER_NT_SERVER                   = $0000003;
  {$EXTERNALSYM VER_NT_SERVER}

{$ENDIF}  // TOSVERSIONINFOEX_DEFINED


function GetOSVersionInfo(var Info: TOSVersionInfoEx): Boolean;
begin
  FillChar(Info, SizeOf(TOSVersionInfoEx), 0);
  Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
  Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
  if (not Result) then
  begin
    FillChar(Info, SizeOf(TOSVersionInfoEx), 0);
    Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
    Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
    if (not Result) then
      Info.dwOSVersionInfoSize := 0;
  end;
end;

function GetOperatingSystem: Integer;
var
  Info: TOSVersionInfoEx;
  Key: HKEY;
begin
  Result:=cOsUnknown;
  if (not GetOSVersionInfo(Info)) then begin
    Exit;
  end;
  case Info.dwPlatformId of
    { Win32s }
    VER_PLATFORM_WIN32s: ;
    { Windows 9x }
    VER_PLATFORM_WIN32_WINDOWS:
      if (Info.dwMajorVersion = 4) and (Info.dwMinorVersion = 0) then
      begin
        Result:=cOsWin95;
      end
      else if (Info.dwMajorVersion = 4) and (Info.dwMinorVersion = 10) then
      begin
        Result:=cOsWin98;
      end
      else if (Info.dwMajorVersion = 4) and (Info.dwMinorVersion = 90) then begin
        Result:=cOsWinME;
      end;
    { Windows NT }
    VER_PLATFORM_WIN32_NT:
      begin
        { Version }
        if (Info.dwMajorVersion<= 4) then begin
          Result:=cOsWinNT;
        end else if (Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 2) then begin
          Result:=cOsWin2003;
        end else if (Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 1) then begin
          Result:=cOsXP;
        end else if (Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 0) then begin
          Result:=cOsWin2000;
        end else if (Info.dwMajorVersion = 6) and (Info.dwMinorVersion = 0) then begin
          if (Info.wProductType=VER_NT_WORKSTATION) then begin
            Result:=cOsVista;
          end else begin
            Result:=cOsWin2008;
          end;
        end else if (Info.dwMajorVersion = 6) and (Info.dwMinorVersion = 1) then begin
          Result:=cOsWindows7;
        end;

      end;
  end;
end;

function GetSpecialPath(handle:thandle; nfolder:integer):string;
var
  shellMalloc: IMalloc;
  ppidl: PItemIdList;
  PerDir: string;
begin
  ppidl := nil;
  try
    if SHGetMalloc(shellMalloc) = NOERROR then
    begin
      SHGetSpecialFolderLocation(handle, nfolder, ppidl);
      SetLength(Result, MAX_PATH);
      if not SHGetPathFromIDList(ppidl, PChar(Result)) then
        raise exception.create('SHGetPathFromIDList failed : invalid pidl');
      SetLength(Result, lStrLen(PChar(Result)));
    end;
  finally
   if ppidl <> nil then
         shellMalloc.free(ppidl);
  end;
end;

function GetShellPath(nfolder:integer):string;
var
  s:string;
begin
  s:=GetSpecialPath(0,nfolder);
  if (length(s)>0) and (s[length(s)]<>'\') then
    s:=s+'\';
  result:=s;
end;

end.
