{/* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1/GPL 2.0/LGPL 2.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* Original author:
* - Pavel Cvrcek <jasnapaka@jasnapaka.com>
*
* Contributor(s):
*
* Alternatively, the contents of this file may be used under the terms of
* either of the GNU General Public License Version 2 or later (the "GPL"),
* or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
* in which case the provisions of the GPL or the LGPL are applicable instead
* of those above. If you wish to allow use of your version of this file only
* under the terms of either the GPL or the LGPL, and not to allow others to
* use your version of this file under the terms of the MPL, indicate your
* decision by deleting the provisions above and replace them with the notice
* and other provisions required by the GPL or the LGPL. If you do not delete
* the provisions above, a recipient may use your version of this file under
* the terms of any one of the MPL, the GPL or the LGPL.
*
* ***** END LICENSE BLOCK ***** */}

unit WinUtils;

interface

uses Classes, Graphics;

// ** Public deklarace

// vrati seznam bezicich procesu
function GetProcessList: TStringList;
// vrati seznam bezicich procesu pod NT
function GetProcessListNT: TStringList;
// vraci cestu ke slozkam Windows
function GetSpecialDir (id: byte): string;
// otevre okno Windows Exploreru 
procedure OpenExplorer (Cesta: string);
// vrati verzi Windows
function OSVersion: byte;
// ziskat adresar, kde jsou nainstalovana Windows
function GetWindowsDir: string;

implementation

uses Forms, Registry, psapi, SysUtils, ShellApi, shlObj, Tlhelp32, Windows, WinSock;


//******************************************************************************
// ** Privatni procedury a funkce
//******************************************************************************


//******************************************************************************
// function GetTempDir
//
// - vraci cestu ke slozce Temp
//******************************************************************************

function GetTempDir: string;
var nbufferLength : DWord;
    lpBuffer : PChar;
begin
  nBufferLength := Max_path + 1;
  GetMem (lpBuffer, nBufferLength);
  try
    if GetTempPath(nBufferLength, lpBuffer) <> 0 then
    Result := StrPas(lpBuffer)
    else Result := '';
  finally
    FreeMem(lpBuffer);
  end;
end;


//******************************************************************************
// function GetWindowsDir
//
// - vraci adresar, kde jsou nainstalovany Windows
//******************************************************************************

function GetWindowsDir: string;
var WindowDir : array[0..255] of Char;
begin
  GetWindowsDirectory(WindowDir, 255);
  Result := StrPas(WindowDir);
end;


//******************************************************************************
// ** Public procedury a funkce
//******************************************************************************


//******************************************************************************
// function GetProcessList
//
// - vrati seznam spustenych procesu
//******************************************************************************

function GetProcessList: TStringList;
var hSnapShot : THandle;
    pe32 : TPROCESSENTRY32;
    StringList: TStringList;
begin
  StringList:= TStringList.Create;
  hSnapShot := CreateToolHelp32SnapShot(TH32cs_snapprocess,0);
  pe32.dwSize := SizeOf(TPROCESSENTRY32);
  if Process32First(hSnapShot, pe32) then StringList.Add(extractFileName(pe32.szExeFile));
  while Process32Next(hSnapShot, pe32) do
  begin
    StringList.Add(extractFileName(pe32.szExeFile));
  end;
  CloseHandle (hSnapShot);
  Result:= StringList;
end;


//******************************************************************************
// function GetProcessListNT
//
// - vrati seznam spustenych procesu pod NT
//******************************************************************************

function GetProcessListNT: TStringList;

  function ProcessFileName(PID: DWORD): string;
  var
    Handle: THandle;
    Fullpath: boolean;
  begin
    Result := ''; Fullpath:= false;
    Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
    if Handle <> 0 then
    try
      SetLength(Result, MAX_PATH);
      if FullPath then
      begin
        if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
          SetLength(Result, StrLen(PChar(Result)))
        else
          Result := '';
      end
      else
      begin
        if GetModuleBaseNameA(Handle, 0, PChar(Result), MAX_PATH) > 0 then
          SetLength(Result, StrLen(PChar(Result)))
        else
          Result := '';
      end;
    finally
      CloseHandle(Handle);
    end;
  end;
  
var
    PIDs: array [0..1024] of DWORD;
    Needed: DWORD;
    I: Integer;
    StringList: TStringList;

begin
  StringList:= TStringList.Create;
  if EnumProcesses(@PIDs, SizeOf(PIDs), Needed) then
    begin
      for I := 0 to (Needed div SizeOf(DWORD)) - 1 do
        begin
          StringList.Add (ProcessFileName(PIDs[I]));
        end;
    end;
  Result:= StringList;
end;


//******************************************************************************
// function GetSpecialDir
//
// - vraci cestu ke specialnim adresarum Windows
//
// Vstup: id - ciselne vyjadreni adresare
// Vystup: - cesta k danemu adresari
//******************************************************************************

function GetSpecialDir (id: byte): string;
var gFolder : Integer;
    SFolder : pItemIDList;
    SpecialPath : Array[0..MAX_PATH] of Char;
begin
  gFolder:= 0;
  case id of
    1: gFolder:= CSIDL_DESKTOP;                         // Desktop
    2: gFolder:= CSIDL_PERSONAL;                        // Dokumenty
    3: gFolder:= CSIDL_FAVORITES;                       // Oblibene
    4: gFolder:= CSIDL_FONTS;                           // Fonty
    5: gFolder:= CSIDL_NETHOOD;                         // Okolni pocitace
    6: gFolder:= CSIDL_PROGRAMS;                        // Programy
    7: gFolder:= CSIDL_STARTUP;                         // Po spusteni
    8: gFolder:= CSIDL_RECENT;                          // Recent
    9: gFolder:= CSIDL_SENDTO;                          // SendTo
    10: gFolder:= CSIDL_STARTMENU;                      // Start
    11: gFolder:= CSIDL_APPDATA;                        // Data aplikaci
    12: gFolder:= CSIDL_COOKIES;                        // Cookies
    13: gFolder:= CSIDL_INTERNET_CACHE;                 // Internet Cache
    14: gFolder:= CSIDL_HISTORY;                        // Historie
    16: gFolder:= CSIDL_TEMPLATES;                      // Templates
    17: gFolder:= CSIDL_COMMON_DESKTOPDIRECTORY;        // Sdileny Desktop
    18: gFolder:= CSIDL_COMMON_FAVORITES;               // Sdilene Oblibene
    19: gFolder:= CSIDL_COMMON_STARTMENU;               // Sdileny Start
    20: gFolder:= CSIDL_COMMON_PROGRAMS;                // Sdileny Programy
    21: gFolder:= CSIDL_COMMON_STARTUP;                 // Sdileny Po spusteni
    else Result:= '';
  end;

  if (id <> 0) and (id <> 15) and (id <= 21) then
    begin
      SHGetSpecialFolderLocation(Application.Handle, gFolder, SFolder);
      SHGetPathFromIDList(SFolder, SpecialPath);
      Result:= StrPas(SpecialPath);
    end;
  if (id = 0) then Result:= GetWindowsDir;              // adresar Windows
  if (id = 15) then Result:= GetTempDir;                // Temp
  if (id = 22) then Result:= '';                        // nesmysl
end;


//******************************************************************************
// procedure OpenExplorer
//
// - otevre okno Windows Exploreru v pozadovanem adresari
//
// Vstup: Cesta - cesta k adresari
//******************************************************************************

procedure OpenExplorer (Cesta: string);
begin
  ShellExecute (Application.handle, 'explore', Pchar (Cesta), Nil, Nil, SW_SHOWNORMAL );
end;


//******************************************************************************
// function OSVersion
//
// - vrati verzi Windows
//******************************************************************************

function OSVersion: byte;
var OS : TOSVersionInfo;
begin
  OS.dwOSVersionInfoSize := SizeOf(OS);
  GetVersionEx(Os);
  case OS.dwPlatformId of
    VER_PLATFORM_WIN32S : Result:= 0;                           // Windows 3.1
    VER_PLATFORM_WIN32_WINDOWS :
    case Os.dwMinorVersion of
      0..9 : begin
               if trim(Os.szCSDVersion) = 'B' then  Result:= 1  // Windows 95 OSR2
               else Result:= 2;                                 // Windows 95
             end;
    10..89 : begin
               if trim(Os.szCSDVersion) = 'A' then Result:= 4   // Windows 98 SE
               else Result:= 3;                                 // Windows 98
             end;
        90 : Result:= 5;                                        // Windows ME
     end;
    VER_PLATFORM_WIN32_NT :
    case OS.dwMajorVersion of
         3 : Result:= 6;                                        // Windows NT 3
         4 : Result:= 7;                                        // Windows NT 4
         5 : begin
               case OS.dwMinorVersion of
                    0 : Result:= 8;                             // Windows 2000
                    1 : Result:= 9;                             // Windows XP
                    2 : Result:= 10;                            // Windows 2003
               end;
             end;
         6: Result:= 11;                                        // Windows Vista
     end;
  end;
end;

{ Function returns string 'FAT' or 'NTFS' in dependence on which file system
  is used on disc which is input as a parameter. 
}
function GetHardDiskPartitionType(const DriveLetter: Char): string;
var
  NotUsed: DWORD;
  VolumeFlags: DWORD;
  VolumeInfo: array[0..MAX_PATH] of Char;
  VolumeSerialNumber: DWORD;
  PartitionType: array[0..32] of Char;
begin
  GetVolumeInformation(PChar(DriveLetter + ':\'),
    nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
    VolumeFlags, PartitionType, 32);
  Result := PartitionType;
end;

end.
