Export Netvibes (source)

De Wiki1000

Cette procédure construit le Widget Netvibes :

const
  netvibes_widget=
'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'#13#10+
'<html xmlns="http://www.w3.org/1999/xhtml" xmlns:widget="http://www.netvibes.com/ns/">'#13#10+
'<head>'#13#10+
'<title>Sage France</title>'#13#10+
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'#13#10+
'<meta name="author" content="Sage France" />'#13#10+
'<meta name="description" content="" />'#13#10+
'<meta name="apiVersion" content="1.0" />'#13#10+
'<meta name="debugMode" content="false" />'#13#10+
'<widget:preferences>'#13#10+
'</widget:preferences>'#13#10+
//'<link rel="stylesheet" type="text/css" href="http://www.netvibes.com/themes/uwa/style.css"/>'#13#10+
//'<script type="text/javascript" src="http://www.netvibes.com/js/UWA/load.js.php?env=Standalone">$BUG</script>'#13#10+
'<script type="text/javascript">'#13#10+
'<![CDATA['#13#10+
'var SageUTILS={};'#13#10+
'SageUTILS.setFrameProperties=function(f) {'#13#10+
'  f.border="0"; f.frameBorder="0"; f.scrolling="no";'#13#10+
'  with (f.style) { border="0px"; margin="0px"; padding="0px"; width="100%"; display="block";}'#13#10+
'};'#13#10+
'SageUTILS.extractInt=function(s) {'#13#10+
'   if (!(s) ||  (s =="")) return "";'#13#10+
'   var i=s.indexOf("%");'#13#10+
'   if (i > 0) return "";'#13#10+
'   i=s.indexOf("px");'#13#10+
'   if (i > 0) s=s.substr(0, i);'#13#10+
'   return s;'#13#10+
'};'#13#10+
'SageUTILS.createFrameContent=function() {'#13#10+
'  var f=widget.createElement("iframe");'#13#10+
'  f.id="frame_"+widget.id;'#13#10+
'  var s=SageUTILS.extractInt(widget.getValue("height"));'#13#10+
'  SageUTILS.setFrameProperties(f);'#13#10+
'  if (s !="") {f.height=s; f.style.height=s+"px";}'#13#10+
'  widget.setBody(f);'#13#10+
'  var fsrc="$URL"$URLPARAMS;'#13#10+
'  fsrc=fsrc+"&rfid="+widget.id;'#13#10+
'  f.src=fsrc;'#13#10+
'};'#13#10+
'widget.onLoad=function() {'#13#10+
'  SageUTILS.createFrameContent();'#13#10+
'};'#13#10+
'//]]>'#13#10+
'</script>'#13#10+
'</head>'#13#10+
'<body>'#13#10+
'  <p>Sage Module is loading ...</p>'#13#10+
'</body>'#13#10+
'</html>';
 
class procedure TXMLRpcPortalServer.createNetvibesParams(iSender, iTarget: Tobject; var iStrParams: String; var index: integer);
var p: TxmlItem;  param: TModuleParam; itm, ci, ni: TxmlItem;
    var s1, s2, s3: String; idy: integer;
begin
  p := TxmlItem(iTarget);
  param := TModuleParam(iSender);
  if not TXMLRpcPortalServer.canShowParam(param, true) then Exit;
  s1 := Format('+"&p[%d].name=%s"',[index, THtmlUtility.HTTPEncode(param.ParamName)]);
  s2 := Format('+"&p[%d].value="+encodeURIComponent(widget.getValue("%s"))', [index, THtmlUtility.HTTPEncode(param.ParamName)]);
  s3 := '';
  //tjBoolean, tjNumber, tjDateTime,, tjEnum, tjObject, tjArray
  if (param.ParamType = tjString) or (param.ParamType = tjInt)
    or (param.ParamType = tjNumber) or (param.ParamType = tjMemo)
    or (param.ParamType = tjDateTime) or (param.ParamType = tjObject)
    or (param.ParamType = tjArray)or (param.Title = '') or (param.ParamType = tjBoolean)
  then
  begin
    itm := TxmlItem.Create(p,'preference');
    itm.AttributesValue['name']:=param.ParamName;
    if( param.Title = '') or  not TXMLRpcPortalServer.canShowParam(param, false)  then
    begin
      itm.AttributesValue['type']:='hidden';
    end else
    begin
      if param.ParamType = tjBoolean then
        itm.AttributesValue['type']:='boolean'
      else
        itm.AttributesValue['type']:='text';
    end;
    itm.AttributesValue['defaultValue']:=param.ParamValue;
  end else if (param.ParamType = tjEnum) then
  begin
    itm := TxmlItem.Create(p,'preference');
    itm.AttributesValue['name']:=param.ParamName;
    itm.AttributesValue['type']:='list';
    itm.AttributesValue['label']:=param.Title;
    itm.AttributesValue['defaultValue']:=param.ParamValue;
    for idy := 0 to param.Count - 1 do
    begin
      ci := param[idy];
      if SameText(ci.ItemName, 'enum') then
      begin
        ni := TxmlItem.Create(itm, 'option');
        ni.AddAttribute('value', ci.AttributesValue['value']);
        ni.AddAttribute('label', ci.AttributesValue['display']);
      end;
    end;
  end;
  if (param.ParamType = tjBoolean) then
    s3 := Format('+"&p[%d].paramtype=bool"', [Index])
  else if (param.ParamType = tjInt) then
    s3 := Format('+"&p[%d].paramtype=int"', [Index]);
  iStrParams := iStrParams + s1 + s2 + s3;
  inc(Index);
end;
 
class function TXMLRpcPortalServer.ProduceNetvibesModule(iRequest: TXmlRpcCall;
  iHttpRequest: TxmlDocument; var info: String;
  iFormat: TXmlResponseFormatType): TObject;
var
  doc : TxmlDocument; iResInfo: TXmlWebResponseInfo;
  iurl, ititle, s: String;
  modid, iconfirm: String;
  iapp: TApplicationItem; m: TModuleItem;
  iroot, itm, pref: TxmlItem;
  idx, index : integer; isError, igetURL:boolean;
  mn: String; ss : TxmlRpcStruct;
  canConfirm: boolean;   ph: TModuleParam;
begin
  iconfirm := '';
  canConfirm:= true;
  isError := false;
  Result := nil;
  ititle := _TP('Sage Module');
  modid := ExtractParamByName(iRequest, 'id');
  iurl := ExtractParamByName(iRequest, 'url');
  igetURL := ExtractParamByName(iRequest, 'export') ='1' ;
  if iurl = '' then iurl := 'http://www.sage.fr';
  if iurl[length(iurl)] <> '/' then iurl := iurl + '/';
  iurl := iurl + Format('%s/%s/%s/%s.%s?netvibes=1', [c_l1000_root_server,c_xmlrpc_action, TXmlRpcUtility.ResponseFormatToString(rREST),c_rest_service_portal,c_rest_service_standalone]);
  iapp := TPortalDocument(UserContexts.CurrentUser.UserPortal).Application;
  m := iapp.FindModule(modid);
  mn := 'emptymodule';
  if Assigned(m) then
  begin
    ititle := m.Title;
    iurl := iurl + '&modtype=' + m.ModType;
    mn:=m.ModType;
    ph := m.FindParamByName('height');
    if Assigned(ph) then canConfirm := false;
  end;
  doc := TxmlDocument.Create(nil);
  doc.Encoding := cstUTF8Encoding;
  iResInfo := TXmlWebResponseInfo.Create(nil);
  try
    doc.LoadfromString(StringReplace(netvibes_widget, '$URL', iurl, []));
    iurl := '';
    if Assigned(m) then
    begin
      iroot := doc.DocumentElement;
      iroot := iroot.FindSelfItem('head');
      pref := iroot.FindSelfItem('title');
      if Assigned(pref) then pref.text:=ititle;
      pref := nil;
      if Assigned(iroot) then
          pref := iroot.FindSelfItem('widget:preferences');
      if Assigned(pref) then
      begin
        index := 0;
        m.EnumParams(pref,createNetvibesParams, iurl, index);
      end;
    end;
    iroot := doc.DocumentElement;
    iroot := iroot.FindSelfItem('head');
    for idx := 0 to iroot.Count - 1 do
    begin
      itm := iroot.Items[idx];
      if SameText(itm.ItemName, 'script') and (itm.AttributesValue['src']='') then
      begin
        s := itm.Text;
        s := StringReplace(s, '$URLPARAMS', iurl, []);
        itm.Text := #13#10'//';
        itm.AddCData(s);
        itm.AddText(#13#10);
      end;
    end;
    doc.FormatOptions := doc.FormatOptions + [xfoOmitXMLDeclaration, xfoUTF8];
    s :=StringReplace(doc.SaveToString, '$BUG', '', []);
    s :=StringReplace(s, '//<![CDATA[', '', []);
    s := StringReplace(s, '//]]>', '', []);
 
    Result := TStringStream.Create(s);
    if (igetURL) then
    begin
      try
        mn := StringReplace(mn, '-', '', [rfReplaceAll]);
        mn := StringReplace(mn, '.', '', [rfReplaceAll]);
        iurl := TExportUtility.ExportFile(TStream(Result), mn+FormatDateTime('yyyymmddhhmmssnn', Now())+'.html');
      except
        isError := true;
      end;
      FreeAndNil(Result);
      if isError or (iurl='') then
      begin
        s := ExtractParamByName(iRequest, 'url');
        if s='' then s:='/';
        if s[length(s)] <> '/' then s := s + '/';
        iurl := s + Format('%s/%s/%s/%s.%s?id=%s&url=%s', [c_l1000_root_server,c_xmlrpc_action,
          TXmlRpcUtility.ResponseFormatToString(rREST),c_rest_service_portal,
          'netvibes', modid ,THtmlUtility.HTTPEncode(s)]);
      end else
      begin
        if canConfirm then iconfirm := Format(_TP('Ajoutez un "UWA widget" vide, cochez "Inline this widget" et%s mettez "Widget URL":'),[#13#10]);
      end;
      Result := TXmlRpcResult.Create(nil);
      ss:=TXmlRpcResult(Result).Params.AddStruct;
      ss.AddString('URI', iurl);
      ss.AddString('confirm', iconfirm);
    end else
    begin
      iResInfo.AddHeader('date', LocalDateTimeToGMT(Now()));
      iResInfo.AddHeader('expires', LocalDateTimeToGMT(Now()));
      iResInfo.AddResponse('content_type',c_utf8_html_type);
      iResInfo.AddResponse('bin_stream', '1');
      FreeAndNil(doc);
    end
  finally
     FreeAndNil(doc);
     if Assigned(iResInfo.DocumentElement) then info := iResInfo.SaveToString;
     FreeAndnil(iResInfo);
  end;
end;

Développement DSM

Outils personnels