Delphi

编程实现SqlServer扩展存储过程并实现Image类型参数的输入和结果的返回

铁匠 — Sat, 30 Aug 2008 10:08:00 GMT

SQLServer有一项即将要过时的功能，那就是扩展存储过程（在MSDN上查询该方面的资料的时候，上面都有一个提示说是这个功能将会在以后的SQL版本中删除，建议使用CLR集成）。虽然要过时了，但是看着现在有不少的DB还在用SQL2000说明这个功能至少还有几年有效期。对了，忘了说了扩展存储过程是干啥用的，懒得查最官方的说法了，用我的语言来说，那就是使用自己的开发语言，来实现一些数据库没有实现的功能，比如说我想在数据库里面直接作MD5的加密和解密，这个功能SQL Server本来不具有的，但是可以自己写一个扩展存储过程来实现。

开发扩展存储过程的开发语言还是有些要求的，就是要能实现导出函数的，如C（VC,BCB,其它的C）,Delphi等，C#由于无法实现导出函数，所以就不能开发了，不过他可以开发CLR集成。由于我只会Delphi，所以我就用它来作例子。

扩展存储过程的hellowolrd（铁匠出品）

如果仅仅写一个hello wolrd，Delphi是不需要任何东西就可以实现，那就是：新建一个DLL的工程，在里面写个如下函数：

function xp_helloWorld: Boolean; stdcall;
begin
//在这里面可以写一个文件好看到效果，具体的代码我就不写了
end;

然后把它放在导出函数里面：

exports
xp_helloWorld;

再在SQLSERVER里去注册，注意注册扩展存储过程只能在Master库里实现，还要求操作者有一定的权限,SQL如下：

if exists
(select * from master.dbo.sysobjects where id = object_id('xp_helloWorld'))
execute sp_dropextendedproc 'xp_helloWorld'
go
--我编写的dll在'D:\PersonWork\SQLExtProcedure\目录下面,修改成你的编写的目录
execute sp_addextendedproc 'xp_helloWorld', 'D:\PersonWork\SQLExtProcedure\sqlExtProcedure.dll'
go

然后在写SQL exec Master.dbo.xp_helloWorld就能看到效果了。

实用的扩展存储过程（铁匠出品）

但是我们开发东西不是一个helloworld就能够用的，所以我们就得引入新的东西：MsOdsApi，这个是一个我们的代码去调用sql现有功能的入口，因为Sqlserver的SDK并没有给Delphi作个版本，所以我们只好自己辛苦一下来转换他们的头文件，不过还好网上的很多前辈们已经帮我们完成了这个工作，在本文的结束时会附上该文件。我觉得会最常用的几个函数如下（具体的参数可以看定义，上面应该写得比较清楚了）：

srv_rpcparams:获取参数的个数

srv_paraminfo：获取指定参数的信息，数据的长度，类型，数据等

srv_paramdata：获取image一类的值的指针

srv_describe：创造返回值的描述

srv_setcoldata：给返回的字段赋值

srv_sendrow：返回一行数据

srv_senddone：表示返回已经完成了。

于是我们开始构建新的扩展存储过程：

function xp_Test(pSrvProc: SRV_PROC): Boolean; stdcall;//这个传时来的参数pSrvProc就是相当于是和sqlserver交互的上下文的指针了
var
PType : Byte;
cbMaxLen , ParaLen : DWORD;
IsNULL : BOOL;

fs: TFileStream;
p: Pointer;
n: integer;
begin
n := srv_rpcparams(pSrvProc);//先取一下有几个参数
srv_paraminfo(pSrvProc, 1, @PType, @cbMaxLen, @ParaLen, nil, @IsNULL);//取第一个参数的定义，注意参数的下标是从1开始的，而不是习惯上的0
p := srv_paramdata(pSrvProc, 1);//由于我们要取image类型的，所以得用这个取数据的指针，否则就用下面这个，注意在这之前，p要先开好内存
//srv_paraminfo(pSrvProc, 1, @PType, @cbMaxLen, @ParaLen, @p, @IsNULL);
fs := TFileStream.Create('d:\test.jpg', fmCreate);//由于无法debug只好能过文件把一些中间变量写到文件里，再用winhex来看了
try
    fs.Write(n, SizeOf(Integer));
    fs.Write(cbMaxLen, SizeOf(DWORD));
    fs.Write(ParaLen, SizeOf(DWORD));
    fs.Write(p^, ParaLen)
finally
    FreeAndNil(fs);
end;

//下面开始返回一行数据
n := ParaLen;
srv_describe(pSrvProc, 1 , 'Data', SRV_NULLTERM, SRV_TDS_IMAGE,
                n, SRVBIGVARCHAR, n, NIL);
    srv_setcoldata(pSrvProc, 1 , p);
    srv_sendrow(pSrvProc);
    srv_senddone(pSrvProc, (SRV_DONE_COUNT or SRV_DONE_MORE), 0, 1);
end;

还是按hellowolrd的方法把它注册到SQLServer里面去。不过由于Image类型的字段不能在存储过程里设置临时变量，所以我们还有再麻烦一下：

Create PROCEDURE [dbo].[UXP_Test]
@in1 Image
AS
BEGIN
Insert into Test1(Data)
exec Master.dbo.xp_Test @in1
END
GO

这样来把我们处理过后的Image类型的字段插入到DB里面去。

最后来看看那个Test.jpg的内容：

Offset 0 1 2 3 4 5 6 7 8 9 A B C D E F

00000000   01 00 00 00 10 00 00 00 72 03 00 00 47 49 46 38   ........r...GIF8
00000010   39 61 A0 00 58 00 A2 00 00 63 9C 9C FF 63 00 00   9a?X.?.c湝c..
00000020   9C 00 00 63 FF CE 31 31 FE 01 02 00 00 00 00 00   ?.c?1?......
00000030   00 21 FF 0B 4E 45 54 53 43 41 50 45 32 2E 30 03   .!.NETSCAPE2.0.

点它一下看大图，就可以看到前四位是1，也就是传入了1个参数，接下来4位值是16（从这里也可以看出来那些image类型的定义果真是16位这么长），再接下来4位这才是数据的真正长度，我是插入了一个GIF动画，所以它的长度和文件的长度是一样的：882，再后面就是文件的开始了GIF89a一个标准的GIF文件头

看看这些数据插入到DB里是不是正确的呢？来看下图：

0x开头，说明它是以16进制数显示的，看开头的几位：474946383961和上面的16进制数对比一下可以看到，这里面的数据是正确的，也就是说我们的Image传入处理后，再返回来这一切都是成功的。

最后贴一下：MsOdsApi.pas(从下一行开始复制)

unit MsOdsApi;
//------------------------------------------------------------
// Open Data Services header file: srv.h
// Copyright (c) 1989, 1990, 1991, 1997 by Microsoft Corp.
//
// Avoid double inclusion
//#ifndef _ODS_SRV_H_
// _ODS_SRV_H_
//#include "windows.h"
// ODS uses pack(4) on all CPU types
//#pragma pack(4)
//#ifdef __cplusplus
//extern "C" {
//#endif
// define model
//#if !defined( FAR )
// FAR far
//#endif
//------------------------------------------------------------
// Formats of data types
//#if !defined(DBTYPEDEFS) // Do not conflict with DBLIB definitions
//#if !defined(MAXNUMERICLEN) // Do not conflict with ODBC definitions
// DBTYPEDEFS
interface
uses
Windows;
type
DBBOOL      = Byte;
DBBYTE      = Byte;
DBTINYINT   = Byte;
DBSMALLINT = Smallint;
DBUSMALLINT = Word;
DBINT       = Longint;
DBCHAR      = Char;
PDBCHAR     = ^DBCHAR;
DBBINARY    = Byte;
DBBIT       = Byte;
DBFLT8      = Double;
srv_datetime = record
    // Format for SRVDATETIME
    dtdays: Longint; // number of days since 1/1/1900
    dttime: Longword; // number 300th second since mid
end;
DBDATETIME = srv_datetime;
srv_dbdatetime4 = record
    // Format for SRVDATETIM4
    numdays: Word; // number of days since 1/1/1900
    nummins: Word; // number of minutes sicne midnight
end;
DBDATETIM4 = srv_dbdatetime4;
srv_money = record
    // Format for SRVMONEY
    mnyhigh: Longint;
    mnylow : Longword;
end;
DBMONEY = srv_money;
DBFLT4   = Double;
DBMONEY4 = Longint;
const
MAXNUMERICDIG     = 38;
DEFAULTPRECISION = 19; // 18
DEFAULTSCALE      = 0;
MAXNUMERICLEN       = 16;
type
srv_dbnumeric = packed record
    // Format for SRVNUMERIC,SRVNUMERICN,SRVDECIMAL,SRVDECIMALN
    precision: Byte;
    scale    : Byte;
    sign     : Byte;                               // 1 = Positive, 0 = Negative
    val      : array [0..MAXNUMERICLEN-1] of Byte; // Padded little-endian value
end;
DBNUMERIC = srv_dbnumeric;
DBDECIMAL = DBNUMERIC;
//#endif // #if !defined(MAXNUMERICLEN)
//#endif // #if !defined( DBTYPEDEFS )
//------------------------------------------------------------
// Constants used by APIs
// Type Tokens
const
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_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_MONEY4         = $7a;
SRV_TDS_INT8           = $7f; // SQL 2000 and later
SRV_TDS_BIGVARBINARY   = $A5;
SRV_TDS_BIGVARCHAR     = $A7;
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;
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;        // SQL 2000 and later
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;
SRV_CONNECT_V7    = 16; // TDS type for TDS 7 clients. Overloaded with SRV_ATTENTION_ACK
SRV_SKIP       = 17;
SRV_TRANSMGR       = 18;
SRV_OLEDB       = 20;
SRV_INTERNAL_HANDLER    = 99;
SRV_PROGRAMMER_DEFINED = 100;
// values for srv_config option parameter
SRV_CONNECTIONS        = 1;
SRV_LOGFILE            = 2;
SRV_STACKSIZE          = 3;
SRV_REMOTE_ACCESS      = 7;
SRV_REMOTE_CONNECTIONS = 9;
SRV_MAX_PACKETS        = 10;
SRV_MAXWORKINGTHREADS = 11;
SRV_MINWORKINGTHREADS = 12;
SRV_THREADTIMEOUT    = 13;
SRV_MAX_PACKETSIZE    = 17;
SRV_THREADPRIORITY    = 18;
SRV_ANSI_CODEPAGE    = 19;
SRV_DEFAULT_PACKETSIZE = 26;
SRV_PASSTHROUGH    = 27;
// vlaues for srv_config value parameter when option = SRV_THREADPRIORITY
SRV_PRIORITY_LOW      = THREAD_PRIORITY_LOWEST;
SRV_PRIORITY_NORMAL   = THREAD_PRIORITY_NORMAL;
SRV_PRIORITY_HIGH     = THREAD_PRIORITY_HIGHEST;
SRV_PRIORITY_CRITICAL = THREAD_PRIORITY_TIME_CRITICAL;
// 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;
// return values of srv_rpcoptions
SRV_RECOMPILE           = $0001;
SRV_NOMETADATA          = $0002;
// values of field parameter to srv_pfield
// SRV_LANGUAGE 1   already defined above
// 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;
// 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;
// Return values from APIs
type
SRVRETCODE = Integer;        // SUCCEED or FAIL
RETCODE    = Integer;
const
SUCCEED = 1;   // Successful return value
FAIL    = 0;   // Unsuccessful return value
SRV_DUPLICATE_HANDLER   = 2;   // additional return value for srv_pre/post_handle
//------------------------------------------------
//PreDeclare structures
//
{struct srv_server;
typedef struct srv_server SRV_SERVER;
struct srv_config;
typedef struct srv_config SRV_CONFIG;
struct srv_proc;
typedef struct srv_proc SRV_PROC;}
type
SRV_SERVER = Pointer;
SRV_CONFIG = Pointer;
SRV_PROC   = Pointer;
//------------------------------------------------
//------------------------------------------------
// ODS MACROs & APIs
// Describing and sending a result set
function srv_describe(srvproc: SRV_PROC;
colnumber: Integer; column_name: PCHAR; namelen: Integer;
desttype, destlen, srctype, srclen: Integer; srcData: Pointer
): Integer; cdecl;
function srv_setutype(srvproc: SRV_PROC; column: Integer; usertype: Longint): Integer; cdecl;
function srv_setcoldata(srvproc: SRV_PROC; column: Integer; data: Pointer): Integer; cdecl;
function srv_setcollen(srvproc: SRV_PROC; column, len: Integer): Integer; cdecl;
function srv_sendrow(srvproc: SRV_PROC): Integer; cdecl;
function srv_senddone(srvproc: SRV_PROC; status, curcmd: Word; count: Longint): Integer; cdecl;
// Dealing with Extended Procedure parameters
function srv_rpcparams(srvproc: SRV_PROC): Integer; cdecl;
function srv_paraminfo(srvproc: SRV_PROC; n: Integer; pbType: PByte;
pcbMaxLen, pcbActualLen: PULONG; pbData: PByte; pfNull: PBOOL): Integer; cdecl;
function srv_paramsetoutput(srvproc: SRV_PROC;
n: Integer; pbData: PByte; cbLen: ULONG; fNull: BOOL): Integer; cdecl;
function srv_paramdata(srvproc: SRV_PROC; n: Integer): Pointer; cdecl;
function srv_paramlen(srvproc: SRV_PROC; n: Integer): Integer; cdecl;
function srv_parammaxlen(srvproc: SRV_PROC; n: Integer): Integer; cdecl;
function srv_paramtype(srvproc: SRV_PROC; n: Integer): Integer; cdecl;
function srv_paramset(srvproc: SRV_PROC; n: Integer; data: Pointer; int: Integer): Integer; cdecl;
function srv_paramname(srvproc: SRV_PROC; n: Integer; var len: Integer): PChar; cdecl;
function srv_paramnumber(srvproc: SRV_PROC; name: PChar; namelen: Integer): Integer; cdecl;
//--------------------------------------------------------------
//--------------------------------------------------------------
// The rest of these APIs are still supported, in SQL Server 7.0,
// but may not be supported after SQL Server 7.0
// MACROs
{ SRV_GETCONFIG(a)      srv_getconfig     ( a )
SRV_GETSERVER(a)      srv_getserver     ( a )
SRV_GOT_ATTENTION(a)   srv_got_attention ( a )
SRV_EVENTDATA(a)      srv_eventdata     ( a )
SRV_IODEAD(a)         srv_iodead        ( a )
SRV_TDSVERSION(a)      srv_tdsversion     ( a )}
function srv_getconfig(server: SRV_SERVER): SRV_CONFIG; cdecl;
function srv_getserver(srvproc: SRV_PROC): SRV_SERVER; cdecl;
function srv_got_attention(srvproc: SRV_PROC): Bool; cdecl;
function srv_eventdata(srvproc: SRV_PROC): Pointer; cdecl;
// Memory
function srv_alloc(ulSize: Longint): Pointer; cdecl;
function srv_bmove(from: Pointer; pto: Pointer; count: Longint): Integer; cdecl;
function srv_bzero(location: Pointer; count: Longint): Integer; cdecl;
function srv_free(ptr: Pointer): Integer; cdecl;
function srv_config_fn(config: SRV_CONFIG; option: Longint; value: PChar; valuelen: Integer): Integer; cdecl;
function srv_config_alloc: SRV_CONFIG; cdecl;
function srv_convert(srvproc: SRV_PROC; srctype: Integer; src: Pointer; srclen: DBINT;
desttype: Integer; dest: Pointer; destlen: DBINT): Integer; cdecl;
{
int (* srv_errhandle(int (* handler)(SRV_SERVER * server,
     SRV_PROC   * srvproc,
     int         srverror,
     BYTE           severity,
     BYTE           state,
     int         oserrnum,
     char     * errtext,
     int         errtextlen,
     char     * oserrtext,
     int         oserrtextlen)))
   ( SRV_SERVER * server,
    SRV_PROC   * srvproc,
    int        srverror,
    BYTE          severity,
    BYTE          state,
    int        oserrnum,
    char     * errtext,
    int        errtextlen,
    char     * oserrtext,
    int        oserrtextlen );
}
function srv_event_fn(srvproc: SRV_PROC; event: Integer; data: PByte): Integer; cdecl;
function srv_getuserdata(srvproc: SRV_PROC): Pointer; cdecl;
function srv_getbindtoken(srvproc: SRV_PROC; token_buf: PChar): Integer; cdecl;
function srv_getdtcxact(srvproc: SRV_PROC; ppv: Pointer): Integer; cdecl;
//typedef int (* EventHandler)(void*);
type
EventHandler = Pointer;
function srv_handle(server: SRV_SERVER; int: Longint; handler: EventHandler): EventHandler; cdecl;
function srv_impersonate_client(srvproc: SRV_PROC): Integer; cdecl;
function srv_init(config: SRV_CONFIG; connectname: PChar; namelen: Integer): SRV_SERVER; cdecl;
function srv_iodead(srvproc: SRV_PROC): Bool; cdecl;
function srv_langcpy(srvproc: SRV_PROC; start, nbytes: Longint; buffer: PChar): Longint; cdecl;
function srv_langlen(srvproc: SRV_PROC): Longint; cdecl;
function srv_langptr(srvproc: SRV_PROC): Pointer; cdecl;
function srv_log(server: SRV_SERVER; datestamp: Bool; msg: PChar; msglen: Integer): Integer; cdecl;
function srv_paramstatus(srvproc: SRV_PROC; n: Integer): Integer; cdecl;
function srv_pfield(srvproc: SRV_PROC; field: Integer; len: PInteger): PChar; cdecl;
function srv_returnval(srvproc: SRV_PROC; value_name: PDBCHAR; len: Integer; status: Byte;
iType, maxlen, datalen: DBINT; value: PByte): Integer; cdecl;
function srv_revert_to_self(srvproc: SRV_PROC): Integer; cdecl;
function srv_rpcdb(srvproc: SRV_PROC; len: PInteger): PChar; cdecl;
function srv_rpcname(srvproc: SRV_PROC; len: PInteger): PChar; cdecl;
function srv_rpcnumber(srvproc: SRV_PROC): Integer; cdecl;
function srv_rpcoptions(srvproc: SRV_PROC): Word; cdecl;
function srv_rpcowner(srvproc: SRV_PROC; len: PInteger): PChar; cdecl;
function srv_run(server: SRV_SERVER): Integer; cdecl;
function srv_sendmsg(srvproc: SRV_PROC;
msgtype: Integer; msgnum: DBINT; msgClass, state: DBTINYINT;
rpcname: PChar; rpcnamelen: Integer;
linenum: Word; msg: PChar; msglen: Integer): Integer; cdecl;
function srv_ansi_sendmsg(srvproc: SRV_PROC;
msgtype: Integer; msgnum: DBINT; msgClass, state: DBTINYINT;
rpcname: PChar; rpcnamelen: Integer;
linenum: Word; msg: PChar; msglen: Integer): Integer; cdecl;
function srv_sendstatus(srvproc: SRV_PROC; status: Longint): Integer; cdecl;
function srv_setuserdata(srvproc: SRV_PROC; ptr: Pointer): Integer; cdecl;
function srv_sfield(server: SRV_SERVER; field: Integer; len: PInteger): PChar; cdecl;
function srv_symbol(iType, symbol: Integer; len: PInteger): PChar; cdecl;
function srv_tdsversion(srvproc: SRV_PROC): Integer; cdecl;
function srv_writebuf(srvproc: SRV_PROC; ptr: Pointer; count: Word): Integer; cdecl;
function srv_willconvert(srctype, desttype: Integer): Bool; cdecl;
procedure srv_ackattention(srvproc: SRV_PROC); cdecl;
function srv_terminatethread(srvproc: SRV_PROC): Integer; cdecl;
function srv_sendstatistics(srvproc: SRV_PROC): Integer; cdecl;
function srv_clearstatistics(srvproc: SRV_PROC): Integer; cdecl;
function srv_setevent(server: SRV_SERVER; event: Integer): Integer; cdecl;
function srv_message_handler(srvproc: SRV_PROC;
errornum: Integer; severity, state: Byte; oserrnum: Integer; errtext: PChar;
errtextlen: Integer; oserrtext: PChar; oserrtextlen: Integer): Integer; cdecl;
function srv_pre_handle(server: SRV_SERVER; srvproc: SRV_PROC;
                   event: Longint; handler: EventHandler; remove: Bool): Integer; cdecl;
function srv_post_handle(server: SRV_SERVER; srvproc: SRV_PROC;
                   event: Longint; handler: EventHandler; remove: Bool): Integer; cdecl;
function srv_post_completion_queue(srvproc: SRV_PROC; inbuf: PChar; inbuflen: PChar): Integer; cdecl;
function srv_IgnoreAnsiToOem(srvproc: SRV_PROC; bTF: BOOL): Integer; cdecl;
//#ifdef __cplusplus
//}
//#endif
//#pragma pack()
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));
//#endif //_ODS_SRV_H_
//////////////////////////////////////////////////////////////////
// Suggested implementation of __GetXpVersion
//
//__declspec(dllexport) ULONG __GetXpVersion()
//   {
//   return ODS_VERSION;
//   }
//////////////////////////////////////////////////////////////////
implementation
const
sLibName = 'Opends60.DLL';
function srv_describe;                  external sLibName name 'srv_describe';
function srv_setutype;                  external sLibName name 'srv_setutype';
function srv_setcoldata;                external sLibName name 'srv_setcoldata';
function srv_setcollen;                 external sLibName name 'srv_setcollen';
function srv_sendrow;                   external sLibName name 'srv_sendrow';
function srv_senddone;                  external sLibName name 'srv_senddone';
// Dealing with Extended Procedure parameters
function srv_rpcparams;                 external sLibName name 'srv_rpcparams';
function srv_paraminfo;                 external sLibName name 'srv_paraminfo';
function srv_paramsetoutput;            external sLibName name 'srv_paramsetoutput';
function srv_paramdata;                 external sLibName name 'srv_paramdata';
function srv_paramlen;                  external sLibName name 'srv_paramlen';
function srv_parammaxlen;               external sLibName name 'srv_parammaxlen';
function srv_paramtype;                 external sLibName name 'srv_paramtype';
function srv_paramset;                  external sLibName name 'srv_paramset';
function srv_paramname;                 external sLibName name 'srv_paramname';
function srv_paramnumber;               external sLibName name 'srv_paramnumber';
//--------------------------------------------------------------
// The rest of these APIs are still supported, in SQL Server 7.0,
// but may not be supported after SQL Server 7.0
function srv_getconfig;                 external sLibName name 'srv_getconfig';
function srv_getserver;                 external sLibName name 'srv_getserver';
function srv_got_attention;             external sLibName name 'srv_got_attention';
function srv_eventdata;                 external sLibName name 'srv_eventdata';
// Memory
function srv_alloc;                     external sLibName name 'srv_alloc';
function srv_bmove;                     external sLibName name 'srv_bmove';
function srv_bzero;                     external sLibName name 'srv_bzero';
function srv_free;                      external sLibName name 'srv_free';
function srv_config_fn;                 external sLibName name 'srv_config';
function srv_config_alloc;              external sLibName name 'srv_config_alloc';
function srv_convert;                   external sLibName name 'srv_convert';
function srv_event_fn;                  external sLibName name 'srv_event';
function srv_getuserdata;               external sLibName name 'srv_getuserdata';
function srv_getbindtoken;              external sLibName name 'srv_getbindtoken';
function srv_getdtcxact;                external sLibName name 'srv_getdtcxact';
function srv_handle;                    external sLibName name 'srv_handle';
function srv_impersonate_client;        external sLibName name 'srv_impersonate_client';
function srv_init;                      external sLibName name 'srv_init';
function srv_iodead;                    external sLibName name 'srv_iodead';
function srv_langcpy;                   external sLibName name 'srv_langcpy';
function srv_langlen;                   external sLibName name 'srv_langlen';
function srv_langptr;                   external sLibName name 'srv_langptr';
function srv_log;                       external sLibName name 'srv_log';
function srv_paramstatus;               external sLibName name 'srv_paramstatus';
function srv_pfield;                    external sLibName name 'srv_pfield';
function srv_returnval;                 external sLibName name 'srv_returnval';
function srv_revert_to_self;            external sLibName name 'srv_revert_to_self';
function srv_rpcdb;                     external sLibName name 'srv_rpcdb';
function srv_rpcname;                   external sLibName name 'srv_rpcname';
function srv_rpcnumber;                 external sLibName name 'srv_rpcnumber';
function srv_rpcoptions;                external sLibName name 'srv_rpcoptions';
function srv_rpcowner;                  external sLibName name 'srv_rpcowner';
function srv_run;                       external sLibName name 'srv_run';
function srv_sendmsg;                   external sLibName name 'srv_sendmsg';
function srv_ansi_sendmsg;              external sLibName name 'srv_ansi_sendmsg';
function srv_sendstatus;                external sLibName name 'srv_sendstatus';
function srv_setuserdata;               external sLibName name 'srv_setuserdata';
function srv_sfield;                    external sLibName name 'srv_sfield';
function srv_symbol;                    external sLibName name 'srv_symbol';
function srv_tdsversion;                external sLibName name 'srv_tdsversion';
function srv_writebuf;                  external sLibName name 'srv_writebuf';
function srv_willconvert;               external sLibName name 'srv_willconvert';
procedure srv_ackattention;             external sLibName name 'srv_ackattention';
function srv_terminatethread;           external sLibName name 'srv_terminatethread';
function srv_sendstatistics;            external sLibName name 'srv_sendstatistics';
function srv_clearstatistics;           external sLibName name 'srv_clearstatistics';
function srv_setevent;                  external sLibName name 'srv_setevent';
function srv_message_handler;           external sLibName name 'srv_message_handler';
function srv_pre_handle;                external sLibName name 'srv_pre_handle';
function srv_post_handle;               external sLibName name 'srv_post_handle';
function srv_post_completion_queue;     external sLibName name 'srv_post_completion_queue';
function srv_IgnoreAnsiToOem;           external sLibName name 'srv_IgnoreAnsiToOem';
end.

AVI文件格式研究中碰到的一些问题的解决办法

铁匠 — Mon, 25 Aug 2008 14:54:00 GMT

最近在研究AVI文件格式的生成问题，碰到以下的问题，找到解决办法，共享如下：

1.生成的文件格式的校验问题：

因为是根据AVI RIFF File Refence这个文档来生成的，所以对错不知道。因此需要一个校验工具。偶觉得有两个工具不错：

a. Gsport这个是暴风影音一类的工具会带的工具。如果格式有错误，它会提示出来。

b.VirtualDub 在这里面点工具菜单里面有十六进制编辑器，按Ctrl+R可以显示出RIFF的树，这样比较容易找出问题来。

2.一切都是按文档的说明来生成的，用播放器来播放是正常的，但是用如上的校验工具来看，里面有错位。在trunck列表里面，发现只有第一个是识别出来，后面的跳了一位无法识别。

经研究发现是存在着奇偶对齐的问题，如果内容是奇数位，那么得在后面补上一位来对齐，但是这一位不能记在这个trunck的长度里面，否则解码器多读了一位可能会引起解码错误。

计划把音频加入，以及功能完善化后，发布DLL供人调用。

DELPHI调试WINDOWS服务的一点心得

铁匠 — Sat, 14 Jun 2008 04:30:00 GMT

Delphi可以很轻松地开发windows服务，可是调试的时候，确有问题。服务能跑起来，可以把把调试器附加到服务的进程上。如果服务起不来呢？该如何调试呢？

如果直接按F9，则服务只是被创建，还没有起动，就会自已退出去了。

我想到的办法就是让服务以普通程序的方式来运行。

为了使用同一份代码，所以我彩用条件编译的方式来实现，在工程的DPR文件里面加上条件：

DELPHI的VCL可以说是一个很精妙的设计。对于一个普通程序来说，它初始化出来的Application是TApplication,而服务的Application是TServiceApplication，所以在想让服务以应用程序的方式来运行的话，一定得处理单元头：

uses
{$IFDEF RUNASAPP}
Forms,
{$ELSE}
SvcMgr,
{$ENDIF}

在这里，我的条件是RUNASAPP，在调试的时候，我就加上这个条件来编译，在正常发布的时候就把这个条件去掉。

由于要调用服务的ServiceStart方法，所以得定义一个变量：

{$IFDEF RUNASAPP}
var
b: Boolean;
{$ENDIF}

同时，原来的应用程序代码也要改成：

Application.Initialize;
Application.CreateForm(TMyservice, MyService);
{$IFDEF RUNASAPP}
MyService.ServiceStart(nil, b);
{$ENDIF}
Application.Run;
{$IFDEF RUNASAPP}
Readln;
{$ENDIF}

加Readln的目标是不让ServiceStart完成后，就退出程序。

这下，服务也可以和应用程序一样的，按F9后开始调试。

在Windows NT Services中使用ADOConnection

铁匠 — Sat, 14 Jun 2008 12:08:00 GMT

在开发windows服务的时候，想要连接数据库，可是发现在创建的时候就出错了，看看VCL里面的ADO创建的代码，发现是基于COM的调用的：

FConnectionObject := CreateADOObject(CLASS_Connection) as _Connection;
OleCheck(ConnectionPoint.Advise(Self as IUnknown, FConnEventsID));

所以得在服务启动的时候，初始化一下COM：

CoInitialize(nil);

对应的，在服务停止的时候，需要：

CoUninitialize;

在服务里面弹出一个窗口到用户的桌面上

铁匠 — Sun, 04 May 2008 07:17:00 GMT

曾几何时，服务里面弹出一个窗口到桌面上不再是那么地容易了：以前只要把服务设置为允许和桌面交互就可以直接在服务启动的时候，把一个窗口弹给用户。但是现在在vista(其它的OS 下没有测试，未知)下要弹出这样的窗体，首先会弹出一个提示框提示是否接否一个服务弹出来的消息，点接受后，才会在一个全灰的桌面里面弹出这个窗口。不用想，这样的用户体验，肯定是会被直接PASS。原因很简单，因为不同的用户间的桌面是不一样的，服务用的是System的权限，在vista里面是Session0，而用户的帐户不是这个（肯定大于0）。

看来，想弹出一个窗体，需要另一个程序来作辅助了。解决方案有两种：

开发一个程序A在启动的时候，随系统启动，并监控指定文件M，服务S有消息的时候，放在文件M里，A 感受了文件变化了，就去读这个文件里的内容，根据规则来作对应的动作。坏处很明显，当用户为了让系统跑得快的时候，这种自启动文件很容易被砍掉，导致了有些功能莫名奇妙地不可用。
同样地，也是开发一个程序A，用CreateProcessAsUser这个API来创建这个A ，并且发送到用户的桌面上去。好处是可以把这个A和服务S 放在同一个程序文件里面，根据不同的参数来启动不同的功能。这样用户除非是删除整个服务，否则不会有部分功能能用，又有部分功能不能用的问题。

现在来看看第二种方案，要想用CreateProcessAsUser这个API ，有这样几个步骤：

１.取得用户的令牌（Token）

２.指定好虚拟桌面

３.调用API创建这个用户进程。

在取得用户令牌的时候，又有几个方法：

１.从用户的进程上去剥

２.先用WTSGetActiveConsoleSessionId得到用户会话ID，再用WTSQueryUserToken这个API去取。

不过在vista下面,服务里面的WTSGetActiveConsoleSessionId这个API得到的总是0，也就是Session0,用这个创建出来的进程，还是属于一个服务进程。(而且这个API是XP以及以后的系统才会提供的，在早点的系统上就会调用失败)所以我们只好从用户的进程上去找，用户登录的时候，一定会有的进程就是：explorer.exe，这样可以遍历所有的进程去找到这个（如果是多人同时登录这个系统里，我也不知道该怎么办了，不知道有没有高人指点一下）。

这样创建出来的用户进程，在进程列表里面可以看到是活动用户的。但是如果在这里面使用一下文件选择框，或是去取一些系统目录，比如说用户的桌面，用户的收藏夹等，都会得到空。这时候因为没有指定用户环境造成的。使用CreateEnvironmentBlock这个API就可以搞定了。

从一个灾难性故障引起的想聊聊delphi里的string

铁匠 — Fri, 25 Apr 2008 18:18:00 GMT

用delphi搞了一个小服务，来实现多线程，可断点续传地上下载文件。所有的小块单独跑的时候，都非常正常，但是组装在一起的时候，突然内存暴长一下子占用了1G，引起了缓存的大量开销，频繁的IO读写引起了low CPU的情况下面的系统无法响应。开始的时候以为是里面的一些内存流没有释放引起的，review了一下代码确认没有问题。所以只好让系统再卡一次，把调试器挂到正在跑的服务上。突然发现以下的代码在运行时候，有异常情况出现：

var
packagesStr: string;
I: Integer;
begin
if Length(FPackages) = 0 then
    packagesStr := ''
else begin
    SetLength(packagesStr, Length(FPackages));
    for I := 0 to Length(FPackages) -1 do
      packagesStr[I ] := chr(byte(FPackages[I]) + 65);
end;

FPackages 是一个记录每个文件包的状态的枚举值，想要把它系列化后保存起来，为了效率起见，所以用了这么一个小技巧（具体的，让我留到后面再讲）。本来才80几个包，结果在这里的字串长度长得惊人。然后很快地发现了问题：

packagesStr[I ] := chr(byte(FPackages[I]) + 65);
应该是

packagesStr[I + 1 ] := chr(byte(FPackages[I]) + 65);
因为当I=0的时候，引入第一个值：65，把这个字串的指针搞乱了，所以引起了海量内存的使用。

好了，让我们先看看delphi里面的string的结构吧：

string是一个比较有意思的类型，它不仅仅是一个字串那么简单。它的结构的开始是一个指针，指向了直正字串开始的地址，所以sting有一个copy on write的特性，也就是说当字串赋值的时候，两个串都是指向同一个内存块（也就是string[1]这个地址），但是如果串被改的时候，就会复制一份出来改。

再来说说我的这个小技巧：因为我这里可能有几十个包，所以保存成字串的时候，如果是一段一段地加起来，到时候会产生大量的临时变量，引起性能的问题。所以我预算了一下它需要多长，就先把这个长度开出来，然后按位地去赋值。

string还有一个妙用是可以当成stream来使用。以前找了一个base64加密的类，它的参数只能传string，而我想要把一副图片转成base64好让它能在IE里面方便地传到服务器上。于是我就把这个图片读到了一个string里面：

var
stream: TMemoryStream;
imagestr: string;
begin
with TJPEGImage.Create do
try
    Assign(FCurrDrawingPad);
    CompressionQuality := 80;
    stream := TMemoryStream.Create;
    try
      SaveToStream(stream);
      SetLength(imagestr, stream.Size);
      stream.Position := 0;
      stream.Read(imagestr[1], stream.Size);
      Result := StrTobase64(imagestr);
    finally
      stream.Free;
    end;
finally
    Free;
end;

终于发现IIS7的好处了

铁匠 — Fri, 02 Nov 2007 14:14:00 GMT

最近IronSoft系列组件又出了一些小问题,比如说GIFBuilder在自己创建GIF的时候,竟然发现只有第一帧有延时,后面的没有延时.在给每帧增加延时的时候,突然发现IIS报错了.一看这种错误老铁一般都很头大,因为IIS没有办法调试这样的问题,只能是和JS一样摸黑着来.

突然想起来好像现在装的是IIS7,不知道有改进没有.于是把DELPHI附加到了IIS7的W3WP.exe进程上,运行网页的时候,发现DELPHI竟然有响应,而且报出了一个错误,一看果真是我的代码错了-_-,这个错误一直都有,不知道为什么到现在才发现.于是在组件的代码上加断点,竟然可以正确地停下并进行调试了.

有了调试器的帮助,我只有十来分钟就找到了问题所在,并修正,感觉好爽:)IIS7终于感觉比以前的版本有点用了.

Delphi里的一些需要注意的问题

铁匠 — Tue, 11 Sep 2007 08:10:00 GMT

又发现了一些问题,记录下来,和大家分享:

在写DLL的时候,一定要在主程序和DLL工程里面都引用内存管理器,比如说BolandMM(宝兰MM),不过我比较推荐FastMM,因为这个内存管理器效率高，而且可以监控到有没有内存泄露的问题，同时可以在发行包里省掉BolandMM.dll。之所以发现这个问题，应该从一个郁闷了我三天的问题说起，在DLL里面执行存储过程的时候，发现一直提示“不正常地定义参数对象。提供了不一致或不完整的信息。”而用SQL事件探寻器，并没有发现程序调用了存储过程。通过大量的跟踪分析后才发现是犯的一个低级错误。
当定一个对象的时候，还没有创建这个对象的时候去访问它，竟然不会报内存保护错误，而是随便扔了一个对象过来，这个问题也郁闷了我好久。
调用存储过程的时候，一定要注意参数的顺序，发现参数的名字只是在程序里面用到，事实上没有传到SQL SERVER上面,只是把参数值按顺序依次传到SQL Server上，如果忽视参数顺序的问题，到时候就有的郁闷了。
用Excel来生成代码：）。要把表生成存储过程和生成对应的对象代码以及初始化保存什么的代码，是一个繁杂而且还容易出错的过程，一个简单的办法就是把表设计拷出来，贴到Excel里，然后用字串函数拼出我们想要的代码。

Delphi一些小结

铁匠 — Mon, 10 Sep 2007 16:27:00 GMT

好久没有像模像样地写DELPHI的程序了,最近写了一些,发现了一些以前没有碰到过的问题,以及小技巧:

封装数据库访问层时,可以用一个先定义一个数据访问接口(如IDataProvider),然后实现封在DLL里面,这样轻松实现在不同的数据库之间切换程序的数据源(实现一个和ASP.NET很类似的Provider模式).
在使用存储过程的时候,对一字串类型的值,一定要指明参数所需要的长度,否则会丢数据,赋值的时候,他会把中文按一个字算,但是在执行的时候,中文会当成两个字来算(这个和.NET比起来差别真大).
为了保持控件和对象的关系,可以把对象的指针挂在控件的Data属性里面,但是注意,有些控件的在释放的时候,会顺路帮你把对象释放了,所以在作内存释放的时候,一定要注意顺序,一定要把对象先放了,再删除控件(或是对象释放前先判断一下还存在不).
对象不是生存期自管理的,所以一定要注意,不然就会有内存泄露,我的作法是创建的时候,顺路就挂到那些ObjectList上,当然得注意,一个对象只能让一个ObjectList管理,不然程序退出的时候,又是一堆错.
因为数据有多个层次,多种目录,所以加载的时候,我开始选择打开一个目录加载一层,后面发现这种方式太复杂了,控制代码写得吐血.后面想到了,把原来的大对象拆成为:小对象+大对象的方式,小对象一次性加载完成(我这里的数据估计就几万条,算一下估计是能占个三五M的内存吧),大对象用懒加载的方式,这样即让控制简单,同时也不会造成加载的时候,速度偏慢和占用内存过多的问题.
如果在显示图片的时候,希望在图像区域出现滚动条,那么可以先把图片控件放在一个Frame里,然后再把这个Frame放到需要显示的地方,固定好Frame的大小,就可以了.原理是:其实显示的滚动条是Frame的.
计划完成DataValidator,这样只要注册一下控件的事情校验要求,就可以轻松实现界面控件的校验需求.

开始把GDI+引入到Delphi中来

铁匠 — Tue, 07 Aug 2007 17:43:00 GMT

最近在写一个小控件,涉及到复杂的坐标变换,以及旋转之类的,现在三角函数都记不全了,作这个实在是痛苦.突然想到了.NET中的图片处理已经使用了GDI+了,里面的坐标变换之类的应该是GDI+的一些API.于是找来Reflector把System.Drawing这个DLL反编,查看源码,果真是从GDIplus.dll这个库里导出来的.GdipRotateWorldTransform 这个实现了坐标系的旋转,GdipTranslateWorldTransform这个实现了坐标系的平移...
不过在处理写文字串的时候GdipDrawString,碰到了麻烦:里面的字体什么的还要引用其它的API(GdipCreateFontFamilyFromName,GdipCreateFont)来生成.在使用GdipCreateFontFamilyFromName的时候,发现生成的FontFamily一直是空的,比较奇怪,最后发现.NET里面实现的时候,导入的字符集已经由以前常见的Ansi变成Unicode了,于是把字体名称的字符转成Unicode编码后搞定。得到一个提示，里面的所有字串的都是需要Unicode编码。
不过比较郁闷的事情是生成的图片一直是空白的，跟踪每一步API的使用返回的值都是OK。还得要一袋烟功夫来研究。