{**************************************************************}
{                                                              }
{       Unit for Delphi                                        }
{       Sample of the Extended Stored Procedure                }
{       Created by Valentin Lisetsky                           }
{              Used Source Gleb Oufimtsev (gvu@newmail.ru)     }
{                                                              }
{       Work on MSSQL:                                         }
{         exec master..xpSample @FileName, @WriteString        }
{        (exec master..xpSample 'c:\KU_KU.txt', 'KU-KU')       }
{                                                              }
{**************************************************************}

library XPSMPDLL;

uses
  SysUtils,
  Classes,
  Windows;

{Заголовки API, которые нам понадобятся в примере}
function srv_paraminfo(srv: pointer; num: integer; var typ, maxlen, len: integer;
                  data: pointer; var isnull: boolean): integer;
                  cdecl; external 'Opends60.dll' name 'srv_paraminfo';
function srv_sendmsg(srv: pointer; msgtype: integer; msgnum: integer;
                  severity_class: byte; state: byte; rpcname: pchar; rpcnamelen: integer;
                  linenum: word; message_str: pchar; msglen: integer): integer;
                  cdecl; external 'Opends60.dll' name 'srv_sendmsg';


{возвращает первый параметр - имя файла (с полным путем)}
function GetFileName(srv: pointer):string;
var Typ, MaxLen, Len:Integer; IsNull:boolean; Data:pointer;
begin
  GetMem(Data, 255 );
  try
    srv_paraminfo(srv,  1 , Typ, MaxLen, Len, Data, IsNull);
    SetLength(result, Len);
    MoveMemory(pointer(result), Data, Len);
  finally
    FreeMem(Data);
  end;
end;

{возвращает второй параметр - строку, которую будем
записывать в файл и выводить в ISQL}
function GetString(srv: pointer):string;
var Typ, MaxLen, Len:Integer; IsNull:boolean; Data:pointer;
begin
  GetMem(Data, 255 );
  try
    srv_paraminfo(srv,  2 , Typ, MaxLen, Len, Data, IsNull);
    SetLength(result, Len);
    MoveMemory(pointer(result), Data, Len);
  finally
    FreeMem(Data);
  end;
end;

{Собственно, сама расширенная хранимая процедура}
function xpMain1(srv:pointer):integer; cdecl;
var msg:string; F:TextFile;
begin
  try
    {Создаем файл и суем туда строку.
     Только права должны быть на создание и запись файла в NT}
    AssignFile(F, GetFileName(srv));
    Rewrite(F);
    Writeln(F, GetString(srv));
    CloseFile(F);

    {Рисуем значения параметров в ISQL}
    msg:=# 10 'Значение параметров'# 10 # 9 'файл: "'
               +GetFileName(srv)+'"'# 10 # 9 +'содержимое: "'+GetString(srv)+'"'# 10 ;
    srv_sendmsg(srv, 1 , 0 , 0 , 0 ,nil, 0 , 0 ,PChar(msg),- 1 );

   {Сделаем исключение и полюбуемся результатом.
    Сервер при этом не упадет}
//    raise Exception.Create('Моё сгенерённое исключение');

    result:= 1 ; {Все OK, т.е. SUCCEED}
  except on e:Exception do
    begin
      srv_sendmsg(srv, 2 , 0 , 16 , 1 ,nil, 0 , 0 ,PChar(e.Message),- 1 );
      result:= 0 ; {Дело FAIL, т.е. хреново}
    end;
  end;
end;

exports xpMain1 name 'xpSample';

begin
end.