Get Current User's SID

...Retrieve the current user's SID?

Author: Yorai Aminov 
Homepage: http://www.shorterpath.com 

Category: System

(******************************************************************************)
(* SPGetSid - Retrieve the current user's SID in text format                  *)
(*                                                                            *)
(* Copyright (c) 2004 Shorter Path Software                                   *)
(* http://www.shorterpath.com                                                 *)
(******************************************************************************)


{
  SID is a data structure of variable length that identifies user, group,
  and computer accounts.
  Every account on a network is issued a unique SID when the account is first created.
  Internal processes in Windows refer to an account's SID
  rather than the account's user or group name.
}


unit SPGetSid;

interface

uses
  Windows, SysUtils;

function GetCurrentUserSid: string;

implementation

const
  HEAP_ZERO_MEMORY = $00000008;
  SID_REVISION     = 1; // Current revision level

type
  PTokenUser = ^TTokenUser;
  TTokenUser = packed record
    User: TSidAndAttributes;
  end;

function ConvertSid(Sid: PSID; pszSidText: PChar; var dwBufferLen: DWORD): BOOL;
var
  psia: PSIDIdentifierAuthority;
  dwSubAuthorities: DWORD;
  dwSidRev: DWORD;
  dwCounter: DWORD;
  dwSidSize: DWORD;
begin
  Result := False;

  dwSidRev := SID_REVISION;

  if not IsValidSid(Sid) then Exit;

  psia := GetSidIdentifierAuthority(Sid);

  dwSubAuthorities := GetSidSubAuthorityCount(Sid)^;

  dwSidSize := (15 + 12 + (12 * dwSubAuthorities) + 1) * SizeOf(Char);

  if (dwBufferLen < dwSidSize) then
  begin
    dwBufferLen := dwSidSize;
    SetLastError(ERROR_INSUFFICIENT_BUFFER);
    Exit;
  end;

  StrFmt(pszSidText, 'S-%u-', [dwSidRev]);

  if (psia.Value[0] <> 0) or (psia.Value[1] <> 0) then
    StrFmt(pszSidText + StrLen(pszSidText),
      '0x%.2x%.2x%.2x%.2x%.2x%.2x',
      [psia.Value[0], psia.Value[1], psia.Value[2],
      psia.Value[3], psia.Value[4], psia.Value[5]])
  else
    StrFmt(pszSidText + StrLen(pszSidText),
      '%u',
      [DWORD(psia.Value[5]) +
      DWORD(psia.Value[4] shl 8) +
      DWORD(psia.Value[3] shl 16) +
      DWORD(psia.Value[2] shl 24)]);

  dwSidSize := StrLen(pszSidText);

  for dwCounter := 0 to dwSubAuthorities - 1 do
  begin
    StrFmt(pszSidText + dwSidSize, '-%u',
      [GetSidSubAuthority(Sid, dwCounter)^]);
    dwSidSize := StrLen(pszSidText);
  end;

  Result := True;
end;

function ObtainTextSid(hToken: THandle; pszSid: PChar;
  var dwBufferLen: DWORD): BOOL;
var
  dwReturnLength: DWORD;
  dwTokenUserLength: DWORD;
  tic: TTokenInformationClass;
  ptu: Pointer;
begin
  Result := False;
  dwReturnLength := 0;
  dwTokenUserLength := 0;
  tic := TokenUser;
  ptu := nil;

  if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
    dwReturnLength) then
  begin
    if GetLastError = ERROR_INSUFFICIENT_BUFFER then
    begin
      ptu := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwReturnLength);
      if ptu = nil then Exit;
      dwTokenUserLength := dwReturnLength;
      dwReturnLength    := 0;

      if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
        dwReturnLength) then Exit;
    end 
    else 
      Exit;
  end;

  if not ConvertSid((PTokenUser(ptu).User).Sid, pszSid, dwBufferLen) then Exit;

  if not HeapFree(GetProcessHeap, 0, ptu) then Exit;

  Result := True;
end;

function GetCurrentUserSid: string;
var
  hAccessToken: THandle;
  bSuccess: BOOL;
  dwBufferLen: DWORD;
  szSid: array[0..260] of Char;
begin
  Result := '';

  bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
    hAccessToken);
  if not bSuccess then
  begin
    if GetLastError = ERROR_NO_TOKEN then
      bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
        hAccessToken);
  end;
  if bSuccess then
  begin
    ZeroMemory(@szSid, SizeOf(szSid));
    dwBufferLen := SizeOf(szSid);

    if ObtainTextSid(hAccessToken, szSid, dwBufferLen) then
      Result := szSid;
    CloseHandle(hAccessToken);
  end;
end;

end.

Use a TPanel as a host for child windows (MDI simulation)

Problem/Question/Abstract:

I was wondering if someone can offer assistance with this application. Basically the application is for configuring our system. At present it is a MDI where child windows are various functions (security, report options, etc.). The number of functions are growing, currently around 15, which means an increase in different child forms and, overall, a growing exe. I would like the child forms to be standalone programs or dlls which can appear in the control program as child windows and also execute by themselves. Only one child form is displayed at a time and always maximised within the parent window. I did see some code about that provided for a dll as a child form, but this would not help as a standalone execution.

Answer:

This is an interesting problem. As it happens it is possible in Win32 to make another processes window appear like a child window in ones own windows. It does not work quite as well as a true child in your own process but takes care about moving the pseudo-child with your menu app.

The general design is this: the main/menu app has a form with menu, perhaps tool and status bars, and a client-aligned panel that will serve as the host for the child windows. It reads the available child apps from INI file or registry key and builds a menu or selection list from this info. On user request it launches the appropriate child app and passes the panels window handle on the commandline. The child app checks the command line, if there are no parameters it rans as designed, if there is a parameter it reads it, removes its border and bordericon, parents itself to the passed window handle and sizes itself to its client area. It also sends a message with *its* window handle to the panels parent (the main app form) to register itself. The main app can close the child with this handle and also resize it when the user resizes the main app.

Main app: has a menu with two entries (OpenMenu, CloseMenu), a toolbar with two buttons attached to the same events as the two menus, a statusbar, a client-aliged panel.

unit MenuApp;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, ComCtrls, ToolWin;

const
  UM_CHILDREGISTER = WM_USER + 111;
  UM_CHILDUNREGISTER = WM_USER + 112;

type
  TUmChildRegister = packed record
    msg: Cardinal;
    childwnd: HWND;
    unused: Integer;
    result: Integer;
  end;
  TUmChildUnregister = TUmChildregister;

  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    OpenMenu: TMenuItem;
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    CloseMenu: TMenuItem;
    ToolButton2: TToolButton;
    Panel1: TPanel;
    procedure OpenMenuClick(Sender: TObject);
    procedure CloseMenuClick(Sender: TObject);
    procedure Panel1Resize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FChildAppHandle: HWND;
    procedure UMChildRegister(var msg: TUmChildRegister);
      message UM_CHILDREGISTER;
    procedure UMChildUnRegister(var msg: TUmChildUnRegister);
      message UM_CHILDUNREGISTER;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  shellapi;

{$R *.DFM}

procedure TForm1.OpenMenuClick(Sender: TObject);
var
  path, param: string;
begin
  if FChildAppHandle = 0 then
  begin
    path := ExtractFilePath(Application.Exename) + 'childAppProj.exe';
    param := '$' + IntTohex(panel1.handle, 8);
    ShellExecute(handle, 'open', pchar(path), pchar(param), nil, SW_SHOWNORMAL);
  end
  else
    ShowMessage('Child already loaded');
end;

procedure TForm1.CloseMenuClick(Sender: TObject);
begin
  if FChildAppHandle <> 0 then
    SendMessage(FchildApphandle, WM_CLOSE, 0, 0);
end;

procedure TForm1.Panel1Resize(Sender: TObject);
begin
  if FChildAppHandle <> 0 then
    MoveWindow(FchildAppHandle, 0, 0, Panel1.ClientWidth, Panel1.ClientHeight, true);
end;

procedure TForm1.UMChildRegister(var msg: TUmChildRegister);
begin
  FChildAppHandle := msg.childwnd;
end;

procedure TForm1.UMChildUnRegister(var msg: TUmChildUnRegister);
begin
  if FChildAppHandle = msg.childwnd then
    FChildAppHandle := 0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FChildAppHandle <> 0 then
    SendMessage(FchildApphandle, WM_CLOSE, 0, 0);
end;

end.

Child app has a couple of edits, two buttons, a memo.

unit ChildApp;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, AppEvnts;

type
  TForm2 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    ApplicationEvents1: TApplicationEvents;
    procedure Button1Click(Sender: TObject);
    procedure ApplicationEvents1Activate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FMenuAppWnd: HWND;
    FParentPanelWnd: HWND;
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

const
  UM_CHILDREGISTER = WM_USER + 111;
  UM_CHILDUNREGISTER = WM_USER + 112;

procedure TForm2.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TForm2.ApplicationEvents1Activate(Sender: TObject);
begin
  if FMenuAppWnd <> 0 then
    SendMessage(FMenuAppWnd, WM_NCACTIVATE, 1, 0);
  memo1.lines.add('Activated');
end;

constructor TForm2.Create(aOwner: TComponent);
begin
  if ParamCount > 0 then
  begin
    FParentPanelWnd := StrToInt(ParamStr(1));
    FMenuAppWnd := Windows.GetParent(FParentPanelWnd);
  end;
  inherited;
  if FParentPanelWnd <> 0 then
  begin
    Borderstyle := bsNone;
    BorderIcons := [];
    {remove taskbar button for the child app}
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
      GetWindowLong(Application.Handle, GWL_EXSTYLE)
      and not WS_EX_APPWINDOW or WS_EX_TOOLWINDOW);
  end;
end;

procedure TForm2.CreateWnd;
var
  r: Trect;
begin
  inherited;
  if FMenuAppWnd <> 0 then
  begin
    SendMessage(FMenuAppWnd, UM_CHILDREGISTER, handle, 0);
    Windows.SetPArent(handle, FParentPanelWnd);
    Windows.GetClientRect(FParentPanelWnd, r);
    SetBounds(r.left, r.top, r.right - r.left, r.bottom - r.top);
  end;
end;

procedure TForm2.DestroyWnd;
begin
  if FMenuAppWnd <> 0 then
    SendMessage(FMenuAppWnd, UM_CHILDUNREGISTER, handle, 0);
  inherited;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  {Closing the main form does not fire DestroyWnd for some reason}
  if FMenuAppWnd <> 0 then
    SendMessage(FMenuAppWnd, UM_CHILDUNREGISTER, handle, 0);
end;

procedure TForm2.FormResize(Sender: TObject);
begin
  memo1.width := clientwidth - memo1.Left - 10;
  memo1.height := clientheight - memo1.Top - 10;
end;

end.

One problem I noted is that sometimes the main applications caption will loose the active look when switching between main and child despite the action taken in the childs Application.OnActivate handler.

Using Indy idHTTP to post binary and text

Problem/Question/Abstract:

Using Indy idHTTP to post binary and text

Answer:

This is a small example of using post to send data to web server. There is two different ways to do this operation.

Solve 1:

procedure TForm1.SendPostData;
const
CRLF = #13#10;
var
aStream: TMemoryStream;
Params: TMemoryStream;
S: string;
begin
aStream := TMemoryStream.create;
Params := TMemoryStream.Create;

HTTP.Request.ContentType := 'multipart/form-data;
boundary = - - - - - - - - - - - - - - - - - - - - - - - - - - - - -7
cf87224d2020a';

try
S := '-----------------------------7cf87224d2020a' + CRLF +
'Content-Disposition: form-data; name="file1"; filename="c:abc.txt"' +
CRLF +
'Content-Type: text/plain' + CRLF + CRLF +
'file one content. Contant-Type can be application/octet-stream or if
you want you can ask your OS fot the exact type
.' + CRLF +
'-----------------------------7cf87224d2020a' + CRLF +
'Content-Disposition: form-data; name="sys_return_url2"' + CRLF + CRLF +
'hello2' + CRLF +
'-----------------------------7cf87224d2020a--';

Params.Write(S[1], Length(S));

with HTTP do
begin
try
HTTP.Post('http://www.mydomain.com/postexampe.cgi', Params,
aStream);
except
on E: Exception do
showmessage('Error encountered during POST: ' + E.Message);
end;
end;
aStream.WriteBuffer(#0' ', 1);
showmessage(PChar(aStream.Memory));
except
end;
end;


Solve 2:

procedure TForm1.SendPostData;
var
aStream: TMemoryStream;
Params: TStringStream;
begin
aStream := TMemoryStream.create;
Params := TStringStream.create('');
HTTP.Request.ContentType := 'application/x-www-form-urlencoded';

try
Params.WriteString(URLEncode('sys_return_url=' + 'helo1' + '&'));
Params.WriteString(URLEncode('sys_return_url=' + 'helo2'));
with HTTP do
begin
try
HTTP.Post('http://www.mydomain.com/postexampe.cgi', Params,
aStream);
except
on E: Exception do
showmessage('Error encountered during POST: ' + E.Message);
end;
end;
aStream.WriteBuffer(#0' ', 1);
showmessage(PChar(aStream.Memory));
except
end;
end;

As you can see there is a difference in the way post stream is constructed and the ContentType. In the first example ContentType is "multipart/form-data; boundary=-----------------------------7cf87224d2020a" and this boundary is used to separate different parameters.

In the second example the ContentType is "application/x-www-form-urlencoded". In this case the paremeteras are passed in the form

ParamName=ParamValue&ParamName=ParamValue

Note that the Pramaeters in the second form must be URL encoded.

Where these two formats of post information are used?

The first one is used when you have binary data to post and the second one is when you are going to post only text fields.