uadatapacket.pas

基于Midas 技术的多层应用开发包第二版（带开发文档）

end;

constructor TUAExecuteDataOutPacket.Create;
begin
  inherited;
  FErrorList := TUAParams.Create;
  FAnyValue := TUAParamsList.Create;

end;

destructor TUAExecuteDataOutPacket.Destroy;
begin
  FAnyValue.Free;
  FErrorList.Free;
  inherited;
end;

function TUAExecuteDataOutPacket.GetItemAnyValue(index,
  itemid: integer): TAnyParam;
begin
  Result := TAnyParam( FAnyValue.GetItem(index,itemid) );

end;

function TUAExecuteDataOutPacket.GetItemErrorParam(
  index: Integer): TErrorParam;
begin
  Result := TErrorParam(FErrorList.Items[index]);

end;

function TUAExecuteDataOutPacket.GetResultCode: Integer;
begin
  Result := FResultCode;
end;

function TUAExecuteDataOutPacket.GetUaData: OleVariant;
begin

  Result := VarArrayCreate([0,3], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := FResultCode;
  Result[2] := FErrorList.UAData;
  Result[3] := FAnyValue.UAData;
end;

procedure TUAExecuteDataOutPacket.SetResultCode(const Value: Integer);
begin
  FResultCode := Value;
end;

procedure TUAExecuteDataOutPacket.SetUaData(const Value: OleVariant);
begin
  inherited SetUaData(value[0]);
  FResultCode := value[1];

  FErrorList.UAData := value[2];
  FAnyValue.UAData := value[3];
end;

{ TUAUpdateDataInPacket }

constructor TUAUpdateDataInPacket.Create;
begin
  Inherited;
  FDeltaList := TUAParams.Create;
  FAnyParam := TUAParamsList.Create;

end;

destructor TUAUpdateDataInPacket.Destroy;
begin
  FAnyParam.Free;
  FDeltaList.Free;
  inherited;
end;

function TUAUpdateDataInPacket.GetUaData: OleVariant;
begin

  Result := VarArrayCreate([0,4], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := FUpdateIndex;
  Result[2] := FDeltaList.UAData;

  Result[3] := FAnyParam.UAData;
  Result[4] := FDBConnTag;
end;

procedure TUAUpdateDataInPacket.SetUaData(const Value: OleVariant);
begin

  inherited SetUaData(value[0]);
  FUpdateIndex := value[1];
  FDeltaList.UAData := value[2];
  FAnyParam.UAData := value[3];
  FDbConnTag := value[4];
  
end;


procedure TUAUpdateDataInPacket.ClearAllUaData;
begin
  FDeltaList.Clear;
  FAnyParam.Clear;
end;


procedure TUAUpdateDataInPacket.AddItemDelta(aDelta: TDeltaParam);
begin
  FDeltaList.Add(aDelta);
end;

function TUAUpdateDataInPacket.CountItemDelta(index: integer): integer;
//var
//  aList: TObjectList;
begin
  if index=-1 then
    result := FDeltaList.Count
  else
    result := -1

end;

function TUAUpdateDataInPacket.GetItemDelta(index: Integer): TDeltaParam;
begin
  Result := TDeltaParam(FDeltaList.Items[index]);
end;

procedure TUAUpdateDataInPacket.SetUpdateIndex(const Value: Integer);
begin
  FUpdateIndex := Value;
end;

procedure TUAUpdateDataInPacket.AddItemAnyParam(index: integer;
  aAnyParam: TAnyParam);
begin
  FAnyParam.AddItem(index, aAnyParam);

end;

function TUAUpdateDataInPacket.CountAnyParam(index: integer): integer;
var
  aList: TObjectList;
begin
  if index=-1 then
    result := FAnyParam.Count
  else
    if index>=FAnyParam.Count then
      result := -1
    else
    begin
      aList := TObjectList(FAnyParam[index]);
      result := aList.Count;
    end;

end;

function TUAUpdateDataInPacket.GetItemAnyParam(index,
  itemid: integer): TAnyParam;
begin
  Result := TAnyParam( FAnyParam.GetItem(index,itemid) );

end;

procedure TUAUpdateDataInPacket.SetDBConnTag(const Value: string);
begin
  FDBConnTag := Value;
end;

{ TDataSheetParam }


function TDataSheetParam.GetUaData: OleVariant;
begin

  Result := VarArrayCreate([0,5], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := AliasTableName;
  Result[2] := FieldName;
  Result[3] := FieldType;
  Result[4] := RelSymbol;
  Result[5] := LastValue;

end;

procedure TDataSheetParam.SetAliasTableName(const Value: string);
begin
  if Trim(value) <> '' then
    FAliasTableName := Trim(Value);
end;

procedure TDataSheetParam.SetFieldName(const Value: string);
begin
  if Trim(value)<>'' then
    FFieldName := Trim(value);
end;

procedure TDataSheetParam.SetFieldType(const Value: TFieldType);
begin
  FFieldType := Value;
end;

procedure TDataSheetParam.SetLastValue(const Value: Variant);
begin
  if (not VarIsNull(value)) and (VarCompareValue(value,Unassigned) <> vrEqual) then
    FLastValue := Value;
end;

procedure TDataSheetParam.SetRelSymbol(const Value: string);
begin
  if Trim(value) <> '' then
    FRelSymbol := Trim(Value);
end;

procedure TDataSheetParam.SetUaData(const Value: OleVariant);
begin
  inherited SetUaData(value[0]);
  AliasTableName   := value[1];
  FieldName    := value[2];
  FieldType    := value[3];
  RelSymbol    := value[4];
  LastValue    := value[5];

end;

{ TRowSheetParam }


function TRowSheetParam.GetUaData: OleVariant;
begin
  Result := VarArrayCreate([0,4], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := AliasTableName;
  Result[2] := FieldName;
  Result[3] := FieldType;
  Result[4] := CurrValue;

end;

procedure TRowSheetParam.SetAliasTableName(const Value: string);
begin
  if Trim(value) <> '' then
    FAliasTableName := Trim(Value);
end;

procedure TRowSheetParam.SetCurrValue(const Value: OleVariant);
begin
  if (not VarIsNull(value)) and (VarCompareValue(value,Unassigned) <> vrEqual) then
    FCurrValue := Value;
end;

procedure TRowSheetParam.SetFieldName(const Value: string);
begin
  if Trim(value)<>'' then
    FFieldName := Trim(value);
end;

procedure TRowSheetParam.SetFieldType(const Value: TFieldType);
begin
  FFieldType := Value;
end;

procedure TRowSheetParam.SetUaData(const Value: OleVariant);
begin

  inherited SetUaData(value[0]);
  AliasTableName   := value[1];
  FieldName    := value[2];
  FieldType    := value[3];
  CurrValue    := value[4];

end;

{ TMasterLinkParam }

function TMasterLinkParam.BuildMasterSqlScript: string;
begin

  Result := '';

  if (trim(FMasterAliasTableName) = '') or (trim(FMasterField) ='')
     or (VarisNull(FMasterFieldValue) or
      (VarCompareValue(FMasterFieldValue,Unassigned) = vrEqual )) then Exit;

  Result := FMasterAliasTableName+'.'+FMasterField+ '='+ AnyValueToStr(FDataType,FMasterFieldValue);

end;

constructor TMasterLinkParam.Create;
begin
  inherited;

end;

destructor TMasterLinkParam.Destroy;
begin

  inherited;
end;

function TMasterLinkParam.GetUaData: OleVariant;
begin

  Result := VarArrayCreate([0,4], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := FMasterAliasTableName;
  Result[2] := FMasterField;
  Result[3] := Ord(FDataType);
  Result[4] := FMasterFieldValue;

end;

procedure TMasterLinkParam.SetDataType(const Value: TFieldType);
begin
  FDataType := Value;
end;

procedure TMasterLinkParam.SetMasterAliasTableName(const Value: string);
begin
  FMasterAliasTableName := Value;
end;

procedure TMasterLinkParam.SetMasterField(const Value: string);
begin
  FMasterField := Value;
end;

procedure TMasterLinkParam.SetMasterFieldValue(const Value: Variant);
begin
  FMasterFieldValue := Value;
end;

procedure TMasterLinkParam.SetUaData(const Value: OleVariant);
begin

  inherited SetUaData(Value[0]);
  FMasterAliasTableName := Value[1];
  FMasterField := Value[2];
  FDataType := Value[3];
  FMasterFieldValue := Value[4];

end;

{ TDataReturnParam }

constructor TDataReturnParam.Create;
begin
  inherited;

end;

destructor TDataReturnParam.Destroy;
begin

  inherited;
end;

function TDataReturnParam.GetAliasTableName: string;
begin
  Result := FAliasTableName;
end;

function TDataReturnParam.GetAllRecCount: integer;
begin
  Result := FAllRecCount;
end;

function TDataReturnParam.GetCurrRecCount: integer;
begin
  Result := FCurrRecCount;
end;

function TDataReturnParam.GetData: OleVariant;
begin
  Result := FData;
end;

function TDataReturnParam.GetDataSheetValue: OleVariant;
begin
  Result := FDataSheetValue;
end;

function TDataReturnParam.GetRowSheetValue: OleVariant;
begin
  Result :=FRowSheetValue;
end;

function TDataReturnParam.GetUaData: OleVariant;
begin

  Result := VarArrayCreate([0,6], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := FAliasTableName;
  Result[2] := FData;
  Result[3] := FAllRecCount;
  Result[4] := FCurrRecCount;
  Result[5] := FRowSheetValue;
  Result[6] := FDataSheetValue;

end;

procedure TDataReturnParam.SetAliasTableName(const Value: string);
begin
  if Trim(Value) <> '' then
    FAliasTableName := Value;
end;

procedure TDataReturnParam.SetAllRecCount(const Value: integer);
begin
  FAllRecCount := Value;
end;

procedure TDataReturnParam.SetCurrRecCount(const Value: integer);
begin
  FCurrRecCount := Value;
end;

procedure TDataReturnParam.SetData(const Value: OleVariant);
begin
  if (not VarIsEmpty(Value)) and (VarCompareValue(Value,Unassigned) <> vrEqual) then
    FData := Value;

end;

procedure TDataReturnParam.SetDataSheetValue(const Value: OleVariant);
begin
  if (not VarIsEmpty(Value)) and (VarCompareValue(Value,Unassigned) <> vrEqual) then
    FDataSheetValue := Value;
end;

procedure TDataReturnParam.SetRowSheetValue(const Value: OleVariant);
begin

  if (not VarIsEmpty(Value)) and (VarCompareValue(Value,Unassigned) <> vrEqual) then
    FRowSheetValue := Value;

end;

procedure TDataReturnParam.SetUaData(const Value: OleVariant);
begin

  inherited SetUaData(Value[0]);
  FAliasTableName := Value[1];
  FData := value[2];
  FAllRecCount := Value[3];
  FCurrRecCount:= Value[4];

  FRowSheetValue := Value[5];

  FDataSheetValue := Value[6];

end;

{ TAnyParam }

function TAnyParam.GetAnyValue: Variant;
begin
  Result := FAnyValue;
end;

function TAnyParam.GetUaData: OleVariant;
begin
  Result := VarArrayCreate([0,1], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := FAnyValue;
end;

procedure TAnyParam.SetAnyValue(const Value: Variant);
begin
  FAnyValue := Value;
end;

procedure TAnyParam.SetUaData(const Value: OleVariant);
begin

  inherited SetUaData(value[0]);
  FAnyValue  := value[1];

end;

{ TErrorParam }

function TErrorParam.GetUaData: OleVariant;
begin

  Result := VarArrayCreate([0,4], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := FErrorCode;
  Result[2] := FErrorMask;
  Result[3] := FErrorContext;
  Result[4] := FErrorMsg;

end;

procedure TErrorParam.SetErrorCode(const Value: integer);
begin
  FErrorCode := Value;
end;

procedure TErrorParam.SetErrorContext(const Value: string);
begin
  FErrorContext := Value;
end;

procedure TErrorParam.SetErrorMask(const Value: integer);
begin
  FErrorMask := Value;
end;

procedure TErrorParam.SetErrorMsg(const Value: string);
begin
  FErrorMsg := Value;
end;

procedure TErrorParam.SetUaData(const Value: OleVariant);
begin

  inherited SetUaData(value[0]);
  FErrorCode  := value[1];

  FErrorMask  := value[2];
  FErrorContext := value[3];
  FErrorMsg := value[4];

end;


initialization
  RegisterClasses( [TUAParam,TMasterLinkParam,TRowSheetParam,TDataSheetParam,TDataRequestParam,TDataReturnParam,TErrorParam,
                   TDeltaParam ,TUARequestDataInPacket,TUARequestDataOutPacket,TUAUpdateDataInPacket,TUAUpdateDataOutPacket
                   ,TUAExecuteDataInPacket,TUAExecuteDataOutPacket,TAnyParam]);
end.