uadatapacket.pas

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

     procedure SetResultCode(const Value: Integer);

   protected
     function  GetUaData: OleVariant;override;
     procedure SetUaData(const Value: OleVariant);override;
   public
     constructor Create;  override;
     destructor  Destroy; override;

     procedure AddItemAnyValue( index: integer; aAnyValue: TAnyParam );
     function  GetItemAnyValue( index, itemid: integer ): TAnyParam;
     function  CountAnyValue( index: integer = -1 ): integer;

     procedure ClearAllUaData;

     procedure AddItemErrorParam(aErrorParam:TErrorParam);
     function  GetItemErrorParam(index:Integer):TErrorParam;
     function  CountErrorParam(index: integer = -1):integer;

     property UAData:OleVariant read GetUaData write SetUaData;
     property ResultCode:Integer read GetResultCode write SetResultCode;

   end;



function  GetUAClassName(const UAData: OleVariant): string;

function  AnyValueToStr(lDataType: TFieldType;aValue: Variant ): string;

implementation





function AnyValueToStr(lDataType: TFieldType;aValue: Variant ): string;
begin

  case lDataType of
    ftString, ftFixedChar, ftWideString:
        Result := ''''+VarToStr(aValue)+'''';
    ftSmallint, ftInteger, ftWord, ftLargeint, ftAutoInc, ftCurrency:
        Result := VarToStr(aValue);
    ftBoolean:
        if aValue=true then Result:='1'
        else Result :='0';
    ftFloat:
        Result := VarToStr(aValue);
    ftDate, ftTime, ftDateTime:
        Result := ''''+DatetimeToStr(VarToDateTime(aValue))+'''';
    ftBCD:
        Result := VarToStr(aValue);
    ftTimeStamp:
        Result := VarToStr(aValue);

    ftBytes, ftVarBytes:
        Result := ''''+VarToStr(aValue)+'''';

    ftUnknown, ftBlob, ftMemo, ftGraphic,
    ftFmtMemo, ftParadoxOle, ftDBaseOle,
    ftTypedBinary, ftCursor, ftADT, ftArray, ftReference,
    ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
    ftIDispatch, ftGuid, ftFMTBcd:
        Result := '""'

  else
    Result := '""';
  end;

end;



{ TUACustomDataPacket }

function  GetUAClassName(const UAData: OleVariant): string;
var
  aUAData: OleVariant;
begin

  Result := '';
  if not VarIsArray(UAData) then Exit;

  aUAData := UAData;
  while VarIsArray(aUAData[0]) do aUAData:=aUAData[0];
  Result := aUAData[0];

end;



{ TUAParam }

constructor TUAParam.Create;
begin
  FSessionID := RandomHex;
  FIP := LocalIP;
  FTag := GenerateGUID32;
  FVersion := 'ver 1.03A';
  FMachineID := GetComputerName + '#'+GetUserName;
end;

destructor TUAParam.Destroy;
begin

  inherited;
end;

function TUAParam.GetUaData: OleVariant;
begin
  Result := VarArrayCreate([0,5], varVariant);
  Result[0] := ClassName;
  Result[1] := FTag;
  Result[2] := FVersion;
  Result[3] := FMachineID;
  Result[4] := FIP;
  Result[5] := FSessionID;
end;

procedure TUAParam.SetUaData(const Value: OleVariant);
begin
  if VarIsArray(Value) then
  begin
    FTag     := Value[1];
    FVersion := Value[2];
    FMachineID := Value[3];
    FIP := Value[4];
    FSessionID := Value[5];
  end;
end;

{ TDataRequestParam }

constructor TDataRequestParam.Create;
begin
  inherited;

end;

destructor TDataRequestParam.Destroy;
begin

  inherited;
end;

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

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

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



function TDataRequestParam.GetKeyFields: string;
begin
  Result := FKeyFields;
end;


function TDataRequestParam.GetRequestRecCount: integer;
begin
  Result := FRequestRecCount;
end;

function TDataRequestParam.GetUaData: OleVariant;
begin

  Result := VarArrayCreate([0,6], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := FAliasTableName;
  Result[2] := FKeyFields;
  Result[3] := FAllRecCount;
  Result[4] := FCurrRecCount;
  Result[5] := FRequestRecCount;
  Result[6] := FSqlParams;

end;

procedure TDataRequestParam.SetAliasTableName(const Value: string);
begin

  if Trim(Value) <> '' then
    FAliasTableName := Value ;

end;

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

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


procedure TDataRequestParam.SetKeyFields(const Value: string);
begin
  if Trim(Value)<> '' then
    FKeyFields := Value;
end;


procedure TDataRequestParam.SetRequestRecCount(const Value: integer);
begin
  FRequestRecCount := Value;
end;

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

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

  FRequestRecCount := Value[5];

  FSqlParams := Value[6];

  

end;

function TDataRequestParam.GetSqlParams: string;
begin
  Result := FSqlParams;
end;

procedure TDataRequestParam.SetSqlParams(const Value: string);
begin
  FSqlParams := Value;
end;

{ TUAParams }

function TUAParams.GetUaData: OleVariant;
var
  i, iCount: integer;
  aParam:TUAParam;
begin

  if Count=0 then
  begin
    TVarData(result).VType := varEmpty;
    Exit;
  end;

  iCount := Count;
  Result := VarArrayCreate([0,iCount-1],varVariant);
  for i:=0 to iCount-1 do
  begin
    aParam := TUAParam(Items[i]);
    Result[i] := aParam.UAData;
  end;

end;

procedure TUAParams.SetUaData(const Value: OleVariant);
var
  i: integer;
  aParam:TUAParam;
  aParamClass:TClassUAParam;
begin

  if not VarIsArray(Value) then
    Exit;
  Clear;
  for i:=0 to VarArrayHighBound(Value,1) do
  begin
    aParamClass := TClassUAParam(GetClass(GetUAClassName(Value[0])));
    aParam := TUAParam(aParamClass.Create);
    aParam.UAData := Value[i];
    Add(aParam);
  end;

end;




{ TUAParamsList }

function TUAParamsList.AddItem(index: integer; AObject: TObject): Integer;
var
  i: integer;
  aParams:TUAParams;
begin

  for i := Count to index do
  begin
    aParams := TUAParams.Create;
    Add(aParams);
  end;
  aParams := TUAParams(Items[Index]);
  Result := aParams.Add(AObject);

end;

function TUAParamsList.CountParamsItem(const Index:Integer = -1): Integer;
begin
  Result := 0;
end;

destructor TUAParamsList.Destroy;
begin

  inherited;
end;

function TUAParamsList.GetItem(index, itemid: integer): TObject;
var
  aParams:TUAParams;
begin

  Result := nil;
  if index>=Count then Exit;
  aParams := TUAParams(Items[Index]);
  if ItemID >=aParams.Count then Exit;
  Result := aParams.Items[ItemId];

end;

function TUAParamsList.GetUaData: OleVariant;
var
  i, iCount: integer;
  aParams:TUAParams;
begin

  if Count=0 then
  begin
    TVarData(Result).VType := varEmpty;
    Exit;
  end;

  iCount := Count;
  Result := VarArrayCreate([0,iCount-1],varVariant);
  for i:=0 to iCount-1 do
  begin
    aParams := TUAParams(Items[i]);
    Result[i] := aParams.UAData;
  end;

end;

procedure TUAParamsList.SetUaData(const Value: OleVariant);
var
  i: integer;
  aParams:TUAParams;
begin

  if not VarIsArray(Value) then
    Exit;
  Clear;
  for i:=0 to VarArrayHighBound(Value,1) do
  begin
    aParams := TUAParams.Create;
    aParams.UAData := Value[i];
    Add(aParams);
  end;

end;


{ TDeltaParam }

constructor TDeltaParam.Create;
begin
  inherited;

end;

destructor TDeltaParam.Destroy;
begin

  inherited;
end;

function TDeltaParam.GetUaData: OleVariant;
begin
  Result := VarArrayCreate([0,3], varVariant);
  Result[0] := inherited GetUaData;
  Result[1] := FAliasTableName;
  Result[2] := FKeyFields;
  Result[3] := FDelta;
end;

procedure TDeltaParam.SetAliasTableName(const Value: string);
begin
  FAliasTableName := Value;
end;

procedure TDeltaParam.SetDelta(const Value: OleVariant);
begin
  FDelta := Value;
end;

procedure TDeltaParam.SetKeyFields(const Value: string);
begin
  FKeyFields := Value;
end;

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

  inherited SetUaData(Value[0]);
  FAliasTableName := Value[1];
  FKeyFields := Value[2];
  FDelta := Value[3];

end;

{ TUARequestDataInPacket }


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

end;

procedure TUARequestDataInPacket.AddItemDataSheet(
  aDataSheetParam: TDataSheetParam);
begin
 FDataSheetList.Add(aDataSheetParam);
end;

procedure TUARequestDataInPacket.AddItemMasterLink(
  aMasterLink: TMasterLinkParam);
begin
  FMasterLinkList.Add(aMasterLink);

end;

procedure TUARequestDataInPacket.AddItemRequestData(
  aRequestData: TDataRequestParam);
begin
  FRequestDataList.Add(aRequestData);
end;

procedure TUARequestDataInPacket.AddItemRowSheet(
  aRowSheetParam: TRowSheetParam);
begin
 FRowSheetList.Add(aRowSheetParam);

end;

procedure TUARequestDataInPacket.ClearAllUaData;
begin

  FRowSheetList.Clear;
  FDataSheetList.Clear;
  FMasterLinkList.Clear;
  FRequestDataList.Clear;
  FAnyParam.Clear;

end;


function TUARequestDataInPacket.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 TUARequestDataInPacket.CountDataSheet(index: integer): integer;
//var
//  aList: TObjectList;
begin
  if index=-1 then
    result := FDataSheetList.Count
  else
    result := -1

end;

function TUARequestDataInPacket.CountMasterLink(index: integer): integer;
//var
//  aList: TObjectList;
begin
  if index=-1 then
    result := FMasterLinkList.Count
  else
    result := -1

end;

function TUARequestDataInPacket.CountRequestData(index: integer): integer;
//var
//  aList: TObjectList;
begin
  if index=-1 then
    result := FRequestDataList.Count
  else
    result := -1

end;

function TUARequestDataInPacket.CountRowSheet(index: integer): integer;
//var
//  aList: TObjectList;
begin
  if index=-1 then
    result := FRowSheetList.Count
  else
    result := -1
end;

constructor TUARequestDataInPacket.Create;
begin