Roberto, show de bola sua dica, parabéns!!.
DEUS É PAI.
[]'s
Allan
msn [EMAIL PROTECTED]
Skype allan_gabriel
----- Original Message -----
From: JJW Informática Ltda. - Roberto
To: delphi-br@yahoogrupos.com.br
Sent: Monday, August 21, 2006 5:00 PM
Subject: Re: [delphi-br] Travar Sistema
uses
Forms,
Classes,
SysUtils,
Windows,
Controls,
Psapi,
tlhelp32;
type
TJJWProcessInformation = record
FileName: string;
Path: string;
end;
TJJWProcessList = array of TJJWProcessInformation;
// retira a lista de processos de do windows 98
procedure CreateWin9xProcessList(var AList: TJJWProcessList);
var
hSnapShot: THandle;
ProcInfo: TProcessEntry32;
I: Integer;
begin
SetLength(AList, 0);
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if (Process32First(hSnapshot, ProcInfo)) then
begin
I := Length(AList);
SetLength(AList, I +1);
AList[I].FileName := ExtractFileName(ProcInfo.szExeFile);
AList[I].Path := ExtractFilePath(ProcInfo.szExeFile);
while (Process32Next(hSnapShot, ProcInfo)) do
begin
I := Length(AList);
SetLength(AList, I +1);
AList[I].FileName := ExtractFileName(ProcInfo.szExeFile);
AList[I].Path := ExtractFilePath(ProcInfo.szExeFile);
end;
end;
CloseHandle(hSnapShot);
end;
end;
// retira a lista de processos do windows NT/2000/XP/2003
procedure CreateWinNTProcessList(var AList: TJJWProcessList);
type
PTOKEN_USER = ^TOKEN_USER;
_TOKEN_USER = record
User: TSidAndAttributes;
end;
TOKEN_USER = _TOKEN_USER;
// retorna o domínio e usuário dono de um processo
function GetUserAndDomainFromPID(ProcessId: DWORD;
var User, Domain: string): Boolean;
var
hToken: THandle;
cbBuf: Cardinal;
ptiUser: PTOKEN_USER;
snu: SID_NAME_USE;
ProcessHandle: THandle;
UserSize, DomainSize: DWORD;
bSuccess: Boolean;
begin
Result := False;
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
if ProcessHandle <> 0 then
begin
// EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True);
if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then
begin
bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
ptiUser := nil;
while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
begin
ReallocMem(ptiUser, cbBuf);
bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf,
cbBuf);
end;
CloseHandle(hToken);
if not bSuccess then
Exit;
UserSize := 0;
DomainSize := 0;
LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil,
DomainSize, snu);
if (UserSize <> 0) and (DomainSize <> 0) then
begin
SetLength(User, UserSize);
SetLength(Domain, DomainSize);
if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize,
PChar(Domain), DomainSize, snu) then
begin
Result := True;
User := StrPas(PChar(User));
Domain := StrPas(PChar(Domain));
end;
end;
if bSuccess then
begin
FreeMem(ptiUser);
end;
end;
CloseHandle(ProcessHandle);
end;
end;
// retorna o nome do usuário logado atualmente
function _GetUserName : string;
const
MAX_USER_NAME_LEN = 254;
var
UserName: string;
UserNameLen: DWORD;
begin
UserNameLen := MAX_USER_NAME_LEN - 1;
SetLength(UserName, MAX_USER_NAME_LEN);
if GetUserName(PChar(UserName), UserNameLen) then
Result := Copy(UserName, 1, UserNameLen -1)
else
Result := EmptyStr;
end;
var
PIDArray: array [0..1023] of DWORD;
cb: DWORD;
I, J: Integer;
ProcCount: Integer;
hMod: HMODULE;
hProcess: THandle;
ModuleName: array [0..300] of Char;
User, Domain, CurrentUser: string;
begin
CurrentUser := _GetUserName;
EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
ProcCount := cb div SizeOf(DWORD);
for I := 0 to ProcCount - 1 do
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
False,
PIDArray[I]);
if (hProcess <> 0) then
begin
GetUserAndDomainFromPID(PIDArray[I], User, Domain);
EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
if AnsiSameText(User, CurrentUser) then
begin
J := Length(AList);
SetLength(AList, J +1);
AList[J].FileName := ExtractFileName(ModuleName);
AList[J].Path := ExtractFilePath(ModuleName);
end;
CloseHandle(hProcess);
end;
end;
end;
// retira a lista de processos independente da versão do windows
procedure GetProcessList(var AList: TJJWProcessList);
var
ovi: TOSVersionInfo;
begin
ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(ovi);
case ovi.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(AList);
VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(AList);
end
end;
------- USANDO -------------
GetProcessList(ProcessList);
Count := 0;
for I := Low(ProcessList) to High(ProcessList) do
if AnsiSameText(ProcessList[I].FileName, ExtractFileName(ParamStr(0)))
then
Inc(Count);
Count irá guardar quantas instâncias do seu sistema estão abertas. coloque
esse código no seu DPR para fazer a verificação q necessita
[As partes desta mensagem que não continham texto foram removidas]
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
<*> Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
<*> Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
