uaserviceadapter.pas

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

end;

procedure TUAServiceAdapter.Update(const SrvObjName,ServiceName: WideString;
  DataIn: OleVariant; var DataOut: OleVariant);
var
  sErrorCode:string;

begin

  if not Connected  then
    Connected := true;
  try
    if Connected  = true then
    begin
       try
         OleObject.Update(SrvObjName,ServiceName,DataIn,DataOut);
       except
         on E:Exception do
            begin
              sErrorCode := '-31002';
              Showmessage('error code is:'+sErrorCode + #13#10 +'error detail :'+
                          '[Remote Service Adapter Error]'+#13 + 'Native Error Information :'+ E.Message);
            end;
       end;
    end;
  finally
  end;

end;

procedure TUAServiceAdapter.SetAddress(const Value: string);
begin
  if Pos('.', Value) > 0 then
      FSckt.Address := Value
  else
      FSckt.Host := Value;
end;

procedure TUAServiceAdapter.SetDispatchObject(const Value: IDispatch);
begin
  if Value = nil then SetOleObject(Null);
end;

procedure TUAServiceAdapter.SetIntercept(const Value: string);
begin
  {$ifdef Ver140}
  if (Length(Value) > 0) and (Value[1] = '{') then
      FSckt.InterceptGUID := Value
  else
      FSckt.InterceptName := Value;
  {$else}
  if (Length(Value) > 0) and (Value[1] = '{') then
      FSckt.InterceptGUID := Value;
  {$endif}
end;

procedure TUAServiceAdapter.SetOleObject(const Value: Variant);
begin

  FOleObject := Value;
//  if VarType(Value) <= varNull then
//      FSckt.Connected := false;

end;

procedure TUAServiceAdapter.SetPort(const Value: integer);
begin
  if Trim(IntToStr(Value))<>'' then
    FSckt.Port := Value
  else
    FSckt.Port := 211;  //default Port
end;

procedure TUAServiceAdapter.SetServer(const Value: string);
begin
  if (Length(Value) > 0) and (Value[1] = '{') then
      FSckt.ServerGUID := Value
  else
      FSckt.ServerName := Value;
end;


procedure TUAServiceAdapter.DoConnect;
begin
  try
    try
      if FSckt.Connected = false then
       FSckt.Connected := true;
      FConnected := true;
      OleObject := FSckt.AppServer;
    except
      on E:Exception do
         begin
           Showmessage('[ Socket Connect Internal Error ]'+#13 + 'Native Error Information:'+ E.Message);
           FConnected := false;
         end;
    end;
  finally
//    Result := FConnected;
  end;
end;

function TUAServiceAdapter.DoDisConnect: Boolean;
begin

  Result := false;
  try
    try
      if FSckt.Connected then
      begin
        FSckt.Connected := false;
        FConnected := false;
        OleObject := varNull;
        Result := true;
      end;
    except
      on E:Exception do
         begin
           Result := false;
           FConnected := false;
           Showmessage('[Socket DisConnect Internal Error]'+#13 + 'Native Error Information :'+ E.Message);
         end;
    end;
  finally

  end;

end;

function TUAServiceAdapter.GetTryConnectTimes: LongInt;
begin
  Result := FTryConnectTimes;
end;

function TUAServiceAdapter.GetWaitTimes: Cardinal;
begin
  Result := FWaitTimes;
end;

procedure TUAServiceAdapter.SetTryConnectTimes(const Value: LongInt);
begin
  FTryConnectTimes := Value;
end;

procedure TUAServiceAdapter.SetWaitTimes(const Value: Cardinal);
begin
  FWaitTimes := Value;
end;

procedure TUAServiceAdapter.SetConnected(const Value: Boolean);
begin
  if Value then
  begin
    if Connected then Exit
    else
      DoConnect ;
  end
  else
  begin
    if not Connected then Exit
    else
      DoDisConnect;
  end;
end;

procedure TUAServiceAdapter.Loaded;
begin
 inherited;
end;




function TUAServiceAdapter.GetConnected: Boolean;
begin
  Result := FConnected;
end;


procedure TUAServiceAdapter.SetDataPacketEncrypt(const Value: Boolean);
begin
  FDataPacketEncrypt := Value;
end;

procedure TUAServiceAdapter.SetCompressType(const Value: TCompressType);
begin
  FCompressType := Value;
end;

function TUAServiceAdapter.ReadClientSetting(Sender: TComponent):Boolean;
var
  Reg: TRegINIFile;
  Sections: TStringList;
//  IsCurr:Boolean;
begin
{$define uaDebug}
//  IsCurr := false;
  Reg := TRegINIFile.Create('');
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(KEY_UA_Client, True);
    Sections := TStringList.Create;
    try
      Reg.ReadSections(Sections);
     if Sections.Count <> 0 then
     begin
        Address := Reg.ReadString(csSettings,ckIP,'127.0.0.1');
        {$ifdef uaDebug}
        Server := 'JTServiceSrv.JtService';
        {$else}
        Server := Server;
        {$endif}
        Port := Reg.ReadInteger(csSettings,ckPort,211);
        WaitTimes:= Reg.ReadInteger(csSettings,ckWaitTimes,3000);
        TryConnectTimes := Reg.ReadInteger(csSettings,ckTryConnectTimes,1);
        IsLocalNet := Reg.ReadBool(csSettings,ckIsLocalNet,false);
        Result := true;
     end
     else
     begin
       Result := false;
//       ExecuteNetworkSetting(Self);
     end;
    finally
      Sections.Free;
    end;
  finally
    Reg.Free;
  end;

end;

procedure TUAServiceAdapter.SetIsLocalNet(const Value: Boolean);
begin
  FIsLocalNet := Value;
end;

function TUAServiceAdapter.ExecuteNetworkSetting(Sender: TComponent): Boolean;
begin
  Result := ShowNetworkSetting(Sender);
end;


function TUAServiceAdapter.GetDataPacketType: TDataPacketType;
begin
  Result := FDataPacketType;
end;

procedure TUAServiceAdapter.SetDataPacketType(
  const Value: TDataPacketType);
begin
  FDataPacketType := Value;
end;


function TUAServiceAdapter.GetSiteId: integer;
begin
  Result := FSiteId;
end;


procedure TUAServiceAdapter.SetDefaultDBName(const Value: string);
begin
  FDefaultDBName := Value;
end;

procedure TUAServiceAdapter.SetActiveDBName(const Value: string);
begin
  FActiveDBName := Value;
end;

initialization


finalization



end.