🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: borland.public.interbase.opensource
Article #88

Re: Hyperthreading

#88
From: Olivier Pons
Date: Fri, 26 Jan 2007 08:36
278 lines
9463 bytes
There's a utility that works perfectly here. Here's the source code : 
just compile, then run it ;)
------------------------------------------------------------------------------------------------------------------------------------------------
What is IB_AFFINITY for?

------------------------

IB_AFFINITY is a console mode program that you can use to control the 
affinity
mask of the running IBServer.exe process. That means you can predict on 
which
processor in your multiprocessor machine IBServer is allowed to run.

IB_AFFINITY does run on Windows NT only, not on Win-9x where multiple
processors aren't supported anyway. The program was compiled with 
Delphi-4 (UP3)
  and tested on Windows NT-4 (SP5) with IB5.5.

Command line switches:

----------------------

-Q Query current affinity mask

Display the current affinity mask of IBServer.exe and the entire system 
before
change.

-An New Affinity mask n (decimal) to set

(n AND system_mask) is the new mask to apply.

-N Dont try to enable SeDebugPrivilege

When you want to change the affinity mask of IBServer runnin as NT 
service, you
need the debug privilege. The Administrator account has this privilege by
default. IB_AFFINITY tries to enable this privilege unless you specify 
-N. If
you don't have the debug privilege you can for example use -Q -N to 
query the
masks without changing them or you can use -An -N to change the

affinity mask of IBServer running as taskbar program.

-Rn,m Retry up to n times with m milliseconds delay to locate IBServer This
option is useful in batches that start IBServer or IBGuardian and modify the
affinity mask of IBServer immediately after. Under high load NT might 
not have
finished to create the IBServer process when IB_AFFINITY starts. The retry
option is useful to wait for the IBServer process to be instanciated. An 
value
of -R10,10000 is recommended, but will of course delay the return of 
this tool
by 100 seconds if IBServer is really not started.

Example 1:

----------

C:\> IB_AFFINITY -Q

Current affinity mask: System=15, IBServer=15

This means you have four system processors installed (15 dec = 1111 bin) and
IBServer is allowed to utilize all four processors.

Example 2:

----------

C:\> IB_AFFINITY -Q -A12

Current affinity mask: System=15, IBServer=15

Affinity mask set to 12

C:\> IB_AFFINITY -Q

Current affinity mask: System=15, IBServer=12

This changes the affinity mask of the IBServer process to 12 (= 1100 
bin), so
the process is allowed to run on the system processors 3 and 4.

Disclaimer:

-----------

IB_AFFINITY is freeware. The sourcecode is available. It comes to you AS-IS.
Use it or do not use it, but if you use is, you do it on your own risk.

Author: Karsten Strobel

email : ait-augsburg@t-online.de

Date : 26-JUN-1999


------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

program IB_AFFINITY;

{$APPTYPE CONSOLE}

{ Compiled with Delphi4 (UP3) }

uses Windows, Sysutils;

var
   MaskToSet: Integer = 0;
   SetMask: Boolean = false;
   QueryMask: Boolean = false;
   NoDebugPrivilege: Boolean = false;
   ib_hwnd: THandle = 0;
   ib_processid: DWORD = 0;
   ib_processh: THandle = 0;
   own_token: THandle = 0;
   process_affmask: DWORD = 0;
   sys_affmask: DWORD = 0;
   RetryCountdown: Integer = 0;
   RetryDelay: Integer = 0;

function EnumWindowsProc(hwnd: THandle; lParam: DWORD): Boolean; stdcall;
var
   s: string;
   i: Integer;
begin
   SetLength(s, 256);
   i := GetWindowText(hwnd, @(s[1]), 256);
   SetLength(s, i);
   Result := s <> 'InterBase Server';
   if not Result then ib_hwnd := hwnd;
end;

function MyAdjustTokenPrivileges(TokenHandle: THandle; 
DisableAllPrivileges: BOOL;
   const NewState: TTokenPrivileges; BufferLength: DWORD;
   PreviousState: PTokenPrivileges; ReturnLength: PDWORD): BOOL; stdcall;
   external advapi32 name 'AdjustTokenPrivileges';

function EnablePrivilege(h: THandle; AName: string; AState: Boolean): 
Boolean;
var
   tp: TTokenPrivileges;
begin
   Result := false;
   if not LookupPrivilegeValue(nil, PChar(AName), tp.Privileges[0].Luid) 
then Exit;
   tp.PrivilegeCount := 1;
   if AState then tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
             else tp.Privileges[0].Attributes := 0;
   Result := MyAdjustTokenPrivileges(h, false, tp, SizeOf(tp), nil, nil);
end;

procedure PrintHelp;
begin
   writeln('With IB_AFFINITY you can control the affinity mask of the 
IBServer process.');
   writeln('IB_AFFINITY is freeware and comes AS-IS. Use it on your own 
risk.');
   writeln('IB_AFFINITY has been tested with Interbase V5.5 on Windows 
NT4.');
   writeln('V1.1, Author: Karsten Strobel');
   writeln;
   writeln('Available switches:');
   writeln('   -Q     Query current affinity mask');
   writeln('   -An    New Affinity mask n (decimal) to set');
   writeln('   -N     Don''t try to enable SeDebugPrivilege');
   writeln('   -Rn,m  Retry up to n times with m millisec. delay to 
locate IBServer');
   writeln;
   Halt(1);
end;

var
   i, j, k: Integer;
   s: string;
begin
   try
     //eval cmdline switches
     for i := 1 to ParamCount do
     begin
       s := UpperCase(ParamStr(i));
       if s[1] <> '-' then PrintHelp;
       case s[2] of
         'A': begin
           Delete(s, 1, 2);
           MaskToSet := StrToIntDef(s, -1);
           if (MaskToSet <= 0) or SetMask then PrintHelp;
           SetMask := true;
         end;
         'Q': begin
           if (Length(s) > 2) or QueryMask then PrintHelp;
           QueryMask := true;
         end;
         'N': begin
           if (Length(s) > 2) or NoDebugPrivilege then PrintHelp;
           NoDebugPrivilege := true;
         end;
         'R': begin
           Delete(s, 1, 2);
           k := Pos(',', s);
           if k = 0 then PrintHelp;
           j := StrToIntDef(copy(s, 1, k-1), -1);
           k := StrToIntDef(copy(s, k+1, Length(s)), -1);
           if (j <= 0) or (k < 0) or (RetryCountdown > 0) then PrintHelp;
           RetryCountdown := j;
           RetryDelay := k;
         end;
       else
         PrintHelp;
       end;
     end;
     if not (SetMask or QueryMask) then PrintHelp;

     //check NT is running
     if Win32Platform <> VER_PLATFORM_WIN32_NT then
       raise Exception.Create('IB_AFFINITY requires Windows NT.');

     //find running IBServer
     repeat
       EnumWindows(@EnumWindowsProc, 0);
       if (ib_hwnd <> 0) or (RetryCountdown <= 0) then system.break;
       Sleep(RetryDelay);
       Dec(RetryCountdown);
     until false;

     if ib_hwnd = 0 then
       raise Exception.Create('Unable to find IBServer process. Not 
running?');
     if GetWindowThreadProcessId(ib_hwnd, @ib_processid) = 0 then 
RaiseLastWin32Error;

     //enable SeDebugPrivilege
     //(needed to be able to set affinity mask if IBServer runs as 
service using the system account)
     if not NoDebugPrivilege then
     begin
       Win32Check(OpenProcessToken(GetCurrentProcess, 
TOKEN_ADJUST_PRIVILEGES, own_token));
       Win32Check(EnablePrivilege(own_token, 'SeDebugPrivilege', true));
     end;

     //get handle of IBServer process
     i := PROCESS_QUERY_INFORMATION;
     if SetMask then i := i or PROCESS_SET_INFORMATION;
     ib_processh := OpenProcess(i, false, ib_processid);
     if ib_processh = 0 then RaiseLastWin32Error;
     try
       //query current affinity mask
       Win32Check(GetProcessAffinityMask(ib_processh, process_affmask, 
sys_affmask));
       if QueryMask then
         writeln(Format('Current affinity mask: System=%d, IBServer=%d', 
[sys_affmask, process_affmask]));
       //set new affinity mask
       if SetMask then
       begin
         Win32Check(SetProcessAffinityMask(ib_processh, MaskToSet and 
sys_affmask));
         writeln(Format('Affinity mask set to %d', [MaskToSet and 
sys_affmask]));
       end;
     finally
       CloseHandle(ib_processh);
     end;

   except
     on E:Exception do
     begin
       s := E.Message + #13#10;
       WriteFile(GetStdHandle(STD_ERROR_HANDLE), s[1], Length(s), 
DWORD(i), nil);
       ExitCode := 1;
     end;
   end;
end.
Technical Details
Message-ID: <45b9bd4b$1@newsgroups.borland.com>
Path: arc1-ca.pugleaf.net!g2news2.google.com!news4.google.com!border1.nntp.dca.giganews.com!nntp.giganews.com!newsfeed00.sul.t-online.de!newsfeed01.sul.t-online.de!t-online.de!newsgroups.borland.com!not-for-mail
References: <456a222e$1@newsgroups.borland.com>

Show Full Headers
Complete Article Headers
X-Google-Thread: 106772,f78f837bc5070ca6
X-Google-Attributes: gid106772,public
X-Google-Language: ENGLISH,ASCII-7-bit
Date: Fri, 26 Jan 2007 09:36:11 +0100
From: Olivier Pons <olivier.dot.pons.at.gmaildot.com@ignore.this.fr>
User-Agent: Thunderbird 1.5.0.9 (Windows/20061207)
MIME-Version: 1.0
Newsgroups: borland.public.interbase.opensource
Subject: Re: Hyperthreading
References: <456a222e$1@newsgroups.borland.com>
In-Reply-To: <456a222e$1@newsgroups.borland.com>
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
NNTP-Posting-Host: 193.251.47.182
Message-ID: <45b9bd4b$1@newsgroups.borland.com>
X-Trace: newsgroups.borland.com 1169800523 193.251.47.182 (26 Jan 2007 00:35:23 -0800)
Lines: 278
Path: arc1-ca.pugleaf.net!g2news2.google.com!news4.google.com!border1.nntp.dca.giganews.com!nntp.giganews.com!newsfeed00.sul.t-online.de!newsfeed01.sul.t-online.de!t-online.de!newsgroups.borland.com!not-for-mail