Library encodedatetime;
Uses Sysutils, Classes, Dateutils, MSSQLODS;
// the wrapper of ntwdblib.dll
{$ R * .res}
Const XP_noError = 0; XP_ERROR = 1;
MAX_SERVER_ERROR = 20000; XPERR_UNKNOWN = MAX_SERVER_ERROR 1; XPERR_INVALID_PARAM_COUNT = MAX_SERVER_ERROR 2; XPERR_INVALID_DATA_TYPE = MAX_SERVER_ERROR 3; XPERR_ODS_FUNC_FAIL = MAX_SERVER_ERROR 4; XPERR_INVALID_PARAM_TYPE = MAX_SERVER_ERROR 5; XPERR_INVALID_PARAM = MAX_SERVER_ERROR 6; XPERR_DATA_CONVERT = MAX_SERVER_ERROR 7;
Type pdbdatetime4 = ^ dbdatetime4; pdbdatetime = ^ DBDATETIME;
Function __getxpversion: ulong; stdcall; begin result: = ODS_VERSION;
procedure SendError (pSrvProc: PSRV_PROC; aErrCode: Integer; szErrorMsg: string); begin srv_sendmsg (pSrvProc, SRV_MSG_ERROR, aErrCode, 16, 1, nil, 0, 1, PChar (szErrorMsg), Length (szErrorMsg));
SRV_SENDDONE (PSRVProc, SRV_DONE_ERROR OR SRV_DONE_MORE, 0, 0); END;
function dwxp_encode_datetime (pSrvProc: PSRV_PROC): SRVRETCODE; stdcall; {execute dwxp_encode_datetime @year, --1 integer @month, --2 integer @day, --3 integer @hour, --4 integer @minute, --5 integer @second, --6 integer @milliseconds, --7 integer @datetime output --8 datetime} var i: integer; btype, btype2: byte; cbmaxlen, cbactuallen: ulong; dt4: dbdatetime4; dt: dbdatetime; fnull: boolean ; vByte: Byte; vWord: Word; vLongWord: LongWord; vParams1_7: array [1..7] of LongWord; vPointer: Pointer; vDateTime: TDateTime; vDateTimeStr: string; begin Result: = XP_ERROR; if srv_rpcparams (pSrvProc) <> 8 THEN Begin Senderror (psrvproc, xperr_invalid_param_count, 'dwxp_encode_datetime: The number of parameters does not meet the requirements.'); Exit;
if srv_paraminfo (pSrvProc, 1, @bType, @cbMaxLen, @cbActualLen, nil, @fNull) = FAIL then begin SendError (pSrvProc, XPERR_ODS_FUNC_FAIL, 'dwxp_encode_datetime: Failed call srv_paraminfo.'); Exit; end;
IF (SRV_PARAMSTATUS (PsrvProc, 8) = 0 The begin Senderror (psrvproc, xperr_invalid_param_type, 'dwxp_encode_datetime: @datetime parameters must be declared as Output.'); exit; end;
for I: = 1 to 7 do begin if srv_paraminfo (pSrvProc, I, @bType, @cbMaxLen, @cbActualLen, nil, @fNull) = FAIL then begin SendError (pSrvProc, XPERR_ODS_FUNC_FAIL, 'dwxp_encode_datetime: Failed call srv_paraminfo.') ;
if fNull then begin SendError (pSrvProc, XPERR_INVALID_PARAM, Format ( 'dwxp_encode_datetime:% d parameter can not be NULL.', [I])); Exit; end; case bType of SRVINT1: vPointer: = @vByte; SRVINT2: vPointer: = @vword; srvint4, srvintn: vpointer: = @vlongword; else senderror (psrvproc, xperr_invalid_data_type, format ('dwxp_encode_datetime: The data type of parameter% D does not meet the requirements.% d', [i, btype]); exit; end; ;
if srv_paraminfo (pSrvProc, I, @bType, @cbMaxLen, @cbActualLen, vPointer, @fNull) = FAIL then begin SendError (pSrvProc, XPERR_ODS_FUNC_FAIL, 'dwxp_encode_datetime: Failed call srv_paraminfo.'); Exit; end;
Case btype of srvint1: vParams1_7 [I]: = Vbyte; Srvint2: vParams1_7 [i]: = vWord; Srvint4, Srvintn: vParams1_7 [i]: = VLONGWORD; END;
if srv_paraminfo (pSrvProc, 8, @bType, @cbMaxLen, @cbActualLen, nil, @fNull) = FAIL then begin SendError (pSrvProc, XPERR_ODS_FUNC_FAIL, 'dwxp_encode_datetime: Failed call srv_paraminfo.'); Exit; end;
VDATETIME: = EncodeDateTime (vParams1_7 [1], vParams1_7 [3], vParams1_7 [4], vParams1_7 [5], vParams1_7 [6], vParams1_7 [7]); vDatetimeStr: = DateTimetostr (vdatetime);
IF btype = srvdatetimn dam = sizeof (dbdatetime4) Then btype2: = srvdatetim4 else btype2: = srvdatetime; end else btype2: = bType;
case bType2 of SRVDATETIM4: begin if srv_convert (pSrvProc, SRVVARCHAR, PChar (vDateTimeStr), Length (vDateTimeStr), SRVDATETIM4, @ dt4, SizeOf (DBDATETIME4)) = -1 then begin SendError (pSrvProc, XPERR_DATA_CONVERT, 'dwxp_encode_datetime: data conversion Error. '); Exit; end; srv_paramsetoutput (psrvproc, 8, @ dt4, sizeof (dbdatetime4), false;
SRVDATETIME: begin if srv_convert (pSrvProc, SRVVARCHAR, PChar (vDateTimeStr), Length (vDateTimeStr), SRVDATETIME, @dt, SizeOf (DBDATETIME)) = -1 then begin SendError (pSrvProc, XPERR_DATA_CONVERT, 'dwxp_encode_datetime: Error converting data.' ); Exit; end; srv_paramsetoutput (psrvproc, 8, @dt, sizeof (dbdatetime), false;
Else senderror (psrvproc, xperr_invalid_data_type, 'dwxp_encode_datetim: @datetime parameter data type does not meet the requirements.'); exit;
Result: = xp_noerror;
Exports __getxpversion, dwxp_encode_datetime;
Beginend.mssqlods.Unitunit mssqlods;
interfaceuses Windows; type ULONG = LongWord; DBBOOL = Byte; DBBYTE = Byte; DBTINYINT = Byte; DBSMALLINT = SmallInt; DBUSMALLINT = Word; DBINT = LongInt; DBCHAR = Char; PDBCHAR = PChar; DBBINARY = Byte; DBBIT = Byte; DBFLT8 = double; srv_datetime = packed record dtdays: LongInt; // number of days since 1/1/1900 dttime: LongWord; // number 300th second since mid end; DBDATETIME = srv_datetime; srv_money = packed record mnyhigh: LongInt; mnylow: LongWord; end; DBMONEY = srv_money; DBFLT4 = Single; DBMONEY4 = LongInt; dbdatetime4 = packed record numdays: Word; // number of days since 1/1/1900 nummins: Word; // number of minutes sicne midnight end; DBDATETIM4 = dbdatetime4; Const MaxNumericlen = 16; type dbnumeric = Packed Record Precision: Byte; Scale: Byte; Sign: Byte; Val: Packed Array [0..maxnumericlen - 1] of byte; end; dbdecimal = dbnumeric; const // ------------ -------------------------------------------------- ------ // Constants used by APIs // Type Tokens SRV_TDS_NULL = $ 1F; SRV_TDS_TEXT = $ 23; SRV_TDS_GUID = $ 24; SRV_TDS_VARBINARY = $ 25; SRV_TDS_INTN = $ 26; SRV_TDS_VARCHAR = $ 27; SRV_TDS_BINARY = $ 2D; SRV_TDS_IMAGE = $ 22; SRV_TDS_CHAR = $ 2F; SRV_TDS_INT1 = $ 30; SRV_TDS_BIT = $ 32; SRV_TDS_INT2 = $ 34; SRV_TDS_DECIMAL = $ 37; SRV_TDS_INT4 = $ 38; SRV_TDS_DATETIM4 = $ 3A; SRV_TDS_FLT4 = $ 3B; SRV_TDS_MONEY = $ 3C; SRV_TDS_DATETIME = $ 3D; SRV_TDS_FLT8 = $ 3E; SRV_TDS_NUMERIC = $ 3F; SRV_TDS_SSVARIANT = $ 62; SRV_TDS_NTEXT = $ 63; SRV_TDS_BITN = $ 68;
SRV_TDS_DECIMALN = $ 6A; SRV_TDS_NUMERICN = $ 6C; SRV_TDS_FLTN = $ 6D; SRV_TDS_MONEYN = $ 6E; SRV_TDS_DATETIMN = $ 6F; SRV_TDS_INT8 = $ 7F;; SRV_TDS_BIGVARCHAR = $ A7;; SRV_TDS_BIGVARBINARY = A5 $ SRV_TDS_MONEY4 = 7A $ SRV_TDS_BIGBINARY = $ AD; SRV_TDS_BIGCHAR = $ AF; SRV_TDS_NVARCHAR = $ E7; SRV_TDS_NCHAR = $ EF; // Datatypes // Also: values of symbol parameter to srv_symbol when type = SRV_DATATYPE SRVNULL = SRV_TDS_NULL; SRVTEXT = SRV_TDS_TEXT; SRVGUID = SRV_TDS_GUID; SRVVARBINARY = SRV_TDS_VARBINARY; SRVINTN = SRV_TDS_INTN; SRVVARCHAR = SRV_TDS_VARCHAR; SRVBINARY = SRV_TDS_BINARY; SRVIMAGE = SRV_TDS_IMAGE; SRVCHAR = SRV_TDS_CHAR; SRVINT1 = SRV_TDS_INT1; SRVBIT = SRV_TDS_BIT; SRVINT2 = SRV_TDS_INT2; SRVDECIMAL = SRV_TDS_DECIMAL; SRVINT4 = SRV_TDS_INT4; SRVDATETIM4 = SRV_TDS_DATETIM4; SRVFLT4 = SRV_TDS_FLT4; SRVMONEY = SRV_TDS_MONEY; SRVDATETIME = SRV_TDS_DATETIME; SRVFLT8 = SRV_TDS_FLT8; SRVNUMERIC = SRV_TDS_NUMERIC; SRVSSVARIANT = SRV_TDS_SSVARIANT; SRVNText = SRV_TDS_NTEXT; SRVBITN = SRV_TDS_BITN; SRVDECIMALN = SRV_TDS_DECIMALN; SRVNUMERICN = SRV_TDS_NUMERICN; SRVFLTN = SRV_TDS_FLTN; SRVMONEYN = SRV_TDS_MONEYN; SRVDATETIMN = SRV_TDS_DATETIMN; SRVMONEY4 = SRV_TDS_MONEY4; SRVINT8 = SRV_TDS_INT8; SRVBIGVARBINARY = SRV_TDS_BIGVARBINARY; SRVBIGVARCHAR = SRV_TDS_BIGVARCHAR; SRVBIGBINARY = SRV_TDS_BIGBINARY; SRVBIGCHAR = SRV_TDS_BIGCHAR ; Srvnvarchar = SRV_TDS_NVARCHAR; SRVNCHAR = SRV_TDS_NCHAR; // VALUES for SRV_SYMBOL TYPE Parameter SRV_ERROR = 0; SRV_DONE = 1;
SRV_DATATYPE = 2; SRV_EVENT = 4; // values for srv_symbol symbol parameter, when type = SRV_ERROR SRV_ENO_OS_ERR = 0; SRV_INFO = 1; SRV_FATAL_PROCESS = 10; SRV_FATAL_SERVER = 19; // Types of server events // Also: values for srv_symbol symbol parameter, when type = SRV_EVENT SRV_CONTINUE = 0; SRV_LANGUAGE = 1; SRV_CONNECT = 2; SRV_RPC = 3; SRV_RESTART = 4; SRV_DISCONNECT = 5; SRV_ATTENTION = 6; SRV_SLEEP = 7; SRV_START = 8; SRV_STOP = 9; SRV_EXIT = 10; SRV_CANCEL = 11; SRV_SETUP = 12; SRV_CLOSE = 13; SRV_PRACK = 14; SRV_PRERROR = 15; SRV_ATTENTION_ACK = 16;. // TDS type for TDS 7 clients Overloaded with SRV_ATTENTION_ACK SRV_CONNECT_V7 = 16; SRV_SKIP = 17; SRV_TRANSMGR = 18; SRV_PRELOGIN = 19; SRV_OLEDB = 20; SRV_INTERNAL_HANDLER = 99; SRV_PROGRAMMER_DEFINED = 100; // values for srv_sfield field parameter SRV_SERVERNAME = 0; SRV_VERSION = 6; // Length to indicate string is null terminated SRV_NULLTERM = -1; // values of msgtype parameter to srv_sendmsg SRV_MSG_INFO = 1; SRV_MSG_ERROR = 2; // values of status parameter to srv_senddone // Also: values for symbol parameters to srv_symbol when type = SRV_DONE SRV_DONE_FINAL = $ 0000; SRV_DONE_MORE = $ 0001; SRV_DONE_ERROR = $ 0002; SRV_DONE_COUNT = $ 0010; SRV_DONE_RPC_IN_BATCH = $ 0080 ; // return values of srv_paramstatus SRV_PARAMRETURN = $ 0001; SRV_PARAMDEFAULT = $ 0002; // This is sent by clients in RPC, unset in processRPC SRV_PARAMSORTORDER = $ 0004; // return values of srv_rpcoptions SRV_RECOMPILE = $ 0001;
SRV_NOMETADATA = $ 0002; // values of field parameter to srv_pfield // # define SRV_LANGUAGE 1 already defined above // # define SRV_EVENT 4 already defined above SRV_SPID = 10; SRV_NETSPID = 11; SRV_TYPE = 12; SRV_STATUS = 13; SRV_RMTSERVER = 14; SRV_HOST = 15; SRV_USER = 16; SRV_PWD = 17; SRV_CPID = 18; SRV_APPLNAME = 19; SRV_TDS = 20; SRV_CLIB = 21; SRV_LIBVERS = 22; SRV_ROWSENT = 23; SRV_BCPFLAG = 24; SRV_NATLANG = 25; SRV_PIPEHANDLE = 26; SRV_NETWORK_MODULE = 27; SRV_NETWORK_VERSION = 28; SRV_NETWORK_CONNECTION = 29; SRV_LSECURE = 30; SRV_SAXP = 31; SRV_UNICODE_USER = 33; SRV_UNICODE_PWD = 35; SRV_SPROC_CODEPAGE = 36; SRV_MSGLCID = 37; SRV_INSTANCENAME = 38; SRV_HASHPWD = 39; // return value of SRV_TDSVERSION macro SRV_TDS_NONE = 0; SRV_TDS_2_0 = 1; SRV_TDS_3_4 = 2; SRV_TDS_4_2 = 3; SRV_TDS_6_0 = 4; SRV_TDS_7_0 = 5; type SRVRETCODE = Integer; RETCODE = Integer; const SUCCEED = 1; FAIL = 0; SRV_DUPLICATE_HANDLER = 2; type PSRV_SERVER = Pointer; PSRV_CONFIG = Pointer; PSRV_PROC = Pointer; const SS_MAJOR_VERSION = 7; SS_MINOR_VERSION = 00; SS_LEVEL_VERSION = 0000; SS_MINIMUM_VERSION = '7.00.00.0000'; ODS_VERSION = ((SS_MAJOR_VERSION shl 24) or (SS_MINOR_VERSION shl 16)); OpenDS60_DLL = 'opends60.dll'; function srv_describe (srvproc: PSRV_PROC; colnumber: Integer; column_name: PDBCHAR; namelen: Integer; desttype, destlen, srctype, srclen: DBINT; srcdata: Pointer): Integer; cdecl; function srv_setutype (srvproc: PSRV_PROC COLUMN: INTEGER;
user_type: DBINT): Integer; cdecl; function srv_setcoldata (srvproc: PSRV_PROC; column: Integer; data: Pointer): Integer; cdecl; function srv_setcollen (srvproc: PSRV_PROC; column, len: Integer): Integer; cdecl; function srv_sendrow ( srvproc: PSRV_PROC): Integer; cdecl; function srv_senddone (srvproc: PSRV_PROC; status, info: DBUSMALLINT; count: DBINT): Integer; cdecl; function srv_rpcparams (srvproc: PSRV_PROC): Integer; cdecl; function srv_paraminfo (srvproc: PSRV_PROC; n: Integer; pbType: PByte; pcbMaxLen, pcbActualLen: PLongInt; pbData: PByte; pfNull: PBoolean): Integer; cdecl; function srv_paramstatus (srvproc: PSRV_PROC; n: Integer): Integer; cdecl; function srv_paramsetoutput (srvproc: PSRV_PROC; n: Integer; pbData: PByte; cbLen: LongWord; fNull: Boolean): Integer; cdecl; // function srv_paramdata (srvproc: PSRV_PROC; n: Integer): Pointer; cdecl; // function srv_paramlen (srvproc: PSRV_PROC; n: Integer: integer; cdecl; // function srv_parammaxlen (srvproc: psrv_proc; n: integer): in teger; cdecl; // function srv_paramtype (srvproc: PSRV_PROC; n: Integer): Integer; cdecl; function srv_paramset (srvproc: PSRV_PROC; n: Integer; data: Pointer; len: Integer): Integer; cdecl; function srv_paramname (srvproc : PSRV_PROC; n: Integer; var len: Integer): PDBCHAR; cdecl; function srv_paramnumber (srvproc: PSRV_PROC; name: PDBCHAR; namelen: Integer): Integer; cdecl; function srv_convert (srvproc: PSRV_PROC; srctype: Integer; src: Pointer; srclen: DBINT; desttype: Integer; dest: Pointer; destlen: DBINT): Integer; cdecl; function srv_getbindtoken (srvproc: PSRV_PROC; bindtoken: PChar): Integer; cdecl; function srv_pfield (srvproc: PSRV_PROC; field: Integer; VAR LEN: Integer: PDBCHAR; CDECL;
function srv_pfieldex (srvproc: PSRV_PROC; field: Integer; var len: Integer): Pointer; cdecl; function srv_wsendmsg (srvproc: PSRV_PROC; msgnum, severity: Integer; _message: PWideChar; msglen: Integer): Integer; cdecl; function srv_sendmsg ( srvproc: PSRV_PROC; msgtype: Integer; msgnum: DBINT; _class, state: DBTINYINT; rpcname: PDBCHAR; rpcnamelen: Integer; linenum: DBUSMALLINT; _message: PDBCHAR; msglen: Integer): Integer; cdecl; function srv_willconvert (srvproc: PSRV_PROC; srctype, desttype: Integer): Boolean; cdecl; function srv_message_handler (srvproc: PSRV_PROC; errornum: Integer; severity, state: Byte; oserrnum: Integer; errtext: PChar; errtextlen: Integer; oserrtext: PChar; oserrtextlen: Integer): Integer ; cdecl; implementation function srv_describe (srvproc: PSRV_PROC; colnumber: Integer; column_name: PDBCHAR; namelen: Integer; desttype, destlen, srctype, srclen: DBINT; srcdata: Pointer): Integer; external OpenDS60_DLL; function srv_setutype (srvproc: PSRV_PROC; COLUMN: Integer; user_type: DBINT): Integer; external OpenDS60_DLL; function srv_setcoldata (srvproc: PSRV_PROC; column: Integer; data: Pointer): Integer; external OpenDS60_DLL; function srv_setcollen (srvproc: PSRV_PROC; column, len: Integer): Integer; external OpenDS60_DLL; function srv_sendrow (srvproc: PSRV_PROC): Integer; external OpenDS60_DLL; function srv_senddone (srvproc: PSRV_PROC; status, info: DBUSMALLINT; count: DBINT): Integer; external OpenDS60_DLL; function srv_rpcparams (srvproc: PSRV_PROC): Integer; external OpenDS60_DLL Function SRV_PARAMINFO (SRVPROC: PSRV_PROC; N: Integer; PBTYPE: PBYTE; PCBMAXLEN, PCBACTUALLEN: PLONGINT; PBDATA: PBYTE; PFNULL: PBOOLAN: Integer; External OpenDS60_DLL;
function srv_paramstatus (srvproc: PSRV_PROC; n: Integer): Integer; external OpenDS60_DLL; function srv_paramsetoutput (srvproc: PSRV_PROC; n: Integer; pbData: PByte; cbLen: LongWord; fNull: Boolean): Integer; external OpenDS60_DLL; // function srv_paramdata (srvproc: PSRV_PROC; n: Integer): Pointer; external OpenDS60_DLL; // function srv_paramlen (srvproc: PSRV_PROC; n: Integer): Integer; external OpenDS60_DLL; // function srv_parammaxlen (srvproc: PSRV_PROC; n: Integer): Integer; external OpenDS60_DLL; // function srv_paramtype (srvproc: PSRV_PROC; n: Integer): Integer; external OpenDS60_DLL; function srv_paramset (srvproc: PSRV_PROC; n: Integer; data: Pointer; len: Integer): Integer; external OpenDS60_DLL; function srv_paramname ( srvproc: PSRV_PROC; n: Integer; var len: Integer): PDBCHAR; external OpenDS60_DLL; function srv_paramnumber (srvproc: PSRV_PROC; name: PDBCHAR; namelen: Integer): Integer; external OpenDS60_DLL; function srv_convert (srvproc: PSRV_PROC; srctype: Integer ; SRC: POIN ter; srclen: DBINT; desttype: Integer; dest: Pointer; destlen: DBINT): Integer; external OpenDS60_DLL; function srv_getbindtoken (srvproc: PSRV_PROC; bindtoken: PChar): Integer; external OpenDS60_DLL; function srv_pfield (srvproc: PSRV_PROC; field: Integer; var len: Integer): PDBCHAR; external OpenDS60_DLL; function srv_pfieldex (srvproc: PSRV_PROC; field: Integer; var len: Integer): Pointer; external OpenDS60_DLL; function srv_wsendmsg (srvproc: PSRV_PROC; msgnum, severity: Integer; _message: PWideChar; msglen: Integer): Integer; external OpenDS60_DLL; function srv_sendmsg (srvproc: PSRV_PROC; msgtype: Integer; msgnum: DBINT; _class, state: DBTINYINT; rpcname: PDBCHAR; rpcnamelen: Integer; linenum: DBUSMALLINT; _message: PDBCHAR;
msglen: Integer): Integer; external OpenDS60_DLL; function srv_willconvert (srvproc: PSRV_PROC; srctype, desttype: Integer): Boolean; external OpenDS60_DLL; function srv_message_handler (srvproc: PSRV_PROC; errornum: Integer; severity, state: Byte; oserrnum: Integer; Errtextlen: Integer; Oserrtext: Pchar; Osterrtextlen: Integer: Integer; External OpenDS60_DLL; END. {********************************************** ******** end of file ***************************************
