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;