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);