www.pudn.com > sybase_dblib4.zip > sybase_parameters.pas

unit sybase_parameters; 
interface 
uses classes,sysutils,dialogs; 
 
const 
  STextFalse = 62509; 
  STextTrue = 62510; 
 
type 
{  TReturnType = (ptUnknown, ptInput, ptOutput,ptInputOutput, ptResult);} 
  TReturnType = (ptUnknown, ptInput, ptOutput,ptInputOutput); 
  TSybFieldType = (ftUnKnown,ftSmallint,ftWord,ftInteger,ftTime,ftDate,ftDateTime,ftCurrency,ftFloat,ftChar,ftBit,ftText); 
  appfieldtype = string[30]; 
  SybObjectname = string[30]; 
 
type TSybParams = class; 
 
tsybparam = class(TObject) 
  private 
    FParamList    :TSybParams; 
    FData         :string; 
    FName         :string; 
    FDataType     :TSybFieldType; 
    FSybDataType  :SybObjectname; 
    FNull         :Boolean; 
    FParamType    :TReturnType; 
    FAppFieldName :appfieldtype; 
    function GetSybDataType:integer; 
    function GetSybReturnType:integer; 
  protected 
    { Protected declarations } 
    function IsEqual(Value: TSybParam): Boolean; 
    procedure SetDataType(Value: TSybFieldType); 
    procedure setisnull(value:boolean); 
    procedure setvalue(value:string); 
    procedure setAppFieldName(value:appfieldtype); 
  public 
    constructor create(AParamList :TSybParams;AParamType :TReturnType); 
    destructor destroy; override; 
    procedure Assign(Param: TSybParam); 
{    procedure AssignField(Field: TSybField);} 
{    procedure AssignFieldValue(Field: TSybField; const Value: Variant);} 
    procedure GetData(Buffer: Pointer); 
    function GetDataSize: Word; 
    procedure SetData(Buffer: Pointer); 
    procedure initvalue; 
    procedure Clear; 
    property isnull: Boolean read FNull write setisnull; 
    property Value: string read fdata write Setvalue; 
    property Name: string read FName write FName; 
    property DataType: TSybFieldType read FDataType write SetDataType; 
    property SybDataType:Integer read GetSybDataType; 
    property SybReturnType:Integer read GetSybReturnType; 
    property ParamType: TReturnType read FParamType write FParamType; 
    property AppFieldName :appfieldtype read FAppFieldName write SetAppFieldName; 
  end; 
 
tsybparams= class(TPersistent) 
  private 
    FItems   :TList; 
    function getparam(index:word):tsybparam; 
    function GeTParamValue(const ParamName: string):string; 
    procedure ReadBinaryData(Stream: TStream); 
    procedure WriteBinaryData(Stream: TStream); 
    procedure SetParamValue(const ParamName: string;const Value:string); 
  protected 
    { Protected declarations } 
    procedure AssignTo(Dest: TPersistent); override; 
    procedure DefineProperties(Filer: TFiler); override; 
  public 
    constructor create; virtual; 
    destructor destroy; override; 
    procedure assign(Source:tPersistent); override; 
    procedure assignvalues(Value:TSybParams); 
    procedure addparam(value:tsybparam); 
    function createparam(fldtype:tsybfieldtype;const paramname:string;paramtype:treturntype):tsybparam; 
    procedure GetParamList(List: TList; const ParamNames: string); 
    procedure removeparam(value:tsybparam); 
    procedure exchangeparams(index1,index2:integer); 
    procedure clear; 
    function count:integer; 
    function parambyname(const value:string):tsybparam; 
    property items[index:word]:tsybparam read getparam; default; 
    property ParamValues[const ParamName: string]:string read GeTParamValue write SeTParamValue; 
  end; 
 
function ExtractFieldName(const Fields: string; var Pos: Integer): string; 
 
implementation 
uses sybase32; 
 
function ExtractFieldName(const Fields: string; var Pos: Integer): string; 
var 
  I: Integer; 
begin 
  I := Pos; 
  while (I <= Length(Fields)) and (Fields[I] <> ';') do Inc(I); 
  Result := Copy(Fields, Pos, I - Pos); 
  if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I); 
  Pos := I; 
end; 
 
constructor TSybParam.create(AParamList :TSybParams;AParamType :TReturnType); 
begin 
  if aparamlist <> nil then 
  begin 
    aparamlist.addparam(self); 
  end; 
  paramtype:=aparamtype; 
  datatype:=ftUnknown; 
  value:=''; 
  fnull:=false; 
end; 
 
destructor TSybParam.destroy; 
begin 
  if fparamlist <> nil then fparamlist.removeparam(self); 
end; 
 
procedure TSybParam.setisnull(value:boolean); 
begin 
  fnull:=value; 
end; 
 
procedure TSybParam.setAppFieldName(value:appfieldtype); 
begin 
  fAppFieldName:=value; 
end; 
 
procedure TSybParams.Assign(Source: TPersistent); 
var 
  I: Integer; 
begin 
  if Source is TSybParams then 
  begin 
    Clear; 
    for I := 0 to TSybParams(Source).Count - 1 do 
      with TSybParam.Create(Self, ptUnknown) do 
        Assign(TSybParams(Source)[I]); 
  end 
  else inherited Assign(Source); 
end; 
 
procedure TsybParams.AssignTo(Dest: TPersistent); 
begin 
  if Dest is TsybParams then TsybParams(Dest).Assign(Self) 
  else inherited AssignTo(Dest); 
end; 
 
procedure TSybParams.AssignValues(Value: TSybParams); 
var 
  I, J: Integer; 
begin 
    for I := 0 to Count - 1 do 
      for J := 0 to Value.Count - 1 do 
        if Items[I].Name = Value[J].Name then 
        begin 
          Items[I].Assign(Value[J]); 
          Break; 
        end; 
end; 
 
procedure TSybParam.setvalue(value:string); 
begin 
  fdata:=value; 
end; 
 
procedure TSybParam.Assign(Param: TSybParam); 
begin 
  if Param <> nil then 
  begin 
    DataType := Param.DataType; 
    FData := Param.FData; 
    fnull:=param.isnull; 
    fappfieldname:=param.appfieldname; 
    Name := Param.Name; 
    if ParamType = ptUnknown then ParamType := Param.ParamType; 
  end; 
end; 
 
procedure TSybParam.Clear; 
begin 
  FNull := false; 
{  FData := 0;} 
end; 
 
function TSybParam.GetDataSize: Word; 
begin 
  Result := Length(FData) + 1; 
end; 
 
procedure TSybParam.GetData(Buffer: Pointer); 
begin 
  StrMove(Buffer, PChar(string(FData)), Length(FData)); 
 (PChar(Buffer) + Length(FData))^ := #0; 
end; 
 
procedure TSybParam.SetData(Buffer: Pointer); 
begin 
{  AsString := StrPas(Buffer);} 
end; 
 
function TSybParam.IsEqual(Value: TSybParam): Boolean; 
begin 
  Result := (VarType(FData) = VarType(Value.FData)) and 
    (FData = Value.FData) and (Name = Value.Name) and 
    (DataType = Value.DataType) and (isnull = Value.isnull) and 
    (ParamType = Value.ParamType); 
end; 
 
procedure TSybParam.InitValue; 
begin 
  FNull := False; 
end; 
 
{********************************************************************} 
function TSybParams.GeTParamValue(const ParamName: string):string; 
begin 
  Result := ParamByName(ParamName).Value 
end; 
 
function tsybparams.count:integer; 
begin 
  result:=fitems.count; 
end; 
 
procedure TSybParam.SetDataType(Value: TSybFieldType); 
begin 
{  FData := 0;} 
  FDataType := Value; 
end; 
 
procedure TSybParams.SeTParamValue(const ParamName: string; 
  const Value:string); 
begin 
  ParamByName(ParamName).Value := Value; 
end; 
 
procedure TSybParams.GeTParamList(List: TList; const ParamNames: string); 
var 
  Pos: Integer; 
begin 
  Pos := 1; 
  while Pos <= Length(ParamNames) do 
    List.Add(ParamByName(ExtractFieldName(ParamNames, Pos))); 
end; 
 
constructor tsybparams.create; 
begin 
  fitems:=tlist.create; 
end; 
 
destructor tsybparams.destroy; 
begin 
  clear; 
  fitems.free; 
  inherited destroy; 
end; 
 
function TSybParams.CreateParam(FldType: TSybFieldType; const ParamName: string; 
  ParamType: TReturnType): TSybParam; 
begin 
  Result := TSybParam.Create(Self, ParamType); 
  with Result do 
  begin 
    Name := ParamName; 
    DataType :=FldType; 
{    value:='';} 
  end; 
end; 
 
procedure tsybparams.addparam(value:tsybparam); 
begin 
  fitems.add(value); 
  value.FParamList:=self; 
end; 
 
procedure tsybparams.exchangeparams(index1,index2:integer); 
begin 
  fitems.exchange(index1,index2); 
end; 
 
procedure tsybparams.removeparam(value:tsybparam); 
begin 
  fitems.remove(value); 
  value.FParamList:=nil; 
end; 
 
procedure tsybparams.clear; 
begin 
  while count>0 do 
    tsybparams(FItems.last).free; 
end; 
 
function tsybparams.getparam(index:word):tsybparam; 
begin 
  result:=parambyname(tsybparam(fitems[index]).name); 
end; 
 
function tsybparams.parambyname(const value:string):tsybparam; 
var i :integer; 
begin 
  for i:=0 to count-1 do 
  begin 
    result:=fitems[i]; 
    if ansicomparetext(result.name,value)=0 then exit; 
  end; 
  showmessage('Parameter not found !'); 
end; 
 
procedure TSybParams.DefineProperties(Filer: TFiler); 
begin 
  inherited DefineProperties(Filer); 
  Filer.DefineBinaryProperty('Data', ReadBinaryData, WriteBinaryData,count>0); 
end; 
 
procedure TSybParams.ReadBinaryData(Stream: TStream); 
var 
  I, Temp, NumItems: Integer; 
  Buffer: array[0..255] of Char; 
  TempStr: string; 
begin 
  Clear; 
  with Stream do 
  begin 
    NumItems := 0; 
    ReadBuffer(NumItems, SizeOf(NumItems)); 
    for I := 0 to NumItems - 1 do 
    begin 
      with TSybParam.Create(Self, ptUnknown) do 
      begin 
        Temp := 0; 
        ReadBuffer(Temp, SizeOf(Temp)); 
        SetLength(TempStr, Temp); 
        ReadBuffer(PChar(TempStr)^, Temp); 
        Name := TempStr; 
        ReadBuffer(FParamType, SizeOf(FParamType)); 
        ReadBuffer(FDataType, SizeOf(FDataType)); 
        ReadBuffer(FNull, SizeOf(FNull)); 
        ReadBuffer(FAppFieldName,sizeof(appfieldtype)); 
        Temp := 0; 
        ReadBuffer(Temp, SizeOf(Temp)); 
        SetLength(TempStr, Temp); 
        ReadBuffer(PChar(TempStr)^, Temp); 
        FData := TempStr; 
        Value := TempStr; 
      end; 
    end; 
  end; 
end; 
 
procedure TSybParams.WriteBinaryData(Stream: TStream); 
var 
  I: Integer; 
  Temp: integer; 
  Version: Word; 
  Buffer: array[0..255] of Char; 
begin 
  with Stream do 
  begin 
    Temp := Count; 
    WriteBuffer(Temp, SizeOf(Temp)); 
    for I := 0 to Count - 1 do 
      with Items[I] do 
      begin 
        Temp := Length(FName); 
        WriteBuffer(Temp,sizeof(temp)); 
        WriteBuffer(PChar(FName)^, Length(FName)); 
        WriteBuffer(FParamType, SizeOf(FParamType)); 
        WriteBuffer(FDataType, SizeOf(FDataType)); 
        WriteBuffer(FNull, SizeOf(FNull)); 
        WriteBuffer(FAppFieldName,sizeof(appfieldtype)); 
        Temp := Length(FData); 
        WriteBuffer(Temp,sizeof(temp)); 
        WriteBuffer(PChar(FData)^, Length(FData)); 
    end; 
  end; 
end; 
 
function TSybParam.GetSybDataType:integer; 
begin 
  case datatype of 
    ftUnknown:result:=SYBCHAR; 
    ftSmallint:result:=SYBINT1; 
    ftInteger:result:=SYBINT2; 
    ftWord:result:=SYBINT4; 
    ftTime:result:=SYBDATETIME; 
    ftDate:result:=SYBDATETIME4; 
    ftDateTime:result:=SYBDATETIME; 
    ftCurrency:result:=SYBMONEY; 
    ftFloat:result:=SYBFLT8; 
    ftChar:result:=SYBCHAR; 
    ftBit:result:=SYBBIT; 
    ftText:result:=SYBTEXT; 
  end 
 
end; 
 
function TSybParam.GetSybReturnType:integer; 
begin 
  case paramtype of 
    ptUnknown:result:=DBRPCRETURN; 
    ptInput:result:=DBRPCNORETURN; 
    ptOutput:result:=DBRPCRETURN; 
    ptInputOutput:result:=DBRPCRETURN; 
  end 
 
end; 
 
end.