1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
| unit UIBAffinity;
// Sources du code :
// http://www.ait-augsburg.de/downloads.htm
// http://nono40.developpez.com/sources/source0051/
//
interface
{$WARN SYMBOL_PLATFORM OFF}
procedure TestMasqueIBServeur(Change,Afficher:Boolean);
implementation
Uses Windows,SysUtils,Dialogs;
Function _AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;
NewState: PTokenPrivileges; BufferLength: DWORD;
PreviousState: Integer; ReturnLength: Integer): BOOL;stdcall; external advapi32 name 'AdjustTokenPrivileges';
Function LoggedSetPrivilege ( hProcess:THANDLE;Droit:String;bEnable:Boolean):Boolean;
Var
Info : TTokenPrivileges;
Token : THandle;
Res : Boolean;
Begin
// Ouverture des droits du compte
Res := OpenProcessToken ( hProcess,TOKEN_ADJUST_PRIVILEGES,Token);
If Not Res Then
Begin
ShowMessage('Ouverture des droits impossible' );
Result:=False;
Exit;
End;
// Enable ou disable?
Info.PrivilegeCount := 1;
If bEnable
Then Info.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
Else Info.Privileges[0].Attributes := 0;
// Obtenir le LUID du droit dont on veut changer l'état.
Res := LookupPrivilegeValue ( Nil,Pchar(Droit),Info.Privileges[0].Luid);
If Not Res Then
Begin
ShowMessage('Impossible d''obtenir le LUID de '+Droit );
Result:=False;
Exit;
End;
// Modification du droit
Res := _AdjustTokenPrivileges ( Token, FALSE,@Info, 0, 0, 0);
If Not Res Then
Begin
ShowMessage('Impossible de modifier le droit, erreur '+IntToStr(GetLastError));
Result:=False;
Exit;
End
Else
Begin
If GetLastError<>ERROR_SUCCESS Then
Begin
ShowMessage('Impossible d''activer le droit '+Droit+', vérifiez la gestion locale des comptes.');
Result:=False;
Exit;
End;
End;
CloseHandle( Token );
Result:=True;
End;
procedure TestMasqueIBServeur(Change,Afficher:Boolean);
var
ProcessHWND : THandle;
ProcessID : DWORD;
ProcessHandle : THandle;
ProcessAffinityMask : DWORD;
SystemAffinityMask : DWORD;
Access : DWord;
Const
process_class_name: string = 'IB_Server';
process_window_name: string = 'InterBase Server';
begin
//check NT is running
if Win32Platform <> VER_PLATFORM_WIN32_NT then
Begin
ShowMessage('Sous Win9X ce test est inutile !');
Exit;
End;
//find running process
ProcessHWND := FindWindow(PChar(process_class_name), PChar(process_window_name));
If ProcessHWND=0 Then
Raise Exception.Create('Le process '+process_class_name+' n''est pas trouvé, vérifier que le serveur est bien lancé !');
//Obtention de l'ID du process
If GetWindowThreadProcessId(ProcessHWND, @ProcessID) = 0 then RaiseLastOSError;
// Il faut demander les droits de 'debug' pour accéder aus infos sur les processeurs
LoggedSetPrivilege(GetCurrentProcess,'SeDebugPrivilege',True);
// get handle of then process
Access := PROCESS_QUERY_INFORMATION;
If Change Then Access := Access or PROCESS_SET_INFORMATION;
ProcessHandle := OpenProcess(Access, false, ProcessID);
if ProcessHandle = 0 then RaiseLastOSError;
try
//query current affinity mask
Win32Check(GetProcessAffinityMask(ProcessHandle, ProcessAffinityMask, SystemAffinityMask));
If Afficher Then
ShowMessage(Format('Masque courants : Système=%d, Process=%d', [SystemAffinityMask , ProcessAffinityMask]));
if Change then
begin
Win32Check(SetProcessAffinityMask(ProcessHandle, 1 and SystemAffinityMask));
If Afficher Then
Begin
Win32Check(GetProcessAffinityMask(ProcessHandle, ProcessAffinityMask, SystemAffinityMask));
ShowMessage(Format('Masque changés : Système=%d, Process=%d', [SystemAffinityMask , ProcessAffinityMask]));
End;
End;
finally
CloseHandle(ProcessHandle);
end;
// On rend en fin les droits de 'debug'
LoggedSetPrivilege(GetCurrentProcess,'SeDebugPrivilege',False);
end;
end. |
Fermeture d'une BDD Interbase, très longue
Répondre avec citation
Envoyé par HASSIOMAR
le close comme le application.terminate ne corrige certainement pas des problèmes de transaction 
Partager