Componentes.Terceros.RemObjects/internal/5.0.23.613/1/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
  uRODL, uRODLToXML, uROServer, uROClasses, SysUtils, Classes;


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

implementation
uses
  uROHTTPDispatch
  {$IFDEF MSWINDOWS},Windows, ShellAPI {$ENDIF}
     {$IFDEF LINUX},Types, Libc {$ENDIF};

{$R uROHtmlServerInfo.res}

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


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

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

function GetRodlWithStyleSheet(
  aRodl: TRODLLibrary; aStyleSheetUrl: string): String;
var
  lRodlToXml: TRODLToXML;
begin
  lRodlToXml := TRODLToXML.Create(nil,'');
  try
    lRodlToXml.StyleSheet := aStyleSheetUrl;
    lRodlToXml.Convert(aRodl);
    Result := lRodlToXml.Buffer.Text;
  finally
    lRodlToXml.Free;
  end;
end;

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


  Result := GetResourceAsString('RemObjectsHtmlServerInfo');
  Result := StringReplace(Result, '%BASEPATH%', lUrl, [rfReplaceall]);
  Result := StringReplace(Result, '%NAME%', aRodl.Name, [rfReplaceall]);
  Result := StringReplace(Result, '%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;

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

end;

function GetRodlStyleSheet: string;
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;

{$IFNDEF LINUX}
function GetFileVer(iFileName: string):TVersion;
var whocares:dword;
    Size:dword;
    Data:pointer;
    FixedData:pVSFixedFileInfo;
begin
  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 LINUX}

function GetVersion:string;
{$IFNDEF LINUX}
var
  Version:TVersion;
{$ENDIF LINUX}
begin
{$IFNDEF LINUX}
  {$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;

end.