unit MSI_Routines;

interface

uses Windows, Classes;

type
  TOSVersion = (osUnknown, os95, os95OSR2, os98, os98SE, osNT3, osNT4, os2K, osME);

  PWindow = ^TWindow;
  TWindow = record
    ClassName,
    Text :string;
    Handle,
    Process,
    Thread :longword;
    ParentWin,
    WndProc,
    Instance,
    ID,
    UserData,
    Style,
    ExStyle :longint;
    Rect,
    ClientRect :TRect;
    Atom,
    ClassBytes,
    WinBytes,
    ClassWndProc,
    ClassInstance,
    Background,
    Cursor,
    Icon,
    ClassStyle :longword;
    Styles,
    ExStyles,
    ClassStyles :tstringlist;
    Visible :boolean;
  end;

function Bool2YN(b :boolean) :string;
function GetUser :string;
function GetMachine :string;
function GetOS :TOSVersion;
function IsNT: Boolean;
function FormatSeconds(TotalSeconds :comp; WholeSecondsOnly, DisplayAll, DTFormat :Boolean) :string;
function ReadRegInfo(ARoot :hkey; AKey, AValue :string) :string;
function ReadVerInfo(const fn :string; var Desc :string) :string;
function GetClassDevices(AStartKey,AClassName,AValueName :string; var AResult :TStrings) :string;
procedure GetEnvironment(EnvList :tstringlist);
function GetWinSysDir: string;
function GetStrFromBuf(Buffer :pchar) :string;
function GetWindowInfo(wh: hwnd): PWindow;
function ReplaceStr(ASource,AFind,AReplace :string) :string;

var
  ClassKey: string;

const
  DescValue = 'DriverDesc';

implementation

uses
  Registry, SysUtils;

function Bool2YN(b :boolean) :string;
begin
  if b then
    result:='Yes'
  else
    result:='No';
end;

function GetOS;
var
  OS :TOSVersionInfo;
begin
  ZeroMemory(@OS,SizeOf(OS));
  OS.dwOSVersionInfoSize:=SizeOf(OS);
  GetVersionEx(OS);
  Result:=osUnknown;
  if OS.dwPlatformId=VER_PLATFORM_WIN32_NT then begin
    case OS.dwMajorVersion of
      3: Result:=osNT3;
      4: Result:=osNT4;
      5: Result:=os2K;
    end;
  end else begin
    if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=0) then begin
      Result:=os95;
      if (Trim(OS.szCSDVersion)='B') then
        Result:=os95OSR2;
    end else
      if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=10) then begin
        Result:=os98;
        if (Trim(OS.szCSDVersion)='A') then
          Result:=os98SE;
      end;
  end;
end;

function IsNT: boolean;
begin
  Result:=GetOS in [osNT3,osNT4,os2K];
end;

function FormatSeconds(TotalSeconds :comp; WholeSecondsOnly, DisplayAll, DTFormat :Boolean) :String;
var
 lcenturies,lyears,lmonths,lminutes,lhours,ldays,lweeks :word;
 lSecs :double;
 s :array[1..8] of string;
 SecondsPerCentury :comp;
 FS :string;
begin
  if WholeSecondsOnly then
    FS:='%.0f'
  else
    FS:='%.2f';
  SecondsPerCentury:=36550 * 24;
  SecondsPerCentury:= SecondsPerCentury * 3600;
  lcenturies:=Trunc(TotalSeconds / SecondsPerCentury);
  TotalSeconds:=TotalSeconds-(lcenturies * SecondsPerCentury);
  lyears:=Trunc(TotalSeconds / (365.5 * 24 * 3600));
  TotalSeconds:=TotalSeconds-(lyears * (365.5 * 24 * 3600));
  lmonths:=Trunc(TotalSeconds / (31 * 24 * 3600));
  TotalSeconds:=TotalSeconds-(lmonths * (31 * 24 * 3600));
  lweeks:=Trunc(TotalSeconds / (7 * 24 * 3600));
  TotalSeconds:=TotalSeconds-(lweeks * (7 * 24 * 3600));
  ldays:=Trunc(TotalSeconds / (24 * 3600));
  TotalSeconds:=TotalSeconds-(ldays * (24 * 3600));
  lhours:=Trunc(TotalSeconds / 3600);
  TotalSeconds:=TotalSeconds-(lhours * 3600);
  lminutes:=Trunc(TotalSeconds / 60);
  TotalSeconds:=TotalSeconds-(lminutes * 60);
  If WholeSecondsOnly then
    lsecs:=Trunc(TotalSeconds)
  else
    lsecs:=TotalSeconds;
  if lCenturies=1 then
    s[1]:=' Century, '
  else
    s[1]:=' Centuries, ';
  if lyears=1 then
    s[2]:=' Year, '
  else
    s[2]:=' Years, ';
  if lmonths=1 then
    s[3]:=' Month, '
  else
    s[3]:=' Months, ';
  if lweeks=1 then
    s[4]:=' Week, '
  else
    s[4]:=' Weeks, ';
  if ldays=1 then
    s[5]:=' Day, '
  else
    s[5]:=' Days, ';
  if lhours=1 then
    s[6]:=' Hour, '
  else
    s[6]:=' Hours, ';
  if lminutes=1 then
    s[7]:=' Minute, '
  else
    s[7]:=' Minutes, ';
  if lsecs=1 then
    s[8]:=' Second.'
  else
    s[8]:=' Seconds.';
  If DisplayAll then begin
    if dtformat then
      result:=Format('%2.2d.%2.2d.%2.2d %2.2d:%2.2d:%2.2d',
                     [lyears,lmonths,ldays+lweeks*7,lhours,lminutes,round(lSecs)])
    else
      Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
                     [lcenturies,s[1],lyears,s[2],lmonths,s[3],lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lSecs,s[8]]);

  end else begin
    if dtformat then
      result:=Format('%2.2d:%2.2d:%2.2d',
                     [lhours,lminutes,round(lSecs)])
    else begin
      if lCenturies>=1 then
        Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
                        [lcenturies,s[1],lyears,s[2],lmonths,s[3],lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
      else
        if lyears>=1 then
          Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
                          [lyears,s[2],lmonths,s[3],lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
      else
       if lmonths>=1 then
         Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
                         [lmonths,s[3],lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
       else
         if lweeks>=1 then
           Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
                           [lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
         else
           if ldays>=1 then
             Result:= Format('%.0d%s%.0d%s%.0d%s' + FS + '%s',
                             [ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
           else
             if lhours>=1 then
               Result:= Format('%.0d%s%.0d%s' + FS + '%s',
                               [lhours,s[6],lminutes,s[7],lsecs,s[8]])
             else
               if lminutes>=1 then
                 Result:= Format('%.0d%s' + FS + '%s',[lminutes,s[7],lsecs,s[8]])
               else
                 Result:= Format(FS + '%s',[lsecs,s[8]]);
    end;
  end;
end;

function ReadRegInfo(ARoot :hkey; AKey, AValue :string) :string;
begin
  with TRegistry.create do begin
    result:='';
    rootkey:=aroot;
    if keyexists(akey) then begin
      OpenKey(akey,false);
      if ValueExists(avalue) then begin
        case getdatatype(avalue) of
          rdstring: result:=ReadString(avalue);
          rdinteger: result:=inttostr(readinteger(avalue));
        end;
      end;
      closekey;
    end;
    free;
  end;
end;

function ReadVerInfo(const fn :string; var Desc :string) :string;
var
  VersionHandle,VersionSize :dword;
  PItem,PVersionInfo :pointer;
  FixedFileInfo :PVSFixedFileInfo;
  il :uint;
  version :string;
  p :array [0..MAX_PATH - 1] of char;
begin
  version:='';
  desc:='';
  result:='';
  if fn<>'' then begin
    strpcopy(p,fn);
    versionsize:=getfileversioninfosize(p,versionhandle);
    if versionsize=0 then
      exit;
    getMem(pversioninfo,versionsize);
    try
      if getfileversioninfo(p,versionhandle,versionsize,pversioninfo) then begin
        if verqueryvalue(pversioninfo,'\',pointer(fixedfileinfo),il) then
          version:=inttostr(hiword(fixedfileinfo^.dwfileversionms))+
                   '.'+inttostr(loword(fixedfileinfo^.dwfileversionms))+
                   '.'+inttostr(hiword(fixedfileinfo^.dwfileversionls))+
                   '.'+inttostr(loword(fixedfileinfo^.dwfileversionls));
          if verqueryvalue(pversioninfo,pchar('\StringFileInfo\040904E4\FileDescription'),pitem,il) then
            desc:=pchar(pitem);
      end;
    finally
      freeMem(pversioninfo,versionsize);
      result:=version;
    end;
  end;
end;

function GetMachine :string;
var
  n :dword;
  buf :pchar;
const
  rkMachine = {HKEY_LOCAL_MACHINE\}'SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName';
    rvMachine = 'ComputerName';
begin
  n:=255;
  buf:=stralloc(n);
  GetComputerName(buf,n);
  result:=strpas(buf);
  strdispose(buf);
  with TRegistry.Create do begin
    rootkey:=HKEY_LOCAL_MACHINE;
    if OpenKey(rkMachine,false) then begin
      if ValueExists(rvMachine) then
        result:=ReadString(rvMachine);
      closekey;
    end;
    free;
  end;
end;

function GetUser :string;
var
  n :dword;
  buf :pchar;
begin
  n:=255;
  buf:=stralloc(n);
  GetUserName(buf,n);
  result:=strpas(buf);
  strdispose(buf);
end;

function GetClassDevices(AStartKey,AClassName,AValueName :string; var AResult :TStrings) :string;
var
  i,j :integer;
  sl :TStringList;
  s,v,rclass :string;
const
  rvGUID = 'ClassGUID';
  rvClass = 'Class';
  rvLink = 'Link';
begin
  Result:='';
  AResult.Clear;
  with TRegistry.Create do begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey(AStartKey,false) then begin
      sl:=TStringList.Create;
      GetKeyNames(sl);
      CloseKey;
      for i:=0 to sl.Count-1 do
        if OpenKey(AStartKey+'\'+sl[i],false) then begin
          if ValueExists(rvClass) then begin
            rclass:=UpperCase(ReadString(rvClass));
            if rclass=UpperCase(AClassName) then begin
              if not IsNT then begin
                s:=UpperCase(ReadString(rvLink));
                CloseKey;
                if not OpenKey(AStartKey+'\'+s,False) then
                  Exit;
              end else
                s:=sl[i];
              Result:=s;
              GetKeyNames(sl);
              CloseKey;
              for j:=0 to sl.count-1 do
                if OpenKey(AStartKey+'\'+s+'\'+sl[j],false) then begin
                  if ValueExists(AValueName) then begin
                    v:=ReadString(AValueName);
                    if AResult.IndexOf(v)=-1 then
                      AResult.Add(v);
                  end;
                  CloseKey;
                end;
                Break;
            end;
          end;
          CloseKey;
        end;
      sl.free;
    end;
    free;
  end;
end;

procedure GetEnvironment(EnvList :tstringlist);
var
  c,i :dword;
  b :pchar;
  s :string;
begin
  EnvList.Clear;
  c:=1024;
  b:=GetEnvironmentStrings;
  i:=0;
  s:='';
  while i<c do begin
    if b[i]<>#0 then
      s:=s+b[i]
    else begin
      if s='' then
        break;
      EnvList.Add(s);
      s:='';
    end;
    inc(i);
  end;
  FreeEnvironmentStrings(b);
end;

function GetWinSysDir: string;
var
  n: integer;
  p: PChar;
begin
  n:=MAX_PATH;
  p:=stralloc(n);
  getwindowsdirectory(p,n);
  result:=strpas(p)+';';
  getsystemdirectory(p,n);
  Result:=Result+strpas(p)+';';
end;

function GetStrFromBuf(Buffer :pchar) :string;
var
  i,j :integer;
begin
  result:='';
  j:=0;
  i:=0;
  repeat
    if buffer[i]<>#0 then begin
      result:=result+buffer[i];
      j:=0;
    end else
      inc(j);
    inc(i);
  until j>1;
end;

function GetWindowInfo(wh: hwnd): PWindow;
var
  cn,wn :pchar;
  n, wpid,tid :longword;
begin
  n:=255;
  wn:=stralloc(n);
  cn:=stralloc(n);
  tid:=GetWindowThreadProcessId(wh,@wpid);
  getclassname(wh,cn,n);
  getwindowtext(wh,wn,n);
  new(result);
  result^.ClassName:=strpas(cn);
  result^.Text:=strpas(wn);
  result^.Handle:=wh;
  result^.Process:=wpid;
  result^.Thread:=tid;
  result^.ParentWin:=getwindowlong(wh,GWL_HWNDPARENT);
  result^.WndProc:=getwindowlong(wh,GWL_WNDPROC);
  result^.Instance:=getwindowlong(wh,GWL_HINSTANCE);
  result^.ID:=getwindowlong(wh,GWL_ID);
  result^.UserData:=getwindowlong(wh,GWL_USERDATA);
  result^.Style:=getwindowlong(wh,GWL_STYLE);
  result^.ExStyle:=getwindowlong(wh,GWL_EXSTYLE);
  getwindowrect(wh,result^.Rect);
  getclientrect(wh,result^.ClientRect);
  result^.Atom:=getclasslong(wh,GCW_ATOM);
  result^.ClassBytes:=getclasslong(wh,GCL_CBCLSEXTRA);
  result^.WinBytes:=getclasslong(wh,GCL_CBWNDEXTRA);
  result^.ClassWndProc:=getclasslong(wh,GCL_WNDPROC);
  result^.ClassInstance:=getclasslong(wh,GCL_HMODULE);
  result^.Background:=getclasslong(wh,GCL_HBRBACKGROUND);
  result^.Cursor:=getclasslong(wh,GCL_HCURSOR);
  result^.Icon:=getclasslong(wh,GCL_HICON);
  result^.ClassStyle:=getclasslong(wh,GCL_STYLE);
  result^.Styles:=tstringlist.create;
  result^.visible:=iswindowvisible(wh);
  if not(result^.ExStyle and WS_BORDER=0) then
    result^.Styles.add('WS_BORDER');
  if not(result^.Style and WS_CHILD=0) then
    result^.Styles.add('WS_CHILD');
  if not(result^.Style and WS_CLIPCHILDREN=0) then
    result^.Styles.add('WS_CLIPCHILDREN');
  if not(result^.Style and WS_CLIPSIBLINGS=0) then
    result^.Styles.add('WS_CLIPSIBLINGS');
  if not(result^.Style and WS_DISABLED=0) then
    result^.Styles.add('WS_DISABLED');
  if not(result^.Style and WS_DLGFRAME=0) then
    result^.Styles.add('WS_DLGFRAME');
  if not(result^.Style and WS_GROUP=0) then
    result^.Styles.add('WS_GROUP');
  if not(result^.Style and WS_HSCROLL=0) then
    result^.Styles.add('WS_HSCROLL');
  if not(result^.Style and WS_MAXIMIZE=0) then
    result^.Styles.add('WS_MAXIMIZE');
  if not(result^.Style and WS_MAXIMIZEBOX=0) then
    result^.Styles.add('WS_MAXIMIZEBOX');
  if not(result^.Style and WS_MINIMIZE=0) then
    result^.Styles.add('WS_MINIMIZE');
  if not(result^.Style and WS_MINIMIZEBOX=0) then
    result^.Styles.add('WS_MINIMIZEBOX');
  if not(result^.Style and WS_OVERLAPPED=0) then
    result^.Styles.add('WS_OVERLAPPED');
  if not(result^.Style and WS_POPUP=0) then
    result^.Styles.add('WS_POPUP');
  if not(result^.Style and WS_SYSMENU=0) then
    result^.Styles.add('WS_SYSMENU');
  if not(result^.Style and WS_TABSTOP=0) then
    result^.Styles.add('WS_TABSTOP');
  if not(result^.Style and WS_THICKFRAME=0) then
    result^.Styles.add('WS_THICKFRAME');
  if not(result^.Style and WS_VISIBLE=0) then
    result^.Styles.add('WS_VISIBLE');
  if not(result^.Style and WS_VSCROLL=0) then
    result^.Styles.add('WS_VSCROLL');
  result^.ExStyles:=tstringlist.create;
  if not(result^.ExStyle and WS_EX_ACCEPTFILES=0) then
    result^.ExStyles.add('WS_EX_ACCEPTFILES');
  if not(result^.ExStyle and WS_EX_DLGMODALFRAME=0) then
    result^.ExStyles.add('WS_EX_DLGMODALFRAME');
  if not(result^.ExStyle and WS_EX_NOPARENTNOTIFY=0) then
    result^.ExStyles.add('WS_EX_NOPARENTNOTIFY');
  if not(result^.ExStyle and WS_EX_TOPMOST=0) then
    result^.ExStyles.add('WS_EX_TOPMOST');
  if not(result^.ExStyle and WS_EX_TRANSPARENT=0) then
    result^.ExStyles.add('WS_EX_TRANSPARENT');
  if not(result^.ExStyle and WS_EX_MDICHILD=0) then
    result^.ExStyles.add('WS_EX_MDICHILD');
  if not(result^.ExStyle and WS_EX_TOOLWINDOW=0) then
    result^.ExStyles.add('WS_EX_TOOLWINDOW');
  if not(result^.ExStyle and WS_EX_WINDOWEDGE=0) then
    result^.ExStyles.add('WS_EX_WINDOWEDGE');
  if not(result^.ExStyle and WS_EX_CLIENTEDGE =0) then
    result^.ExStyles.add('WS_EX_CLIENTEDGE');
  if not(result^.ExStyle and WS_EX_CONTEXTHELP=0) then
    result^.ExStyles.add('WS_EX_CONTEXTHELP');
  if not(result^.ExStyle and WS_EX_RIGHT=0) then
    result^.ExStyles.add('WS_EX_RIGHT')
  else
    result^.ExStyles.add('WS_EX_LEFT');
  if not(result^.ExStyle and WS_EX_RTLREADING=0) then
    result^.ExStyles.add('WS_EX_RTLREADING')
  else
    result^.ExStyles.add('WS_EX_LTRREADING');
  if not(result^.ExStyle and WS_EX_LEFTSCROLLBAR=0) then
    result^.ExStyles.add('WS_EX_LEFTSCROLLBAR')
  else
    result^.ExStyles.add('WS_EX_RIGHTSCROLLBAR');
  if not(result^.ExStyle and WS_EX_CONTROLPARENT=0) then
    result^.ExStyles.add('WS_EX_CONTROLPARENT');
  if not(result^.ExStyle and WS_EX_STATICEDGE =0) then
    result^.ExStyles.add('WS_EX_STATICEDGE');
  if not(result^.ExStyle and WS_EX_APPWINDOW=0) then
    result^.ExStyles.add('WS_EX_APPWINDOW');
  result^.ClassStyles:=tstringlist.create;
  if not(result^.ClassStyle and CS_BYTEALIGNCLIENT=0) then
    result^.ClassStyles.add('CS_BYTEALIGNCLIENT');
  if not(result^.ClassStyle and CS_VREDRAW=0) then
    result^.ClassStyles.add('CS_VREDRAW');
  if not(result^.ClassStyle and CS_HREDRAW=0) then
    result^.ClassStyles.add('CS_HREDRAW');
  if not(result^.ClassStyle and CS_KEYCVTWINDOW=0) then
    result^.ClassStyles.add('CS_KEYCVTWINDOW');
  if not(result^.ClassStyle and CS_DBLCLKS=0) then
    result^.ClassStyles.add('CS_DBLCLKS');
  if not(result^.ClassStyle and CS_OWNDC=0) then
    result^.ClassStyles.add('CS_OWNDC');
  if not(result^.ClassStyle and CS_CLASSDC=0) then
    result^.ClassStyles.add('CS_CLASSDC');
  if not(result^.ClassStyle and CS_PARENTDC=0) then
    result^.ClassStyles.add('CS_PARENTDC');
  if not(result^.ClassStyle and CS_NOKEYCVT=0) then
    result^.ClassStyles.add('CS_NOKEYCVT');
  if not(result^.ClassStyle and CS_NOCLOSE=0) then
    result^.ClassStyles.add('CS_NOCLOSE');
  if not(result^.ClassStyle and CS_SAVEBITS=0) then
    result^.ClassStyles.add('CS_SAVEBITS');
  if not(result^.ClassStyle and CS_BYTEALIGNWINDOW=0) then
    result^.ClassStyles.add('CS_BYTEALIGNWINDOW');
  if not(result^.ClassStyle and CS_GLOBALCLASS=0) then
    result^.ClassStyles.add('CS_GLOBALCLASS');
  strdispose(wn);
  strdispose(cn);
end;

function ReplaceStr;
var
  p :integer;
begin
  result:='';
  p:=pos(uppercase(AFind),uppercase(ASource));
  while p>0 do begin
    result:=result+Copy(ASource,1,p-1)+AReplace;
    Delete(ASource,1,p+Length(AFind)-1);
    p:=pos(uppercase(AFind),uppercase(ASource));
  end;
  Result:=Result+ASource;
end;


end.