Arsip: Membuat sendiri UDF library bag.3

ass.dpr

library ass;
{
  Copyright (c) 2004, aa, Adrian H. & Ray AF
  Property of PT SOFTINDO Jakarta.
  All rights reserved.
}
uses
  //{$I fastCodeUses.inc},
  math, sysUtils, sec_h, mdx5u, dbZCrypt; // ordinals , swabConf in '..\swabConf.pas';
{$R .res}
{
//======================================================================================
function test_byval(const byValue: integer = 0): integer; stdcall; export; begin //WRONG!
  result := byValue - 1; end;
function test_byref(var byReference: integer): integer; stdcall; export; begin //right
  result := byReference - 1; end;
function test_bydef(byDefault: integer): integer; stdcall; export; begin //WRONG!
  result := byDefault - 1; end;
//===================================================================================================
// conclussion: all arguments are passed by reference to them, not to be modified!
//              (an integer argument should be passed as a pointer to integer [PInteger])
//===================================================================================================
function IBStrAlloc(const Len: integer): PChar; overload; forward;
function IBStrAlloc(const S: string): PChar; overload; forward;
function testr(const P: PChar = nil): PChar; stdcall; export; // WRONG!
//var S: string;
begin
  if P = nil then
    result := IBStrAlloc('NULL')
  else begin
    //SysUtils.StrPas(P);
    if P = '' then
      Result := IBStrAlloc('[ also null ]')
    else if length(P) < 1 then
      Result := IBStrAlloc('[ empty string ]')
    else
      Result := IBStrAlloc('not null = [' + P + ']')
  end;
end;
//===================================================================================================
// checking (PChar = '') is identical with testing (PChar = nil),
// to check whether argument is an empty string (not a null value) you must check the length of PChar
//===================================================================================================
function testnull(const P1: PInteger = nil): PChar; stdcall cdecl export;
begin
  Result := nil;
end;
function testnull2(const P1: PInteger; P2: PInteger): PChar; STDCALL; export;
begin // firebird can not handle this :(
  Result := nil;
end;
function testnull3(const P1: PInteger; P2: PInteger; const P3:integer = nill): PChar; stdcall; CDECL; export;
begin // must be using cdecl!!
  Result := nil;
end;
//===================================================================================================
// IB documentations (API Guide/DevGuide) says that in windows we should use stdcall for all functions,
// only 3 functions namely: isc_start_transaction(), isc_expand_dpb(), and isc_event_block() — using
// the CDECL calling convention since they have a variable number of arguments.
// i don't know about interbase, but in firebird that statement is misleading (wrong). according to
// our experience, ALL udf functions that have more than 1 argument, MUST use cdecl, or they can not
// handle null value at all, abruptly exit error -902  (yes, that was as stupid as GPF in windows).
// we believe that it was a glitch or supposed to be a bug. because when the external function
// arguments declared as large string ie. CString(32000), they do fine.
//
// blob API functions here also NOT work with stdcall
// (it had already wasted my times and give me a headache just to figured it out)
//
// null handling may ONLY applied to function resulting pointer type. if your function returns
// integer type, you should change them to resulting PInteger type (DO NOT forget to allocating
// memory according to return size with stupid ib_util_malloc, which also means you have to use
// free_it afterward) AND finally DO NOT use BY VALUE for external function declaration.
//===================================================================================================
}
function LocalUserDel(const UserName: VarChar32): integer; stdcall export;
begin
  Result := _sex(opDel, UserName);
end;
function LocalUserAdd(const UserName: VarChar32; const Password: VarChar8 = nil;
  const FirstName: VarChar32 = nil; const MiddleName: VarChar32 = nil; const LastName: VarChar32 = nil;
  const UID: PInteger = nil; const GID: PInteger = nil; const GroupName: VarChar32 = nil): integer; stdcall cdecl export;
begin
  Result := _sex(opAdd, UserName, Password, FirstName, MiddleName, LastName, nil, nil, TRUE, nil, nil, UID, GID, GroupName);
end;
function LocalUserMod(const UserName: VarChar32; const Password: VarChar8 = nil;
  const FirstName: VarChar32 = nil; const MiddleName: VarChar32 = nil; const LastName: VarChar32 = nil;
  const UID: PInteger = nil; const GID: PInteger = nil; const GroupName: VarChar32 = nil): integer; stdcall cdecl export;
begin
  Result := _sex(opMod, UserName, Password, FirstName, MiddleName, LastName, nil, nil, TRUE, nil, nil, UID, GID, GroupName);
end;
function UserDel(
  const UserName: VarChar32;
  const Server: VarChar64; const Protocol: PConSecProtocol;
  const SysDBA: VarChar32 = nil; const MasterKey: VarChar8 = nil): TISCStatus; stdcall cdecl export;
begin
  Result := _sex(opDel, UserName, nil, nil, nil, nil, Server, Protocol, FALSE, SysDBA, MasterKey);
end;
function UserAdd(
  const UserName: VarChar32; const Password: varChar8 = nil;
  const Server: VarChar64 = nil; const Protocol: PConSecProtocol = nil;
  const SysDBA: VarChar32 = nil; const MasterKey: VarChar8 = nil;
  const FirstName: VarChar32 = nil; const MiddleName: VarChar32 = nil;
  const LastName: VarChar32 = nil): TISCStatus; stdcall cdecl export;
  //const UID: PInteger = nil; const GID: PInteger = nil; const GroupName: VarChar32 = nil;
begin
  Result := _sex(opAdd, UserName, Password, FirstName, MiddleName, LastName, Server, Protocol, FALSE, SysDBA, MasterKey);
end;
function UserMod(
  const UserName: VarChar32; const Password: varChar8 = nil;
  const Server: VarChar64 = nil; const Protocol: PConSecProtocol = nil;
  const SysDBA: VarChar32 = nil; const MasterKey: VarChar8 = nil;
  const FirstName: VarChar32 = nil; const MiddleName: VarChar32 = nil;
  const LastName: VarChar32 = nil): TISCStatus; stdcall cdecl export;
  //const UID: PInteger = nil; const GID: PInteger = nil; const GroupName: VarChar32 = nil;
begin
  Result := _sex(opMod, UserName, Password, FirstName, MiddleName, LastName, Server, Protocol, FALSE, SysDBA, MasterKey);
end;
function UserAdd3(
  const UserName: VarChar32; const Password: varChar8 = nil;
  const Server: VarChar64 = nil; const Protocol: PConSecProtocol = nil;
  const SysDBA: VarChar32 = nil; const MasterKey: VarChar8 = nil;
  //const FirstName: VarChar32 = nil; const MiddleName: VarChar32 = nil; const LastName: VarChar32 = nil;
  const UID: PInteger = nil; const GID: PInteger = nil;
  const GroupName: VarChar32 = nil): TISCStatus; stdcall cdecl export;
begin
  Result := _sex(opAdd, UserName, Password, nil, nil, nil,
    Server, Protocol, FALSE, SysDBA, MasterKey, UID, GID, GroupName);
end;
function UserMod3(
  const UserName: VarChar32; const Password: varChar8 = nil;
  const Server: VarChar64 = nil; const Protocol: PConSecProtocol = nil;
  const SysDBA: VarChar32 = nil; const MasterKey: VarChar8 = nil;
  //const FirstName: VarChar32 = nil; const MiddleName: VarChar32 = nil; const LastName: VarChar32 = nil;
  const UID: PInteger = nil; const GID: PInteger = nil;
  const GroupName: VarChar32 = nil): TISCStatus; stdcall cdecl export;
begin
  Result := _sex(opMod, UserName, Password, nil, nil, nil,
    Server, Protocol, FALSE, SysDBA, MasterKey, UID, GID, GroupName);
end;
const
  IBUTIL = 'ib_util.dll'; // this stupid, slow, archaic reptile, MUST be declared using cdecl.
  OLE32 = 'ole32.dll';
function IBUtilMalloc(Length: integer): pointer; stdcall cdecl; external IBUTIL name 'ib_util_malloc';
function CoCreateGuid(out guid: TGUID): HResult; stdcall external OLE32 name 'CoCreateGuid';
function GenUUID: PChar;
// declare externalfunction gen_uuid returns char(16) character set octets free_it
// entry_point 'GenUUID' module_name 'sec.dll';
var
  GUID: TGUID;
const
  GUIDSize = sizeof(GUID);
begin
  Result := IBUtilMalloc(GUIDSize);
  CoCreateGUID(GUID); move(GUID, Result^, GUIDSize);
end;
type
  MDxDigestStr = PChar; // 16 bytes mdx Digest as PChar
function IBStrAlloc(const Len: integer): PChar; overload;
begin
  Result := nil;
  if len >= 0 then begin // zero length string is still a valid string
    Result := IBUtilMalloc(Len + 1);
    Result[Len] :=#0;
  end;
end;
function IBStrAlloc(const S: string): PChar; overload;
var
  Len: integer;
begin
  Len := length(S); // zero length string is still a valid string
  Result := IBUtilMalloc(Len + 1);
  Result[Len] :=#0;
  if Len > 0 then
    move(S[1], Result^, Len);
end;
function IBBufAlloc(const Buffer: pointer; const Length: integer): pointer; overload;
begin
  Result := nil;
  if Length > 0 then begin
    Result := IBUtilMalloc(Length);
    move(Buffer^, Result^, Length);
  end;
end;
function binn(const Buffer; const BufferLength: integer): string;
overload register assembler asm
  @@Start:
    or Buffer, Buffer; jz @@Stop     // insanity checks
    or BufferLength, BufferLength; jg @@begin // may not exceed 2GB
    xor eax, eax; ret
  @@Begin: push esi; push edi; push ebx
    push Result
    mov ebx,edx; shl edx,3 // save BufLen, request BufLen   8
    mov esi,Buffer; mov eax,Result;
    //call __LStrCLSet; mov edi, eax
    push edx; call System.@LStrClr
    pop edx; call System.@LStrSetLength
    mov edi,[eax];
    lea ecx,ebx-1;  // i'd rather using ecx for loss 1 clock
  @@Loop: mov al, [esi+ecx]//lodsb;
      test al,al; sets bl;
      test al,1 shl 6; setnz bh;
      test al,1 shl 5; setnz dl;
      test al,1 shl 4; setnz dh;
      or bx,'00'; or dx,'00';
      mov [edi+0],bx; mov [edi+2],dx
      test al,1 shl 3; setnz bl;
      test al,1 shl 2; setnz bh;
      test al,1 shl 1; setnz dl;
      test al,1 shl 0; setnz dh;
      or bx,'00'; or dx,'00';
      mov [edi+4],bx; mov [edi+6],dx
      lea edi, [edi+8]
    dec ecx; jge @@Loop;
    pop eax // Result
  @@end: pop ebx; pop edi; pop esi
  @@Stop:
  end;
//function bins(const P: PInteger; const length: integer): PChar; cdecl overload begin
//  if P = nil then result := nil else
//    Result := IBStrAlloc(binn(P^, length))
//end;
function bin(const P: PInteger): PChar; stdcall begin
  if P = nil then result := nil else
    Result := IBStrAlloc(binn(P^, sizeof(P^)))
end;
function bin64(const P: PInt64): PChar; stdcall begin
  if P = nil then result := nil else
    Result := IBStrAlloc(binn(P^, sizeof(P^)))
end;
function bin16(const P: PSmallInt): PChar; stdcall begin
  if P = nil then result := nil else
    Result := IBStrAlloc(binn(P^, sizeof(P^)))
end;
function bin8(const P: PByte): PChar; stdcall begin
  if P = nil then result := nil else
    Result := IBStrAlloc(binn(P^, sizeof(P^)))
end;
function binx_not(const P: Pointer; const size: integer = sizeof(int64)): pointer;
// this really is stupid. they provided us bin_or, bin_xor & bin_shl/shr.
// (not X) is_equal_with: (neg X -1) also_equal_with: neg (X + 1) in respected size
var
  n: int64;
begin
  Result := nil;
  if P <> nil then begin
    case size of
      sizeof(ShortInt): n := not PShortInt(P)^;
      sizeof(SmallInt): n := not PSmallint(P)^;
      sizeof(Integer): n := not PInteger(P)^;
      sizeof(int64): n := not PInt64(P)^;
    else exit;
    end;
    Result := IBBufAlloc(@n, size);
  end;
end;
function bin_not(const P: PInteger): pointer; cdecl; stdcall //overload;
begin
  Result := binx_not(P, sizeof(P^));
end;
function bin64_not(const P: PInt64): pointer; cdecl; stdcall //overload;
begin
  Result := binx_not(P, sizeof(P^));
end;
function bin16_not(const P: PSmallInt): pointer; cdecl; stdcall //overload;
begin
  Result := binx_not(P, sizeof(P^));
end;
function bin8_not(const P: PShortInt): pointer; cdecl; stdcall //overload;
// not used, stupid firebird only knows smallint, integer and bigint
begin
  Result := binx_not(P, sizeof(P^));
end;
function mdxnsum(const Buffer: pointer; const Length: Longword;
  const Algorithm: tmdxAlgorithm = mda5): MDxDigestStr; overload;
var
  Digest: tmdxDigest;
begin
  Result := nil;
  if (Buffer <> nil) then begin
    Digest := mdx5u.mdxDigest(Buffer, Length, Algorithm);
    Result := IBBufAlloc(@Digest, sizeof(Digest));
  end;
end;
function mdxnsum(const Buffer: PChar; const PBufLen: PLongword;
  const Algorithm: tmdxAlgorithm = mda5): MDxDigestStr; overload;
begin
  Result := nil;
  if (Buffer <> nil) and (PBufLen <> nil) then
    Result := mdxnsum(Buffer, PBufLen^)
end;
function md4(const P: PChar): MDxDigestStr; stdcall export;
begin
  Result := mdxnsum(P, length(P), mda4);
end;
function md5(const P: PChar): MDxDigestStr; stdcall export;
begin
  Result := mdxnsum(P, length(P), mda5);
end;
function md4n(const Buffer: PChar; const PLength: PLongword): MDxDigestStr; stdcall cdecl export;
begin
  Result := mdxnsum(Buffer, PLength, mda4);
end;
function md5n(const Buffer: PChar; const PLength: PLongword): MDxDigestStr; stdcall cdecl export;
begin
  Result := mdxnsum(Buffer, PLength, mda5);
end;
type
  //PISCBLObHandle = ^TISCBLObHandle;
  TISCBLObHandle = integer; //pointer;
  pfnBLOBAccessGet = ^tfnBLOBAccessGet;
  // these routines will NEVER WORK with stdcall
  tfnBLOBAccessGet = function(const Handle: TISCBLObHandle; const Buffer: PChar; const BufSize: integer; const Count: PInteger): integer; stdcall cdecl;
  tfnBLOBAccessPut = function(const Handle: TISCBLObHandle; const Buffer: PChar; const BufSize: integer): integer; stdcall cdecl;
  tfnBLOBSeek = function(const Handle: TISCBLObHandle; const mode: integer; const Offset: Longword): integer; stdcall cdecl;
  PBLOb = ^TBLOb;
  TBLOb = packed record
    // if BLOB data is not to be read by udf set blob_get/put_segment to NULL
    BLOBGetSegment: tfnBLOBAccessGet;
    BLOBHandle: TISCBLObHandle; // required
    //Set these values to NULL if Blob data is not passed to a UDF.
    NumSegments, SegmentLen, TotalSize: Longword;
    BLOBPutSegment: tfnBLOBAccessPut; // not used anyway
    BLObSeek: tfnBLOBSeek; // not used anyway
  end;
type
  tBLObInfoRequest = (birAllInfo, birHandle, birNumSegments, birSegmentLen, birTotalSize, birGet, birPut, birSeek);
function getBLObInfo(const BLOb: PBLOb; const infoKind: tBLObInfoRequest = birAllInfo): pointer;
const
  CSEP = ''; RSEP = ' '; //RSEP = ', ';
var
  S: string;
begin
  if (BLOb = nil) or (BLOB^.BLOBHandle = 0) then Result := nil
  else
    with BLOB^ do begin
      if infoKind = birAllInfo then begin
        S := format('Handle%0:s:%.08x%2:sSeg%0:s:%3:dx%4:d%2:sSize%0:s:%5:d',
          [CSEP, BLOBHandle, RSEP, NumSegments, SegmentLen, TotalSize]); //, @BLOBGetSegment, @BLOBPutSegment, @BLObSeek]); // tab, handle, cr/lf, numseg, seglen, size
        Result := IBStrAlloc(S);
      end
      else begin
        Result := IBBufAlloc(@BLOBhandle, sizeof(Integer));
        case infoKind of
          birTotalSize: PCardinal(Result)^ := TotalSize;
          birNumSegments: PCardinal(Result)^ := NumSegments;
          birSegmentLen: PCardinal(Result)^ := SegmentLen;
        end;
      end;
    end;
end;
function BLObSize(const BLOb: PBLOb): PInteger; stdcall export;
begin
  Result := getBLObInfo(BLOB, birTotalSize)
end;
function BLObSegments(const BLOb: PBLOb): PInteger; stdcall export;
begin
  Result := getBLObInfo(BLOB, birNumSegments);
end;
function BLObSegLen(const BLOb: PBLOb): PInteger; stdcall export;
begin
  Result := getBLObInfo(BLOB, birSegmentLen);
end;
function BLObInfo(const BLOb: PBLOb): PChar; stdcall export;
begin
  Result := getBLObInfo(BLOB);
end;
function mdbsum(const BLOb: PBLOb; const Algorithm: tmdxAlgorithm): MDxDigestStr;
// warning! this is inefficient routines (allocating ALL blob memory at once)
// because of fetch bug in mdx5.obj we haven't yet fixed, despite of it
// this really IS fast, so if your frequent blob are of small to medium size
// better use this function, but if you have really large blob to be hashed
// more than memory capacity (>1GB) you should use mdbsum2 instead
var
  B, Buffer: PChar; Digest: tmdxDigest;
  BLObHandle: TISCBLObHandle;
  Length: Longword; Count: smallInt;
begin
  Result := nil;
  if (BLOb <> nil) and (BLOb^.BLOBHandle <> 0) then begin
    Length := BLOb^.TotalSize; getmem(Buffer, Length);
    B := Buffer; BLObHandle := BLOb^.BLObHandle;
    try
      while BLOb^.BLObGetSegment(BLObHandle, B, Length, @Count) > 0 do inc(B, Count);
      Digest := mdx5u.mdxDigest(Buffer, Length, Algorithm);
      Result := IBBufAlloc(@Digest, sizeof(Digest));
    finally
      freemem(Buffer);
    end;
  end;
end;
function mdbsum2(const BLOb: PBLOb; const Algorithm: tmdxAlgorithm): MDxDigestStr;
type
  tfnmdxfetch = procedure(var Digest: tmdxDigest; const Chunk: pointer);
  tfnmdxtail = procedure(var Digest: tmdxDigest; Buffer: pointer; const BufLen: cardinal; const DataLen: int64);
var
  B, Buffer: PChar; Digest: tmdxDigest;
  BLObHandle: TISCBLObHandle;
  segLen, Count: integer;
  i: integer; totalSize: int64;
  numSeg: longword; S: string;
  mdxfetch: tfnmdxfetch;
  mdxtail: tfnmdxtail;
begin
  Result := nil;
  if (BLOb <> nil) and (BLOb^.BLOBHandle <> 0) then begin
    mdxClear(Digest);
    if Algorithm = mda4 then begin
      mdxtail := md4tail;
      mdxfetch := __mdx4fetch;
    end
    else if Algorithm = mda5 then begin
      mdxtail := md5tail;
      mdxfetch := __mdx5fetch;
    end
    else exit;
    // BufLen MUST be folded up 64 bytes, or a really-nasty thing will happen
    segLen := (BLOb^.SegmentLen + mdx5u.MDXBLOCKMASK) div MDXBLOCK  MDXBLOCK;
    getmem(Buffer, segLen); numSeg := BLOB^.NumSegments;
    BLObHandle := BLOb^.BLObHandle;
    try
      S := '';
      totalSize := 0; Count := 0; mdxinit(Digest);
      while BLOb^.BLObGetSegment(BLObHandle, Buffer, segLen, @Count) > 0 do begin
        S := S + inttoStr(numSeg) + ':' + inttoStr(Count);
        B := Buffer; inc(totalSize, Count); dec(numSeg);
        if numSeg = 0 then begin
          S := S + '=';
          mdxtail(Digest, Buffer, Count, totalSize);
        end
        else begin
          S := S + ',';
          for i := 1 to Count div MDXBLOCK do begin
            mdxfetch(Digest, B); inc(B, MDXBLOCK);
          end
        end;
      end;
      S := S + '>' + inttoStr(totalSize);
      S := mdxDigesttoStr(Digest);
      Result := IBStrAlloc(S);
      Result := IBBufAlloc(@Digest, sizeof(Digest));
    finally
      freemem(Buffer);
    end;
  end;
end;
function md4b(const BLOB: PBLOb): MDxDigestStr; stdcall export;
begin
  Result := mdbsum2(BLOB, mda4);
end;
function md5b(const BLOB: PBLOb): MDxDigestStr; stdcall export;
begin
  Result := mdbsum2(BLOB, mda5);
end;
{
function md5b2(const BLOB: PBLOb): MDxDigestStr; stdcall export;
begin
  Result := mdbsum2(BLOB, mda5);
end;
}
{ dbzCrypt routines }
// encrypt S without containing#0in the result, useful for pchar
// or database string field which does not accept#0within string
type
  PString = Pchar;
  PHexString = PChar; // HexStr size is twice of it's str counterpart
  tStrFunction = function(const S: string): string;
  tStrIDFunction = function(const S: string; const I: integer = 0): string;
function callfndbzCrypt(const P: PChar; const havingfun: tStrFunction): PChar;
begin
  Result := P;
  if P <> nil then
    Result := IBStrAlloc(havingfun(P))
end;
function callfndbzIDCrypt(const P: PChar; const ID: PInteger; const havingfun: tStrIDFunction): PChar;
begin
  Result := P;
  if P <> nil then
    if ID = nil then
      Result := IBStrAlloc(havingfun(P))
    else
      Result := IBStrAlloc(havingfun(P, ID^))
end;
function XOR32(const S: PString): PString; stdcall export; // mod32's string xor32
begin
  Result := callfndbzCrypt(S, dbzCrypt.XOR32);
end;
function XOR32encrypt(const Str: PString): PHexString; stdcall export; // encrypt TO hexStr
begin
  Result := callfndbzCrypt(Str, dbzCrypt.XOR32encrypt);
end;
function XOR32decrypt(const HexStr: PHexString): PString; stdcall export; // decrypt FROM hexStr
begin
  Result := callfndbzCrypt(HexStr, dbzCrypt.XOR32decrypt);
end;
function NZDecrypt(const S: PString): PString; stdcall export;
begin
  Result := callfndbzCrypt(S, dbzCrypt.NZDecrypt);
end;
function NZEncrypt(const S: PString): PString; stdcall export;
begin
  Result := callfndbzCrypt(S, dbzCrypt.NZEncrypt);
end;
function NZDecryptOfHexStr(const HexStr: PHexString): PString; stdcall export;
begin
  Result := callfndbzCrypt(HexStr, dbzCrypt.NZDecryptOfHexStr);
end;
function NZEncryptToHexStr(const Str: PString): PHexString; stdcall export;
begin
  Result := callfndbzCrypt(Str, dbzCrypt.NZEncryptToHexStr);
end;
function NZidDecrypt(const S: PString): PString; stdcall export;
begin
  Result := callfndbzCrypt(S, dbzCrypt.NZidDecrypt);
end;
function NZidEncrypt(const S: PString; const ID: PInteger = nil): PString; stdcall cdecl export;
begin
  Result := callfndbzIDCrypt(S, ID, dbzCrypt.NZidEncrypt);
end;
function NZidDecryptOfHexStr(const HexStr: PHexString): PString; stdcall export;
begin
  Result := callfndbzCrypt(HexStr, dbzCrypt.NZidDecryptOfHexStr);
end;
function NZidEncryptToHexStr(const Str: PString; const ID: PInteger = nil): PHexString; stdcall cdecl export;
begin
  Result := callfndbzIDCrypt(Str, ID, dbzCrypt.NZidEncryptToHexStr);
end;
function HexStrtoStr(const HexStr: PString): PString; stdcall export;
begin
  Result := callfndbzCrypt(HexStr, dbzCrypt.HexStrtoStr);
end;
function StrtoHexStr(const HexStr: PString): PString; stdcall export; // HexStr size is twice of it's str counterpart
begin
  Result := callfndbzCrypt(HexStr, dbzCrypt.StrtoHexStr);
end;
function getver: longword; stdcall export;
begin
  Result := $01000001;
end;
function getverstr: PChar; stdcall export;
var
  v: cardinal;
begin
  v := getVer;
  Result := IBBufAlloc(@v, sizeof(v));
end;
function testnull4(const I: PInteger): PInteger; stdcall export;
begin
  Result := nil;
  if I <> nil then begin
    IBBufAlloc(Result, 4); Result^ := I^ - 1
  end;
end;
const
  QUOTE_CHAR = '''';
function quotedStr(const P: PChar; const Q: PChar = nil): PChar; stdcall export;
var
  QUOTE: char;
begin
  Result := nil;
  if P <> nil then begin
    if Q <> '' then QUOTE := Q^ else QUOTE := QUOTE_CHAR;
    Result := IBStrAlloc(AnsiQuotedStr(P, QUOTE))
  end;
end;
function unquotedStr(const P: PChar; const Q: PChar = nil): PChar; stdcall export;
var
  S: string;
  PS: PChar;
  QUOTE: char;
begin
  Result := nil;
  if P <> nil then begin
    S := P; PS := PChar(S);
    if Q <> '' then QUOTE := Q^ else QUOTE := QUOTE_CHAR;
    Result := IBStrAlloc(AnsiExtractQuotedStr(PS, QUOTE))
  end;
end;
{ from this point forward are our private routines, don't bother }
{ make a virtually impossible console for login password }
function makeNIPKeyPass(const PNIP: PLongword = nil; const PKey: PLongword = nil): PChar; stdcall cdecl export;
function strint(const I: integer): string; asm
    push eax; mov eax,edx; call System.@LStrClr;
    push 4; pop edx; call System.@LStrSetLength;
    pop edx; mov eax,[eax]; mov [eax],edx;
  end;
function strint64(const I: int64): string; asm
    call System.@LStrClr;
    push 8; pop edx; call System.@LStrSetLength;
    mov ecx,dword[I]; mov edx,dword[I+4];
    mov eax,[eax]; mov [eax],ecx; mov [eax+4],edx;
  end;
const
  Chachacha =#10#26#27#28;//^i^m^j^[; // to prevent console login
var
  SKey: string;
begin
  Result := nil; if PNIP <> nil then begin
    if (PKey = nil) or (PKey^ = 0) then
      SKey := ChaChaCha
    else
      SKey := strint(dbzCrypt.asmInttoNZN(PKey^));
    SKey := SKey + strint(dbzCrypt.asmInttoNZN(PNIP^));
    Result := IBBufAlloc(PChar(SKey), 8);
  end;
end;
function FullName(const Prefix, RealName: PChar; const Suffix: PChar = nil): PChar; stdcall cdecl export;
// Pretty concatenated Prefix (firstname/attributes) + RealName + Suffix (lastname/attributes)
// Prefix: [Mrs.] RealName: [Inge DR] Suffix: [SE, AK, MFM] returns:  'Mrs. Inge DR, SE, AK, MFM'
var
  S: string;
begin
  if RealName = nil then Result := nil
  else begin
    S := Prefix;
    if S <> '' then S := S + ' ';
    S := trim(S + trim(RealName));
    if Suffix <> '' then S := S + ', ' + Suffix;
    Result := IBStrAlloc(S);
  end;
end;
function GroupedName(const PKeg: PSmallint; const PName: PChar; const PBLockSize: PSmallint = nil): PChar; stdcall cdecl export;
// returns Group name prefixed by letter 'A' to 'Z', 'a' to 'z', group element name prefixed by
// number ' 1' to '99' (Block100), '  1' to '999' (block1000), '   1' to '9999' (block10000) etc...
// (note for group elements: with adittional spaces prefix as necessary)
const
  A0 = ord('A') - 1;
  A1 = ord('a') - ord('A');
  ZERO = ord('0');
var
  S: string;
  Block: smallint;
  j, k, l: word;
begin
  if (PKeg = nil) or (PName = nil) then Result := nil
  else begin
    Block := 100;
    if (PBLockSize <> nil) and (PBlockSize^ > 100) then Block := abs(PBlockSize^);
    math.DivMod(abs(PKeg^), Block, j, k);
    if k = 0 then begin
      if j > 26 then begin
        if j > 52 then j := 52;
        inc(j, A1);
      end;
      S := char(j + A0)
    end
    else begin
      if k < 10 then
        S := ' ' + char(k + ZERO)
      else
        S := inttoStr(k);
      if block > 100 then begin
        l := 3;
        if block > 1000 then l := 4;
        if block > 10000 then l := 5;
        while length(S) < l do S := ' ' + S;
      end;
    end;
    S := S + '. ' + trim(PName);
    Result := IBStrAlloc(S);
  end;
end;
type
  TStr3 = string;
const
  X100: PChar = (
    '00010203040506070809' + '10111213141516171819' +
    '20212223242526272829' + '30313233343536373839' +
    '40414243444546474849' + '50515253545556575859' +
    '60616263646566676869' + '70717273747576777879' +
    '80818283848586878889' + '90919293949596979899'
    );
function asmfix3digits(const I: integer): TStr3;
// fixed inttoStr by 3 digits '000' .. '999' // out of [0..999] returns: '000'
asm
  push eax; mov eax,edx; call System.@LStrClr;
  mov edx,3; call System.@LStrSetLength;
  mov eax,[eax]; mov ecx,'000';
  pop edx; mov [eax],ecx;
  cmp edx,1000; sbb ecx,ecx;
  and edx,ecx; jz @@done
    cmp edx,100; jb @@12;
    push 100; pop ecx;
    push eax; mov eax,edx;
    xor edx,edx; div cx;  // ax=Q, dx=R
    mov cl,al; or cl,'0';
    pop eax; mov [eax],cl
    @@12:
      mov ecx,dword ptr X100;
      mov dx,[ecx+edx 2]
      mov [eax+1],dx
  @@done:
end;
function asmfix3pdigits(const I: integer; const DOT: char = '.'): TStr3;
// fixed inttoStr by 3 digits '000' .. '999' // out of [0..999] returns: '000'
// prefixed by DOT, make them '.000' .. '.999' // customizable DOT character
asm
  push I; mov eax,Result;
  movzx edx,dl; push edx;
  call System.@LStrClr;
  mov edx,4; call System.@LStrSetLength;
  mov eax,[eax];
  pop ecx; or ecx,('000' shl 8)
  pop edx; mov [eax],ecx;
  cmp edx,1000; sbb ecx,ecx;
  and edx,ecx; jz @@done
    cmp edx,100; jb @@12;
    push 100; pop ecx;
    push eax; mov eax,edx;
    xor edx,edx; div cx;  // ax=Q, dx=R
    mov cl,al; or cl,'0';
    pop eax; mov [eax+1],cl
    @@12:
      mov ecx,dword ptr X100;
      mov dx,[ecx+edx2]
      mov [eax+2],dx
  @@done:
end;
function asmfix3n(const I: integer): integer; overload;
// fixed inttoStr by 3 digits ord('000') .. ord('999') // out of [0..999] returns: '000'
// in hexadecimal representation in 4 bytes of integer (the last/Most-Significant-byte) is#0
// note: the first byte is the least-significant-byte, the last byte is the most-significant-byte
// $00303132 = '210'#0
asm
  cmp eax,1000; sbb edx,edx;
  and edx,eax; mov eax,'000';
  jz @@done_
    push 100; pop ecx;
    cmp edx,ecx;
    jb @@12
      mov eax,edx; xor edx,edx; div cx;
      or eax,'0';
    @@12:
      mov ecx,dword ptr[X100]
      movzx edx,word[ecx+edx 2]
      shl edx,8; or eax,edx
  @@done_:
end;
function asmfix3np(const I: integer; const DOT: char): integer; overload;
// fixed inttoStr by 3 digits ord('000') .. ord('999') // out of [0..999] returns: '000'
// prefixed by DOT as first byte, make them '.000' .. '.999' // customizable DOT character
// NOTE! if DOT is char#0then the MOST significant byte (last byte) which will be#0
// (not the first/least-significant byte, since it doesn't make sense to be converted to PChar);
asm
  test dl,dl; movzx ecx,dl;
  jz asmfix3n;
  or ecx,'000' shl 8; push ecx;
  cmp eax,1000; sbb edx,edx;
  and edx,eax; mov eax,ecx;
  jz @@done_
    push 100; pop ecx;
    cmp edx,ecx;
    jb @@12
      mov eax,edx; xor edx,edx; div cx;
      or eax,'0'; mov ah,al
    @@12:
      mov ecx,dword ptr[X100]
      movzx edx,word[ecx+edx2]
      shl edx,16; or eax,edx
  @@done_: pop edx; mov al,dl
end;
function NPWPStr12(const Str9: string): string; // 12 digits without KPP/cabang
const
  KPPID = '550-'; // intel's reversed of '-055'
asm
  push eax; mov eax,edx; call System.@LStrClr;
    mov edx,12; call System.@LStrSetLength
    mov eax,[eax]; mov edx,'0.00';
    mov ecx,'550-'; mov [eax],edx;
    mov [eax+4],edx; mov eax+8,edx;
  pop edx; mov ecx,[edx]; // 12,
  push ebx; mov bl,[edx+2] //3
    mov[eax],cx; mov[eax+3],bl; //
    mov cx,[edx+3]; mov bl,[edx+5] ;//45,6
    mov [eax+4],cx; mov [eax+7],bl
    mov cx,[edx+6]; mov bl,[edx+8] ;//78, 9
    mov [eax+8],cx; mov [eax+11],bl
  pop ebx;
end;
type
  TInt4chars = integer;
const
  zero9 = '000000000';
  NPWP_ZERO_DIGITS = length(zero9);
function __NPWPStr(const Str9: string; const KPP, Cabang: TInt4chars): string; // 12 digits without KPP/cabang
asm
  push edx; push ecx;
  push eax; mov eax,Result; call System.@LStrClr;
    mov edx,20; call System.@LStrSetLength
    mov eax,[eax]; mov edx,'0.00';
    mov ecx,'550-'; mov [eax],edx;
    mov [eax+4],edx; mov eax+8,edx;
  pop edx; mov ecx,[edx]; // 12,
  push ebx; mov bl,[edx+2] //3
    mov[eax],cx; mov[eax+3],bl; //
    mov cx,[edx+3]; mov bl,[edx+5] ;//45,6
    mov [eax+4],cx; mov [eax+7],bl
    mov cx,[edx+6]; mov bl,[edx+8] ;//78, 9
    mov [eax+8],cx; mov [eax+11],bl
  pop ebx; pop ecx; pop edx;
  mov eax+12,edx; mov eax+16,ecx;
end;
function _NPWPStr(const NPWP: integer; const KPP: integer; const Cabang: integer): string; overload;
var
  i, nKPP, nCab: integer;
begin
  Result := inttoStr(cardinal(NPWP));
  i := NPWP_ZERO_DIGITS - length(result);
  if i > 0 then Result := copy(zero9, 1, i) + Result;
  nKPP := asmfix3np(KPP, '-'); nCab := asmfix3np(Cabang, '.');
  Result := __NPWPStr(Result, nKPP, nCab);
end;
function NPWPStr(const NPWP: PLongword; const PKPP: PSmallInt = nil; PCabang: PSmallInt = nil): PChar; stdcall cdecl export;
const
  DEFAULT_KPP = 055;
var
  S: string;
  nKPP, nCabang: integer;
begin
  Result := nil;
  if NPWP <> nil then begin
    nKPP := DEFAULT_KPP; nCabang := 0;
    if PKPP <> nil then nKPP := PKPP^;
    if PCabang <> nil then nCabang := PCabang^;
    S := _NPWPStr(NPWP^, nKPP, nCabang);
    Result := IBStrAlloc(S);
  end
end;
function NPWPStrCab(const NPWP: PLongword; const PCabang: PSmallInt = nil): PChar; stdcall cdecl export;
begin
  Result := NPWPStr(NPWP, nil, PCabang);
end;
// end of private routines
exports
  FullName name 'fullname', GroupedName name 'groupedname',
  NPWPStr name 'npwpstr', NPWPStrCab name 'npwpstrcab',
  NZidEncryptToHexStr name 'nzid_encrypto_hexstr',
  NZidDecryptOfHexStr name 'nzid_decrypt_hexstr',
  NZidEncrypt name 'nzid_encrypt',
  NZidDecrypt name 'nzid_decrypt',
  NZEncryptToHexStr name 'nz_encrypto_hexstr',
  NZDecryptOfHexStr name 'nz_decrypt_hexstr',
  NZEncrypt name 'nz_encrypt',
  NZDecrypt name 'nz_decrypt',
  XOR32encrypt name 'xor32_encrypt',
  XOR32decrypt name 'xor32_decrypt',
  XOR32 name 'xor32',
  HexStrtoStr name 'hexstr_to_str', StrtoHexStr name 'str_to_hexstr',
  genUUID name 'ass_gen_uuid', md5n, md4n, md5b, md4b, md5, md4,
  UserMod3 name 'usr_mod3', UserAdd3 name 'usr_add3',
  UserMod name 'usr_mod', UserAdd name 'usr_add', UserDel name 'usr_del',
  LocalUserMod name 'lusr_mod', LocalUserAdd name 'lusr_add', LocalUserDel name 'lusr_del',
  makeNIPKeyPass name 'makenipkeypass',
  BLOBInfo name 'blob_info', BLOBSegLen name 'blob_seglen', BLOBSegments name 'blob_segments', BLOBSize name 'blob_size',
  quotedStr name 'quotedstr', unquotedStr name 'unquotedstr',
  //bin_not(const P: PShortInt), bin_not(const P: PSmallInt), bin_not(const P: PInt64), bin_not(const P: PInteger),
  //bins(const P: PInteger; const length: integer), bins(const P: PInteger), bins64(const P: PInt64),
  bin, bin64, bin16, bin8, bin_not, bin64_not, bin16_not,
  getVer, getVerStr; //, testnull4; //, testnull, testnull2;
begin
  isMultiThread := TRUE;
end.
// RSPI: 769-2252; Poli-Anak: 769-2250;

ass.SQL

/
Copyright 2005-2008 aa, Adrian Hafizh & Ray AF
private property of PT SOFTINDO, JAKARTA
All rights reserved
/
/
set term ^; -- stupid
-- A32: varchar(31)
-- S32: varchar(31) not null
-- TEXT: varchar(1023)
recreate procedure "dropxfun"(fn S32) as begin
if (exists(select 1 from rdb$functions where rdb$function_name = :fn)) then
execute statement 'drop external function "' || fn || '" ';
end^ -- grant execute on procedure "dropxfun" to asswUser, asswReport^
recreate procedure "declxfun"(fn S32, S TEXT) as declare dfn A32; begin
dfn = ' external function "' || fn || '" ';
if (not exists(select 1 from rdb$functions where rdb$function_name = :fn)) then
execute statement 'create' || dfn || S;
end^ -- grant execute on procedure "declxfun" to asswUser, asswReport^
recreate procedure "redeclxfun"(fn S32, S TEXT) as declare dfn A32; begin
dfn = ' external function "' || fn || '" ';
if (exists(select 1 from rdb$functions where rdb$function_name = :fn)) then
execute statement 'drop' || dfn;
execute statement 'create' || dfn || S;
end^ -- grant execute on procedure "redeclxfun" to asswUser, asswReport^
set term ;^ -- stupid
commit;
grant execute on procedure "dropxfun" to asswUser, asswReport;
grant execute on procedure "declxfun" to asswUser, asswReport;
grant execute on procedure "redeclxfun" to asswUser, asswReport;
/
declare external function assver returns integer by value entry_point 'getver' module_name 'ass';
declare external function assverstr returns Char(4) character set octets free_it entry_point 'getverstr' module_name 'ass';
declare external function bin_not integer null returns integer free_it entry_point 'bin_not' module_name 'ass';
declare external function bin16_not smallint null returns smallint free_it entry_point 'bin16_not' module_name 'ass';
declare external function bin64_not bigint null returns bigint free_it entry_point 'bin64_not' module_name 'ass';
declare external function bin integer null returns Char(32) free_it entry_point 'bin' module_name 'ass';
declare external function bin8 integer null returns Char(8) free_it entry_point 'bin8' module_name 'ass';
declare external function bin16 integer null returns Char(16) free_it entry_point 'bin16' module_name 'ass';
declare external function bin64 bigint null returns Char(64) free_it entry_point 'bin64' module_name 'ass';
declare external function quotedStr CString(63) null returns CString(63) free_it entry_point 'quotedstr' module_name 'ass';
declare external function unquotedStr CString(63) null returns CString(63) free_it entry_point 'unquotedstr' module_name 'ass';
declare external function quotedStrL CString(1023) null returns CString(1023) free_it entry_point 'quotedstr' module_name 'ass';
declare external function unquotedStrL CString(1023) null returns CString(1023) free_it entry_point 'unquotedstr' module_name 'ass';
declare external function quotedCStr CString(63) null, Char(1) null returns CString(63) free_it entry_point 'quotedstr' module_name 'ass';
declare external function unquotedCStr CString(63) null, Char(1) null returns CString(63) free_it entry_point 'unquotedstr' module_name 'ass';
declare external function quotedCStrL CString(1023) null, Char(1) null returns CString(1023) free_it entry_point 'quotedstr' module_name 'ass';
declare external function unquotedCStrL CString(1023) null, Char(1) null returns CString(1023) free_it entry_point 'unquotedstr' module_name 'ass';
declare external function genGUID returns char(16) character set octets free_it entry_point 'gen_uuid' module_name 'ass';
declare external function BLOBinfo BLOb null returns CString(47) free_it entry_point 'blob_info' module_name 'ass';
declare external function BLOBSegments BLOb null returns integer free_it entry_point 'blob_segments' module_name 'ass';
declare external function BLOBSegLen BLOb null returns integer free_it entry_point 'blob_seglen' module_name 'ass';
declare external function BLOBSize BLOb null returns integer free_it entry_point 'blob_size' module_name 'ass';
/             
All of these long strings CString(95) here could be
changed to any length permitted by server's string type
max folded8: IB6 = CString(16375), FB21 = CString(32759)
              /
declare external function md4 CString(95) null returns Char(16) character set octets free_it entry_point 'md4' module_name 'ass';
declare external function md5 CString(95) null returns Char(16) character set octets free_it entry_point 'md5' module_name 'ass';
declare external function md4b BLOb null returns Char(16) character set octets free_it entry_point 'md4b' module_name 'ass';
declare external function md5b BLOb null returns Char(16) character set octets free_it entry_point 'md5b' module_name 'ass';
declare external function md4n CString(95) null, integer returns Char(16) character set octets free_it entry_point 'md4n' module_name 'ass';
declare external function md5n CString(95) null, integer returns Char(16) character set octets free_it entry_point 'md5n' module_name 'ass';
declare external function StrToHexStr CString(95) null returns CString(95) free_it entry_point 'str_to_hexstr' module_name 'ass';
declare external function HexStrToStr CString(95) null returns CString(95) free_it entry_point 'hexstr_to_str' module_name 'ass';
declare external function XOR32 CString(95) null returns CString(95) free_it entry_point 'xor32' module_name 'ass';
declare external function xor32Decrypt CString(95) null returns CString(95) free_it entry_point 'xor32_decrypt' module_name 'ass';
declare external function xor32Encrypt CString(95) null returns CString(95) free_it entry_point 'xor32_encrypt' module_name 'ass';
declare external function "nzDecrypt" CString(95) null returns CString(95) free_it entry_point 'nz_decrypt' module_name 'ass';
declare external function "nzEncrypt" CString(95) null returns CString(95) free_it entry_point 'nz_encrypt' module_name 'ass';
declare external function "nzDecryptHexStr" CString(95) null returns CString(95) free_it entry_point 'nz_decrypt_hexstr' module_name 'ass';
declare external function "nzEncryptoHexStr" CString(95) null returns CString(95) free_it entry_point 'nz_encrypto_hexstr' module_name 'ass';
declare external function "nzidDecrypt" CString(95) null returns CString(95) free_it entry_point 'nzid_decrypt' module_name 'ass';
declare external function "nzidEncrypt" CString(95) null, integer null returns CString(95) free_it entry_point 'nzid_encrypt' module_name 'ass';
declare external function "nzidDecryptHexStr" CString(95) null returns CString(95) free_it entry_point 'nzid_decrypt_hexstr' module_name 'ass';
declare external function "nzidEncryptoHexStr" CString(95) null, integer null returns CString(95) free_it entry_point 'nzid_encrypto_hexstr' module_name 'ass';
declare external function "makeNIPPass" integer null returns Char(8) character set octets free_it entry_point 'makenipkeypass' module_name 'ass';
declare external function "makeNIPKeyPass" integer null, integer null returns Char(8) character set octets free_it entry_point 'makenipkeypass' module_name 'ass';
commit;
comment on external function "makeNIPPass" is 'makeNIPPass(NIP)';
comment on external function "makeNIPKeyPass" is 'makeNIPKeyPass(NIP, Key)';
declare external function Fullname CString(31) null, CString(47) null, CString(31) null returns CString(63) free_it entry_point 'fullname' module_name 'ass';
declare external function GroupedName smallint null, CString(79) null returns CString(79) free_it entry_point 'groupedname' module_name 'ass';
declare external function GroupedNameEx smallint null, CString(79) null, smallint null returns CString(79) free_it entry_point 'groupedname' module_name 'ass';
declare external function NPWPStr integer null returns Char(20) free_it entry_point 'npwpstr' module_name 'ass';
declare external function NPWPStrKPP integer null, smallint null returns Char(20) free_it entry_point 'npwpstr' module_name 'ass';
declare external function NPWPStrCab integer null, smallint null returns Char(20) free_it entry_point 'npwpstrcab' module_name 'ass';
declare external function NPWPStrKPPCab integer null, smallint null, smallint null returns Char(20) free_it entry_point 'npwpstr' module_name 'ass';
commit;
comment on external function Fullname is 'FullName(Prefix, Name, Suffix)';
comment on external function GroupedName is 'GroupedName(ID, Name)';
comment on external function GroupedNameEx is 'GroupedNameEx(ID, Name, BlockSize = 100)';
comment on external function NPWPStr is 'NPWPStr(NPWP); default KPP = 055, Cabang = 0';
comment on external function NPWPStrKPP is 'NPWPStrKPP(NPWP, KPP = 055); default Cabang = 0';
comment on external function NPWPStrCab is 'NPWPStrCab(NPWP, Cabang = 0); default KPP = 055';
comment on external function NPWPStrKPPCab is 'NPWPStrKPPCab(NPWP, KPP = 055, Cabang = 0)';
/                 
note:	password declared as CString(19) only for convenience
it will be silently truncated upto max. 8 chars by program
(i felt uncomfort to type masterke without 'y')
caution! these actually are dangerous functions, particularly for
LocalUserAdd/Del/Mod, anyone can create and modify any user
(except sysdba, of course)
                 */
-- Local User
declare external function "LocalUserDel" CString(31) null -- username
returns integer by value entry_point 'lusr_del' module_name 'ass';
declare external function "LocalUserAdd"
CString(31) null, CString(19) null -- username/password
returns integer by value entry_point 'lusr_add' module_name 'ass';
declare external function "LocalUserAdd2"
CString(31) null, CString(19) null, -- username/password
CString(31) null, CString(31) null, CString(31) null -- first/middle/last-name
returns integer by value entry_point 'lusr_add' module_name 'ass';
declare external function "LocalUserAdd3"
CString(31) null, CString(19) null, -- username/password
CString(31) null, CString(31) null, CString(31) null, -- first/middle/last-name
integer null, integer null, CString(31) null -- UID/GID/Groupname
returns integer by value entry_point 'lusr_add' module_name 'ass';
--
commit;
comment on external function "LocalUserDel" is 'LocalUserDel(UserName)';
comment on external function "LocalUserAdd" is 'LocalUserAdd(UserName, Password)';
comment on external function "LocalUserAdd2" is 'LocalUserAdd2(UserName, Password, FirstName, MiddleName, LastName)';
comment on external function "LocalUserAdd3" is 'LocalUserAdd3(UserName, Password, FirstName, MiddleName, LastName, UID, GID, GroupName)';
--
declare external function "LocalUserMod"
CString(31) null, CString(19) null -- username/password
returns integer by value entry_point 'lusr_mod' module_name 'ass';
declare external function "LocalUserMod2"
CString(31) null, CString(19) null, -- username/password
CString(31) null, CString(31) null, CString(31) null -- first/middle/last-name
returns integer by value entry_point 'lusr_mod' module_name 'ass';
declare external function "LocalUserMod3"
CString(31) null, CString(19) null, -- username/password
CString(31) null, CString(31) null, CString(31) null, -- first/middle/last-name
integer null, integer null, CString(31) null -- UID/GID/Groupname
returns integer by value entry_point 'lusr_mod' module_name 'ass';
--
commit;
comment on external function "LocalUserMod" is 'LocalUserMod(UserName, Password)';
comment on external function "LocalUserMod2" is 'LocalUserMod2(UserName, Password, FirstName, MiddleName, LastName)';
comment on external function "LocalUserMod3" is 'LocalUserMod3(UserName, Password, FirstName, MiddleName, LastName, UID, GID, GroupName)';
--
-- Generic User Maintenance (Local and Remote)
declare external function "UserDel"
CString(31) null, -- CString(19) null, -- username -- /password
CString(63) null, integer null, -- server/protocol
CString(31) null, CString(19) null -- sysdba/masterkey
returns integer by value entry_point 'usr_del' module_name 'ass';
declare external function "UserAdd"
CString(31) null, CString(19) null, -- username/password
CString(63) null, integer null, -- server/protocol
CString(31) null, CString(19) null -- sysdba/masterkey
returns integer by value entry_point 'usr_add' module_name 'ass';
declare external function "UserAdd2"
CString(31) null, CString(19) null, -- username/password
CString(63) null, integer null, -- server/protocol
CString(31) null, CString(19) null, -- sysdba/masterkey
CString(31) null, CString(31) null, CString(31) null -- first/middle/last-name
returns integer by value entry_point 'usr_add' module_name 'ass';
declare external function "UserAdd3"
CString(31) null, CString(19) null, -- username/password
CString(63) null, integer null, -- server/protocol
CString(31) null, CString(19) null, -- sysdba/masterkey
integer null, integer null, CString(31) null -- UID/GID/Groupname
returns integer by value entry_point 'usr_add3' module_name 'ass';
--
commit;
comment on external function "UserDel" is 'UserDel(sUserName, sServer, nProtocol, sSysDBA, smasterkey)';
comment on external function "UserAdd" is 'UserAdd(sUserName, sPassword, sServer, nProtocol, sSysDBA, smasterkey)';
comment on external function "UserAdd2" is 'UserAdd2(sUserName, sPassword, sServer, nProtocol, sSysDBA, smasterkey, sFirstName, sMiddleName, sLastName)';
comment on external function "UserAdd3" is 'UserAdd3(sUserName, sPassword, sServer, nProtocol, sSysDBA, smasterkey, nUID, nGID, sGroupName)';
--
declare external function "UserMod"
CString(31) null, CString(19) null, -- username/password
CString(63) null, integer null, -- server/protocol
CString(31) null, CString(19) null -- sysdba/masterkey
returns integer by value entry_point 'usr_mod' module_name 'ass';
declare external function "UserMod2"
CString(31) null, CString(19) null, -- username/password
CString(63) null, integer null, -- server/protocol
CString(31) null, CString(19) null, -- sysdba/masterkey
CString(31) null, CString(31) null, CString(31) null -- first/middle/last-name
returns integer by value entry_point 'usr_mod' module_name 'ass';
declare external function "UserMod3"
CString(31) null, CString(19) null, -- username/password
CString(63) null, integer null, -- server/protocol
CString(31) null, CString(19) null, -- sysdba/masterkey
integer null, integer null, CString(31) null -- UID/GID/Groupname
returns integer by value entry_point 'usr_mod3' module_name 'ass';
--
commit;
comment on external function "UserMod" is 'UserMod(sUserName, sPassword, sServer, nProtocol, sSysDBA, smasterkey)';
comment on external function "UserMod2" is 'UserMod2(sUserName, sPassword, sServer, nProtocol, sSysDBA, smasterkey, sFirstName, sMiddleName, sLastName)';
comment on external function "UserMod3" is 'UserMod3(sUserName, sPassword, sServer, nProtocol, sSysDBA, smasterkey, nUID, nGID, sGroupName)';
--
commit;