Componentes.Terceros.RemObjects/official/5.0.35.741/RemObjects SDK for Delphi/Source/uROHtmlServerInfo.pas

unit uROHtmlServerInfo;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

interface

uses
  {$IFDEF FPC}LResources,{$ENDIF}
  uRODLToXML, uRODL, uROServer, {uROClasses, }SysUtils, Classes;


function GetResourceAsString(aName: string): Ansistring;
function GetRodlServerInfo(const RootUrl: string; aRodl: TRODLLibrary; aDispatchers: TROMessageDispatchers): Ansistring;
function GetRodlStyleSheet: Ansistring;
function GetRodlWithStyleSheet(aRodl: TRODLLibrary; aStyleSheetUrl: string): AnsiString;
procedure GetRodlFavIcon(dest: TStream);
function GetRodlCss: Ansistring;
function GetVersion: string;

implementation

uses
  {$IFDEF MSWINDOWS}Windows, {$ENDIF}
  uROHTTPDispatch;

{$IFNDEF FPC}
{$R uROHtmlServerInfo.res}
{$ENDIF}

type
  TVersion = record
    Major : word;
    Minor : word;
    Release : word;
    Build : word;
  end;


function GetResourceAsString(aName: string): Ansistring;
var
  lRes: TResourceStream;
begin
  lRes := TResourceStream.Create(HInstance, aName, RT_RCDATA);
  try
    SetLength(Result, lRes.Size);
    lRes.Read(pointer(Result)^, Length(Result));
  finally
    lRes.Free;
  end;
end;

function GetRodlCss: Ansistring;
begin
  result := GetResourceAsString('RemObjectsHtmlServerDocumentationCss');
end;

function GetRodlWithStyleSheet(
  aRodl: TRODLLibrary; aStyleSheetUrl: string): AnsiString;
var
  lRodlToXml: TRODLToXML;
begin
  lRodlToXml := TRODLToXML.Create(nil, '');
  try
    lRodlToXml.StyleSheet := aStyleSheetUrl;
    lRodlToXml.Convert(aRodl);
    Result := {$IFDEF UNICODE}UTF8Encode{$ENDIF} (lRodlToXml.Buffer.Text);
  finally
    lRodlToXml.Free;
  end;
end;

function GetRodlServerInfo(const RootUrl: string; aRodl: TRODLLibrary; aDispatchers: TROMessageDispatchers): Ansistring;
var
  lUrl, lPath, s, r: string;
  i: Integer;
begin
  s := '';
  lUrl := RootUrl;
  if lUrl = '' then lUrl := '/' else
  if lUrl[Length(lUrl)] <> '/' then lUrl := lUrl + '/';


  R := {$IFDEF UNICODE}UTF8ToString{$ENDIF} (GetResourceAsString('RemObjectsHtmlServerInfo'));
  R := StringReplace(R, '%BASEPATH%', lUrl, [rfReplaceall]);
  R := StringReplace(R, '%NAME%', aRodl.Name, [rfReplaceall]);
  R := StringReplace(R, '%DOC%', aRodl.Documentation, [rfReplaceall]);

  for i := 0 to aDispatchers.Count -1 do
  begin
    lPath := TROHTTPDispatcher(aDispatchers[i]).PathInfo;
    if lPath = '' then continue;
    if lPath[1] = '/' then Delete(lPath, 1, 1);
    s := s + '<li><a href="' + lUrl + lPath	 + '">' +
      lPath + '</a> <i>(' + aDispatchers[i].Message.ClassName +
      ')</i></li>';
  end;

  R := StringReplace(R, '%DISPATCHERS%', s, [rfReplaceall]);
  R := StringReplace(R, '%RO%', GetVersion(), [rfReplaceall]);

  Result := {$IFDEF UNICODE}UTF8Encode{$ENDIF}(R);
end;

function GetRodlStyleSheet: Ansistring;
begin
  Result := GetResourceAsString('RemObjectsHtmlServerDocumentation');
end;

procedure GetRodlFavIcon(dest: TStream);
var
  fs: TResourceStream;
begin
  fs := TResourceStream.Create(HInstance, 'RemObjectsHtmlIcon', RT_RCDATA);
  try
    dest.CopyFrom(fs, fs.Size);
  finally
    fs.Free;
  end;
end;

{$IFDEF MSWINDOWS}
function GetFileVer(iFileName: string):TVersion;
var whocares:dword;
    Size:dword;
    Data:pointer;
    FixedData:pVSFixedFileInfo;
begin
  whocares:=0;
  {$IFDEF FPC}
  Data := nil;
  {$ENDIF FPC}  
  FixedData := nil;
  Size := GetFileVersionInfoSize(pChar(iFileName), whocares);
  if Size > 0 then begin
    GetMem(Data,Size);
    try
      if GetFileVersionInfo(pChar(iFileName),0,Size,Data) then begin
        Size := sizeof(TVSFixedFileInfo);
        if VerQueryValue(Data,'\',pointer(FixedData),Size) then begin
          result.Major := HiWord(FixedData^.dwFileVersionMS);
          result.Minor := LoWord(FixedData^.dwFileVersionMS);
          result.Release := HiWord(FixedData^.dwFileVersionLS);
          result.Build := LoWord(FixedData^.dwFileVersionLS);
        end;
      end;
    finally
      FreeMem(Data);
    end;
  end;
end;
{$ENDIF}

function GetVersion:string;
{$IFDEF MSWINDOWS}
var
  Version:TVersion;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  {$IFDEF FPC}
   Version := GetFileVer(ParamStr(0));
  {$ELSE}
   Version := GetFileVer(GetModuleName(hInstance));
  {$ENDIF}
   result := 'v' + IntToStr(Version.Major)+'.'+IntToStr(Version.Minor)+'.'+
             IntToStr(Version.Release)+'.'+IntToStr(Version.Build);
{$ELSE}
  Result:='';
{$ENDIF}
end;

{$IFDEF FPC}
initialization
  {$I uROHtmlServerInfo.lrs}
{$ENDIF FPC}
end.