sybase_parameters.pas

sybase大全

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.