new module - rxfileutils - in windows allow to get file owner name

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1072 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/rx/rxfileutils.pas

@@ -0,0 +1,131 @@
+unit rxFileUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils;
+
+function GetFileOwnerUser(const SearchDomain, FileName:String):String;
+procedure GetFileOwnerData(const SearchDomain, FileName:String;out UserName, DomainName:string);
+implementation
+uses
+{$IFDEF WINDOWS}
+   Windows,
+{$ELSE}
+{$ENDIF}
+   FileUtil;
+
+{$IFDEF WINDOWS}
+function LStrError(const Ernum: Longint; const UseUTF8: Boolean = False): string;
+const
+  MAX_ERROR = 1024;
+var
+  Tmp: string;
+  TmpW: widestring;
+begin
+  Result := ' [' + IntToStr(Ernum) + ']: ';
+  if USEUtf8 then begin
+    SetLength(TmpW, MAX_ERROR);
+    SetLength(TmpW, FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM or
+                                   FORMAT_MESSAGE_IGNORE_INSERTS or
+                                   FORMAT_MESSAGE_ARGUMENT_ARRAY,
+                                   nil, Ernum, 0, @TmpW[1], MAX_ERROR, nil));
+    Tmp := UTF8Encode(TmpW);
+  end else begin
+    SetLength(Tmp, MAX_ERROR);
+    SetLength(Tmp, FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
+                                 FORMAT_MESSAGE_IGNORE_INSERTS or
+                                 FORMAT_MESSAGE_ARGUMENT_ARRAY,
+                                 nil, Ernum, 0, @Tmp[1], MAX_ERROR, nil));
+  end;
+  if Length(Tmp) > 2 then
+    Delete(Tmp, Length(Tmp)-1, 2);
+  Result := Result + Tmp;
+end;
+
+{ TODO -oalexs : In future need rewrite this code for fix mem leak }
+
+procedure GetFileNameOwner(const SearchDomain, FileName: String; out UserName, DomainName: string);
+var
+  RCode, RC1:WINBOOL;
+  SDSize:DWORD;      // Size of security descriptor
+
+  FAccountName:PChar;   // Account name
+  lngAccountLen:DWORD;  // Length of account name
+  FDomainName:PChar;    // Domain name
+  lngDomainLen:DWORD;   // Length of domain name
+
+  ptrUse:SID_NAME_USE;         // Pointer to SID_NAME_USE
+  ptrOwner:PSID;
+  P:PByteArray;
+begin
+  ptrOwner:=nil;
+  SDSize:=0;
+  P:=nil;
+  UserName:='';
+  DomainName:='';
+
+  RCode := GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, nil, 0, @SDSize);
+  GetMem(P, SDSize);
+  FillChar(P^, SDSize, 0);
+  RCode := GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, Pointer(P), SDSize, @SDSize);
+  if not RCode then
+    raise Exception.Create(LStrError(GetLastError, true));
+
+  RCode := GetSecurityDescriptorOwner(Pointer(P), ptrOwner, @RC1);
+  if not RCode then
+    raise Exception.Create(LStrError(GetLastError, true));
+
+  lngAccountLen:=0;
+  lngDomainLen:=0;
+  RCode := LookupAccountSid(PChar(SearchDomain), ptrOwner, nil, lngAccountLen, nil, lngDomainLen, ptrUse);
+  //' Configure the strings' buffer sizes
+  GetMem(FAccountName, lngAccountLen);
+  FillChar(FAccountName^, lngAccountLen, 0);
+  GetMem(FDomainName, lngDomainLen);
+  FillChar(FDomainName^, lngDomainLen, 0);
+
+  RCode:=LookupAccountSid(PChar(SearchDomain), ptrOwner, FAccountName, lngAccountLen, FDomainName, lngDomainLen, ptrUse);
+
+  if not RCode then
+    raise Exception.Create(LStrError(GetLastError, true));
+
+  UserName:=FAccountName;
+  DomainName:=FDomainName;
+
+  Freemem(P, SDSize);
+  Freemem(FAccountName, lngAccountLen);
+  Freemem(FDomainName, lngDomainLen);
+end;
+{$ELSE}
+{$ENDIF}
+
+function GetFileOwnerUser(const SearchDomain, FileName: String): String;
+var
+  S:string;
+begin
+  {$IFDEF WINDOWS}
+  GetFileNameOwner(SearchDomain, FileName, Result, S);
+  Result:=UTF8Encode(Result);
+  {$ELSE}
+  Result:='';
+  {$ENDIF}
+end;
+
+procedure GetFileOwnerData(const SearchDomain, FileName: String; out UserName,
+  DomainName: string);
+begin
+  {$IFDEF WINDOWS}
+  GetFileNameOwner(SearchDomain, FileName, UserName, DomainName);
+  UserName:=UTF8Encode(UserName);
+  DomainName:=UTF8Encode(DomainName);
+  {$ELSE}
+  UserName:='';
+  DomainName:='';
+  {$ENDIF}
+end;
+
+end.
+

components/rx/rxnew.lpk

@@ -26,7 +26,7 @@ translate to Lazarus by alexs in 2005 - 2009
     <License Value="free ware
 "/>
     <Version Major="2" Minor="1" Release="1" Build="103"/>
-    <Files Count="54">
+    <Files Count="55">
       <Item1>
         <Filename Value="rxlookup.pas"/>
         <UnitName Value="rxlookup"/>
@@ -245,6 +245,10 @@ translate to Lazarus by alexs in 2005 - 2009
         <Filename Value="rxconst.pas"/>
         <UnitName Value="rxconst"/>
       </Item54>
+      <Item55>
+        <Filename Value="rxfileutils.pas"/>
+        <UnitName Value="rxFileUtils"/>
+      </Item55>
     </Files>
     <LazDoc Paths="docs\"/>
     <i18n>

components/rx/rxnew.pas

@@ -16,7 +16,7 @@ uses
   rxdbgrid_findunit, rxdbgrid_columsunit, rxpopupunit, rxcustomchartpanel, 
   rxsortmemds, AutoPanel, pickdate, rxiconv, rxceEditLookupFields, rxclock, 
   rxspin, RxDBSpinEdit, RegisterRxDB, RxTimeEdit, RxDBTimeEdit, RxDBCtrls, 
-  rxfilterby, rxconst, LazarusPackageIntf;
+  rxfilterby, rxconst, rxFileUtils, LazarusPackageIntf;
 
 implementation