Mega Code Archive
MS SQL Extended Stored Procedures Tutorial (Part 3)
<![CDATA[
Title: MS SQL Extended Stored Procedures Tutorial (Part 3)
Question: As we saw from Part 2 the ODS API is rather complex and in places unwieldy. Here's where the power of Delphi comes to the rescue. We will create a class thst hides and encapsulates the workings of the API.
The class must be able to ....
1) Tell us if it's creation has the correct number of passed
parameters and there type are correct.
2) Be able to return the actual parameter values in a string list together with the count.
3) Be able to add data rows to the returned dataset via a string array.
4) Be able to create the returned data set with returned success or error.
5) handle Errors and Usage messages gracefully.
The API is able to handle all sorts of input and output data types. To keep things nice and simple we will restrict ALL input parameters and output columns to type string.
This is not as limiting as it seems as within the DLL we can covert Parmams[x] to any type via StrToInt(), StrToDate() etc. Also the output columns are no problem as Delphi TQuery ability to typecast fields solves this problem..
eg.
Query1.Fields[0].AsString;
Query1.Fields[0].AsInteger;
Next .. Using the class to create a user friendly DLL template
Answer:
unit MahMsSqlXP;
interface
// =============================================================================
//
// Mike Heydon 2006
//
// =============================================================================
uses Classes,SysUtils,MsOdsApi;
const
XP_NOERROR = 0;
XP_ERROR = 1;
type
{TXpStoredProc}
TXpStoredProc = class(TObject)
private
FResultHeaders : array of string;
FErrors : boolean;
FSrvProc : SRV_PROC;
FResultCols,
FParamCount : integer;
FParams : TStringList;
FUsageHelp : string;
FDataList : TList;
procedure _PrintError(AErrorMsg : PChar);
public
constructor Create(ASrvProc : SRV_PROC;
AXpProcName : string;
AParamNames : array of string;
AResultHeaders : array of string);
destructor Destroy; override;
procedure AddResultRow(AStrArray : array of string);
function CreateResultSet : SRVRETCODE;
// Properties
property ParamCount : integer read FParamCount;
property Params : TStringList read FParams;
property Errors : boolean read FErrors;
end;
// -----------------------------------------------------------------------------
implementation
// =======================================
// Create and Destroy the instance
// =======================================
constructor TXpStoredProc.Create(ASrvProc : SRV_PROC;
AXpProcName : string;
AParamNames : array of string;
AResultHeaders : array of string);
var i,iRequiredCount,
iMaxLen,iActualLen : integer;
iType : byte;
bNull : longbool;
pData : pointer;
sData : string;
begin
inherited Create;
FErrors := false;
FDataList := TList.Create;
FParams := TStringList.Create;
FParamCount := 0;
FSrvProc := ASrvProc;
FResultCols := length(AResultHeaders);
SetLength(FResultHeaders,FResultCols);
for i := low(AResultHeaders) to high(FResultHeaders) do
FResultHeaders[i] := AResultHeaders[i];
// Build up usage help string
FUsageHelp := 'Usage: ' + AXpProcName + ' ';
for i := low(AParamNames) to high(AParamNames) do
FUsageHelp := FUsageHelp + ',';
Delete(FUsageHelp,length(FUsageHelp),1);
// Count number of input parameters - Must Match ParamNames
FParamCount := srv_RpcParams(ASrvProc);
iRequiredCount := length(AParamNames);
if iRequiredCount FParamCount then begin
_PrintError(PChar(FUsagehelp));
FErrors := true;
end;
// Check all Params are of type string
if not FErrors then begin
for i := 1 to FParamCount do begin
// Get parameter type and length information.
if (srv_ParamInfo(ASrvProc,i,@iType,@iMaxLen,@iActualLen,
nil,@bNull) = FAIL) then begin
_PrintError('srv_paraminfo failed...');
FErrors := true;
exit;
end;
// Make sure parameter is of char or varchar datatype (string)
if (iType SRVBIGVARCHAR) and (iType SRVBIGCHAR) then begin
_PrintError('Parameters MUST be of type string');
FErrors := true;
exit;
end;
// Create Delphi string from pointer and add to Params
pData := srv_ParamData(ASrvProc,i);
SetLength(sData,iActualLen);
move(pData^,sData[1],iActualLen);
FParams.Add(sData);
sData := '';
end;
end;
end;
destructor TXpStoredProc.Destroy;
var i : integer;
begin
for i := 0 to FDataList.Count - 1 do TStringList(FDataList[i]).Free;
FreeAndNil(FDataList);
FreeAndNil(FParams);
inherited Destroy;
end;
// Internal Calls --------------------------------------------------------------
// ===================================================================
// Display error message
// ===================================================================
procedure TXpStoredProc._PrintError(AErrorMsg : PChar);
begin
srv_SendMsg(FSrvProc,SRV_MSG_ERROR,20001,SRV_INFO,1,
nil,0,0,AErrorMsg,SRV_NULLTERM);
srv_SendDone(FSrvProc,(SRV_DONE_ERROR or SRV_DONE_MORE),0,0);
end;
// Public Calls ----------------------------------------------------------------
// ===================================================================
// Add a result row to data array
// ===================================================================
procedure TXpStoredProc.AddResultRow(AStrArray : array of string);
var oStrArray : TStringList;
i : integer;
begin
if not FErrors and (length(AStrArray) 0) then begin
oStrArray := TStringList.Create;
for i := low(AStrArray) to high(AStrArray) do
oStrArray.Add(AStrArray[i]);
FDataList.Add(oStrArray);
end;
end;
// =======================================================
// Generate the result set from data list and return
// XP_ERROR(1) or XP_NOERROR(0)
// =======================================================
function TXpStoredProc.CreateResultSet : SRVRETCODE;
var i,ii,iResult : integer;
oRow : TStringList;
begin
iResult := XP_NOERROR;
if (not FErrors) then begin
if (FResultCols 0) then begin
// Define Colums
for i := low(FResultHeaders) to high(FResultHeaders) do begin
srv_Describe(FSrvProc,i + 1,
PChar(FResultHeaders[i]),SRV_NULLTERM,SRVBIGCHAR,
8000,SRVBIGCHAR,8000,nil);
end;
// Send Rows
for i := 0 to FDataList.Count - 1 do begin
oRow := TStringList(FDataList[i]);
// Add Blanks for missing cols
for ii := oRow.Count to FResultCols - 1 do oRow.Add(' ');
// Set data Pointers for columns
for ii := 0 to oRow.Count - 1 do
srv_SetColData(FSrvProc,ii + 1,PChar(oRow[ii]));
// Send a row
if (srv_SendRow(FSrvProc) = FAIL) then begin
_PrintError('srv_sendrow failed...');
iResult := XP_ERROR;
break;
end;
end;
srv_SendDone(FSrvProc,(SRV_DONE_COUNT or SRV_DONE_MORE),0,1);
end;
end
else
iResult := XP_ERROR;
Result := iResult;
end;
end.
]]>