/[lcore]/trunk/unitsettc.pas
ViewVC logotype

Contents of /trunk/unitsettc.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 61 - (show annotations)
Thu Feb 4 22:47:07 2010 UTC (7 years, 10 months ago) by plugwash
File size: 1213 byte(s)
set line ending property on files to hopefully avoid line ending problems in future
1 { Copyright (C) 2005 Bas Steendijk and Peter Green
2 For conditions of distribution and use, see copyright notice in zlib_license.txt
3 which is included in the package
4 ----------------------------------------------------------------------------- }
5
6 unit Unitsettc;
7
8 interface
9
10 procedure settc;
11 procedure unsettc;
12
13 implementation
14
15 uses
16 windows,
17 sysutils;
18
19 var
20 classpriority,threadpriority:integer;
21 refcount:integer=0;
22
23 procedure settc;
24 var
25 hprocess,hthread:integer;
26 begin
27 if (refcount = 0) then begin
28 hProcess := GetCurrentProcess;
29 hThread := GetCurrentThread;
30 ClassPriority := GetPriorityClass(hProcess);
31 ThreadPriority := GetThreadPriority(hThread);
32 SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);
33 SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
34 end;
35 inc(refcount);
36 end;
37
38 procedure unsettc;
39 var
40 hprocess,hthread:integer;
41 begin
42 dec(refcount);
43 if (refcount < 0) then refcount := 0;
44 if (refcount = 0) then begin
45 hProcess := GetCurrentProcess;
46 hThread := GetCurrentThread;
47 SetPriorityClass(hProcess, ClassPriority);
48 SetThreadPriority(hThread, ThreadPriority);
49 end;
50 end;
51
52 end.
53

Properties

Name Value
svn:eol-style CRLF

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.5