Arsip: Membuat sendiri UDF library bag.3


by _aa_ in TipDanTrik more 12 years ago 1645
sec_h.pas
unit sec_h; { Copyright (c) 2004, aa, Adrian H. & Ray AF Property of PT SOFTINDO Jakarta. All rights reserved. } {$ALIGN 4} interface type { these are for hints only, do NOT mean to prevent arbitrary length input } VarChar8 = PAnsiChar; VarChar32 = PAnsiChar; VarChar64 = PAnsiChar; //VarChar128 = PAnsiChar; Short = smallint; // NOT shortint!; Delphi's shortint is signed char; PConSecProtocol = ^TConSecProtocol; {$Z4} // important! 4 bytes enumerated size TConSecProtocol = (cspNone, cspTCPIP, cspNetBEUI, cspSPX, cspLocal); // note protocol SPX is deprecated TSecuritySpec = (ssUID, ssGID, ssServer, ssPassword, ssGroupName, ssFirstName, ssMiddleName, sslastName, ssSysDBA, ssMasterKey); TSecuritySpecSet = set of TSecuritySpec; PUserSecData = ^TUserSecData; TUserSecData = record SecFlags: TSecuritySpecSet; UID, GID: integer; Protocol: TConSecProtocol; Server: VarChar64; UserName: VarChar32; Password: VarChar8; GroupName: varChar32; FirstName, MiddleName, LastName: VarChar32; SysDBA: VarChar32; MasterKey: VarChar8; end; TISCStatus = integer; PISCStatusVector = ^TISCStatusVector; TISCStatusVector = array[0..20 - 1] of TISCStatus; tSecOperation = (opAdd, opDel, opMod); const fbclient = 'fbclient.dll'; //Chachacha =#10#26#27#28;//^i^m^j^[; // to prevent console login _MasterKey_: string = #10#13#26#27#28'Sys'; _SysDBA_: string = 'SysDBA'; function ISCUserAdd(Status: PISCStatusVector; Data: PUserSecData): TISCStatus; stdcall; external fbclient name 'isc_add_user'; function ISCUserDel(Status: PISCStatusVector; Data: PUserSecData): TISCStatus; stdcall; external fbclient name 'isc_delete_user'; function ISCUserMod(Status: PISCStatusVector; Data: PUserSecData): TISCStatus; stdcall; external fbclient name 'isc_modify_user'; function _sex(const op: tSecOperation; const UserName: PChar; const Password: PChar = nil; const FirstName: Pchar = nil; const MiddleName: Pchar = nil; const LastName: PChar = nil; const Server: PChar = nil; const Protocol: PConSecProtocol = nil; const isLocal: boolean = true; const SysDBA: PChar = nil; const MasterKey: PChar = nil; const UID: PInteger = nil; const GID: Pinteger = nil; const GroupName: PChar = nil): TISCStatus; implementation procedure clearUserSecData(var data: TUserSecData; const UserName: varChar32; const Password: varChar8 = nil); begin with data do begin SecFlags := []; UID := 0; GID := 0; GroupName := nil; Protocol := cspLocal; Server := nil; FirstName := nil; MiddleName := nil; LastName := nil; SysDBA := nil; MasterKey := nil; end; data.UserName := UserName; data.Password := Password; if Password <> nil then data.SecFlags := [ssPassword] end; procedure initUserSecData(var data: TUserSecData; const FirstName: VarChar32 = nil; const MiddleName: VarChar32 = nil; const LastName: VarChar32 = nil; const UID: PInteger = nil; const GID: PInteger = nil; const GroupName: VarChar32 = nil); var ss: TSecuritySpecSet; begin ss := []; if UID <> nil then begin include(ss, ssUID); data.UID := UID^; end; if GID <> nil then begin include(ss, ssGID); data.GID := GID^; end; if GroupName <> nil then begin include(ss, ssGroupName); data.GroupName := GroupName; end; if FirstName <> nil then begin include(ss, ssFirstName); data.FirstName := FirstName; end; if MiddleName <> nil then begin include(ss, ssMiddleName); data.MiddleName := MiddleName; end; if LastName <> nil then begin include(ss, sslastName); data.LastName := LastName; end; with data do SecFlags := secFlags + ss; end; procedure initUserSecDataEx(var data: TUserSecData; const Server: VarChar64 = nil; const Protocol: PConSecProtocol = nil; const SysDBA: VarChar32 = nil; const MasterKey: VarChar8 = nil); var ss: TSecuritySpecSet; begin ss := []; if Protocol <> nil then data.Protocol := Protocol^; if Server <> nil then begin include(ss, ssServer); data.Server := Server; end; if SysDBA <> nil then begin include(ss, ssSysDBA); data.SysDBA := SysDBA; end; if MasterKey <> nil then begin include(ss, ssMasterKey); data.MasterKey := MasterKey; end; with data do SecFlags := secFlags + ss; end; function _sex; var SVec: TISCStatusVector; data: TUserSecData; PMasterKey, PPassword: PChar; SMasterKey, SPassword: string; begin Result := -1; if op = opDel then PPassword := nil else begin PPassword := Password; if (Password <> nil) and (length(Password) > 8) then begin SPassword := copy(string(pChar(password)), 1, 8); PPassword := PChar(SPassword); end; end; clearUserSecData(data, UserName, PPassword); if op <> opDel then initUserSecData(data, FirstName, MiddleName, LastName, UID, GID, GroupName); if not isLocal then begin PMasterKey := MasterKey; if (MasterKey <> nil) and (length(MasterKey) > 8) then begin SMasterKey := copy(string(pChar(MasterKey)), 1, 8); PMasterKey := PChar(SMasterKey); end; initUserSecDataEx(data, Server, Protocol, SysDBA, PMasterKey); end; case op of opAdd: Result := ISCUserAdd(@</b>SVec, @</b>data); opDel: Result := ISCUserDel(@</b>SVec, @</b>data); opMod: Result := ISCUserMod(@</b>SVec, @</b>data); end; end; end.
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;