unautils.pas

Voice Commnucation Components for Delphi

}
function choice(value: bool; true_choice: pointer = nil; false_choice: pointer = nil): pointer; overload;
{DP:METHOD
  Returns one of the choices depending on value of boolean selector.
}
function choiceD(value: bool; const true_choice: double = 0; false_choice: double = 0): double; overload;
function choiceE(value: bool; const true_choice: extended = 0; false_choice: extended = 0): extended; overload;

{DP:METHOD
  Returns true if command line contains given switch.
}
function hasSwitch(const name: string; caseSensitive: bool = false): bool; overload;
{DP:METHOD
  Returns value of given command line switch.
}
function switchValue(const name: string; caseSensitive: bool = false; defValue: int = 0): int; overload;
function switchValue(const name: string; caseSensitive: bool = false; const defValue: string = ''): string; overload;

{DP:METHOD
  Returns greatest common divider.
  <P />For example, if a=11025 and b=1000 the result will be 25.
}
function gcd(a, b: unsigned): unsigned;


// -- Varinats --
{$IFDEF __SYSUTILS_H_ }

{$IFDEF __AFTER_D5__ }

function varGetValue(const value: variant; defValue: boolean; index: int = -1): bool; overload;
function varGetValue(const value: variant; defValue: int; index: int = -1): int; overload;
function varGetValue(const value: variant; const defValue: string; index: int = -1): string; overload;
function varGetValue(const value: variant; const defValue: wideString; index: int = -1): wideString; overload;
function varGetValue(const value: variant; const defValue: tDateTime; index: int = -1): tDateTime; overload;
function varGetVarValue(const value: variant; const defValue: variant; index: int = -1): variant;
function varGetHighBound(const value: variant; dim: int = 1): int;
//
function string2variantNull(const value: string): variant;
function var2str(const value: variant; forceType: integer = varVariant): string;
function str2var(const value: string): variant;
//
function oleVarGetValue(const value: oleVariant; defValue: boolean; index: int = -1): bool; overload;
function oleVarGetValue(const value: oleVariant; defValue: int; index: int = -1): int; overload;
function oleVarGetValue(const value: oleVariant; const defValue: string; index: int = -1): string; overload;
function oleVarGetValue(const value: oleVariant; const defValue: wideString; index: int = -1): wideString; overload;
function oleVarGetValue(const value: oleVariant; const defValue: tDateTime; index: int = -1): tDateTime; overload;
function oleVarGetVarValue(const value: oleVariant; const defValue: oleVariant; index: int = -1): oleVariant;
function oleVarGetHighBound(const value: oleVariant; dim: int = 1): int;

{$ENDIF }	// __AFTER_D5__

{$ENDIF }	// __SYSUTILS_H_


type
  //
  // -- security attribute --
  //
  PSECURITY_ATTRIBUTES = ^SECURITY_ATTRIBUTES;
  SECURITY_ATTRIBUTES = packed record
    //
    nLength: DWORD;
    lpSecurityDescriptor: PSecurityDescriptor;
    bInheritHandle: Windows.BOOL;
  end;

// --  --
function getNullDacl(): PSECURITY_ATTRIBUTES;


var
  //
  g_wideApiSupported: bool;	// true if wide API looks to be present

  //
  g_OSVersion: OSVERSIONINFOW;	// safe to use on any OS


implementation


uses
  unaPlacebo
{$IFDEF UNA_PROFILE}
  , unaProfile
{$ENDIF}
{$IFDEF __SYSUTILS_H_ }
  , Math
{$ENDIF}
  ;

{$IFDEF UNA_PROFILE}
var
  profId_unaUtils_base64encode: unsigned;
  profId_unaUtils_base64decode: unsigned;
{$ENDIF}

{$IFDEF __SYSUTILS_H_ }
{$ELSE}

// --  --
function min(A, B: int): int;
begin
  if (A > B) then
    result := B
  else
    result := A;
end;

// --  --
function min(A, B: int64): int64;
begin
  if (A > B) then
    result := B
  else
    result := A;
end;

// --  --
function min(A, B: unsigned): unsigned;
begin
  if (A > B) then
    result := B
  else
    result := A;
end;

// --  --
function max(A, B: int): int;
begin
  if (A < B) then
    result := B
  else
    result := A;
end;

// --  --
function max(A, B: int64): int64;
begin
  if (A < B) then
    result := B
  else
    result := A;
end;

// --  --
function max(A, B: unsigned): unsigned;
begin
  if (A < B) then
    result := B
  else
    result := A;
end;

// --  --
function max(A, B: double): double;
begin
  if (A < B) then
    result := B
  else
    result := A;
end;


// --  --
procedure abort();
var
  n: int;
begin
  n := 0;
  //
  n := 1 div n;
  //
  if (0 < n) then
    // copiler is broken :)
end;

{$ENDIF }	// not __SYSUTILS_H_

// --  --
function base64encode(data: pointer; size: unsigned): string;
const
  Base64: string[64] = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var
  L: unsigned;
  P: string;
  j: unsigned;
  i: unsigned;
  d: pArray;
begin
{$IFDEF UNA_PROFILE}
  profileMarkEnter(profId_unaUtils_base64encode);
{$ENDIF}
  result := '';
  i := 0;
  //
  d := data;
  if (d <> nil) then begin
    //
    while (i < size) do begin
      //
      P := '';
      L := (d[i] shl 16);
      inc(i);
      if (i < size) then begin
	L := L + (d[i] shl 8);
	inc(i);
	if (i < size) then
	  inc(L, d[i])
	else
	  P := '=';
      end
      else
	P := '==';
      //
      for j := 1 to 4 - length(P) do begin
	//
	result := result + Base64[(L and $FC0000) shr 18 + 1];
	L := L shl 6;
      end;
      //
      if (P <> '') then begin
	result := result + P;
	break;
      end;
      //
      inc(i);
    end;
  end;
{$IFDEF UNA_PROFILE}
  profileMarkLeave(profId_unaUtils_base64encode);
{$ENDIF}
end;

// -- --
function base64encode(const data: string): string;
begin
  if ('' <> data) then
    result := base64encode(@data[1], length(data))
  else
    result := '';
end;

// -- --
function char2int(const data: string; var ofs: unsigned): unsigned;
var
  c: char;
begin
  if (unsigned(length(data)) >= ofs) then begin
    //
    c := data[ofs];

    case (c) of

      'A'..'Z': result := ord(c) - ord('A');
      'a'..'z': result := ord(c) - ord('a') + 26;
      '0'..'9': result := ord(c) - ord('0') + 52;
      '+'     : result := 62;
      '/'     : result := 63;
      else      result := 64;

    end;
    inc(ofs);
  end
  else
    result := 65;
end;

// --  --
function base64decode(data: pointer; len: unsigned): string;
var
  dataStr: string;
begin
  if ((0 < len) and (nil <> data)) then begin
    //
    setLength(dataStr, len);
    move(data^, dataStr[1], len);
    result := base64decode(dataStr);
  end
  else
    result := '';
end;

// --  --
function base64decode(const data: string): string;
var
  Z: unsigned;
  L: unsigned;
  i: unsigned;
  j: int;
  c: int;
  V: byte;
  D: byte;
begin
{$IFDEF UNA_PROFILE}
  profileMarkEnter(profId_unaUtils_base64decode);
{$ENDIF}
  //
  result := '';
  i := 1;
  Z := length(data);
  while (i <= Z) do begin
    //
    V := 0;
    L := 0;
    c := 18;
    repeat
      //
      D := char2int(data, i);
      case (D) of

	64:
	  continue;	// invalid char (or '=')

	65:
	  break;	// end of data

	else begin
	  //
	  L := L + D shl c;
	  c := c - 6;
	  inc(V);
	end;
      end;
      //
    until (3 < V);
    //
    for j := 1 to V - 1 do begin
      //
      result := result + chr((L and $FF0000) shr 16);
      L := L shl 8;
    end;
    //
  end;
  //
{$IFDEF UNA_PROFILE}
  profileMarkLeave(profId_unaUtils_base64decode);
{$ENDIF}
end;

// -- --
function base64decode(const data: string; out buf: pointer): unsigned;
var
  str: string;
begin
  str := base64decode(data);
  result := length(str);
  if (result > 0) then begin
    buf := malloc(result);
    move(str[1], buf^, result);
  end
  else
    buf := nil;
end;

// --  --
function base65encode(data: pointer; len: unsigned): string;
var
  sz: int;
begin
  if (nil <> data) then begin
    //
    sz := (len shl 3);
    if (0 <> sz mod 5) then
      sz := sz div 5 + 1
    else
      sz := sz div 5;
    //
    setLength(result, sz);
    asm
	mov	ecx, len
	or	ecx,ecx
	jz	@done

	push	esi
	push	edi
	push	ebx

	mov	esi, data
	mov	edi, result
	mov	edi, [edi]

	mov	ebx, ecx	// EBX = sz
	mov	dl, 5		// magic value :)
	sub	dh, dh		// DH = 0 (5 bit value)