Delphi写Sql2000扩展存储过程代码示例

library project1;

uses
   Windows,
   SysUtils,
   MSODSApi;

... {$R * .res} 
Function GetParamStr(pSrvProc: SRV_PROC; Index : integer; Var Param : String ) : integer;
var
   PType : Byte;
   cbMaxLen , ParaLen : DWORD;
   IsNULL : BOOL;
begin
   Result : = NO_ERROR;
   srv_paraminfo(pSrvProc, index, @PType, @cbMaxLen, @ParaLen, NIL, @IsNULL);

    if PType in [SRVTEXT,SRVVARCHAR,SRVCHAR,SRVNTEXT,
                SRVBIGVARCHAR,SRVBIGCHAR,SRVNVARCHAR,SRVNCHAR] then
     begin
       Param : =   '''' ;
        if ParaLen > 0 then begin
         SetLength(Param , ParaLen);
         srv_paraminfo(pSrvProc, index, @PType, @cbMaxLen, @ParaLen, @Param[ 1 ], @IsNULL);
       end;
     end
    else begin
     Result : =   - 1 ;
   end;
end;


Function EpPackFile(pSrvProc: SRV_PROC) : integer;cdecl;
var
   ls1,ls2,ls3 : String;
   n      : integer;
begin

   Result : =   1 ;
   n : = srv_rpcparams(pSrvProc);
    if n <>   3 then begin
      //      不是3个参数 
   end;
    if    (GetParamStr(pSrvProc, 1 ,ls1) <> NO_ERROR) then begin
      //     不是字符串 
   end;
    if     (GetParamStr(pSrvProc, 2 ,ls2) <> NO_ERROR) then begin
      //     不是字符串 
   end;
    if     (GetParamStr(pSrvProc, 3 ,ls3) <> NO_ERROR) then begin
      //     不是字符串 
   end;
   n : = Length(ls1);
   srv_describe(pSrvProc, 1 ,   '' 参数 '' , SRV_NULLTERM, SRVBIGVARCHAR,
                 n, SRVBIGVARCHAR, n, NIL);
     srv_setcoldata(pSrvProc, 1 , @ls1[ 1 ]);
     srv_sendrow(pSrvProc);
     srv_setcoldata(pSrvProc, 1 , @ls2[ 1 ]);
     srv_sendrow(pSrvProc);
     srv_setcoldata(pSrvProc, 1 , @ls3[ 1 ]);
     srv_sendrow(pSrvProc);
   srv_senddone(pSrvProc, (SRV_DONE_COUNT or SRV_DONE_MORE), 0 , 1 );
end;


exports
   EpPackFile Name '' xp_EpPackFile '' ;
begin
end.

编译后放入binn目录，在sql中添加并测试，代码如下:

 

Use Master;
IF   object_id ( '' xp_EpPackFile '' ) IS   NOT   NULL   EXEC sp_dropextendedproc '' xp_EpPackFile '' ;
EXEC sp_addextendedproc '' xp_EpPackFile '' , '' project1.dll '' ;
EXEC master..xp_EpPackFile '' aa '' , '' bb '' , '' cc '' ;
EXEC sp_dropextendedproc '' xp_EpPackFile '' ;
DBCC SPEncrypt(FREE);