unit uROIDETools;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Delphi IDE Integration
{
{ compiler: Delphi 5 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.
{----------------------------------------------------------------------------}

{$IFDEF LINUX}
{$I ../RemObjects.inc}
{$ELSE}
{$I ..\RemObjects.inc}
{$ENDIF LINUX}

interface

uses Classes, ToolsAPI, Contnrs, Windows, uRODLConvertersUtils;

const
  MaxSourceSize = 10000;

  kw_RODLGenerationDelphi = '{#ROGEN';
  kw_RODLGenerationCpp    = '//#ROGEN';

type { TIDEMessage }
  TIDEMessageType = (mInfo, mError, mWarning);

  TIDEMessage = class
  private
    fMessageType: TIDEMessageType;
    fFileName,
      fMessageStr,
      fPrefixStr: string;

  public
    constructor Create(aMessageType: TIDEMessageType;
      const aMessageStr: string;
      const aFileName: string = '';
      const aPrefixStr: string = '');

    property MessageType: TIDEMessageType read fMessageType;
    property FileName: string read fFileName;
    property MessageStr: string read fMessageStr;
    property PrefixStr: string read fPrefixStr;
  end;

  { TIDEMessageList }
  TIDEMessageList = class(TObjectList)
  private
    fPrefixStr: string;

    function GetItems(Index: integer): TIDEMessage;

  public
    constructor Create(const aPrefixStr: string);
    destructor Destroy; override;

    procedure ClearMessages;
    procedure Add(aMessageType: TIDEMessageType;
      const aMessageStr: string;
      const aFileName: string = '';
      const aPrefixStr: string = '');

    procedure FlushMessages;

    property Items[Index: integer]: TIDEMessage read GetItems; default;
  end;

// Service access helpers
function ModuleServices: IOTAModuleServices;
function CurrentProject: IOTAProject;
function MessageServices: IOTAMessageServices;
function Services: IOTAServices;
function ActionServices: IOTAActionServices;

//  Module helpers
function ModuleFileName(const aModule: IOTAModule): string;
function ModuleDir(const aModule: IOTAModule): string;
function ModuleSourceSize(const aModule: IOTAModule): integer;

// Project helpers

function CodeGenLanuageFromProjectPersonality(aProject: IOTAProject): TROCodeGenLanguage;

function FindModule(const aProject: IOTAProject; const aModuleName: string): IOTAModule;
function FindModuleByUnitName(const aProject: IOTAProject; const aModuleName: string): IOTAModule;
function GenerateRESFromRODL(const RODLFileName: string; aMessageList: TIDEMessageList): boolean;
function ExtractRODLFileName(const Source: string): string; // Only returns the file name specified in the dpr file

function FindFirstRodlProject: IOTAProject;
function ProjectIsRodlProject(aProject: IOTAProject):boolean;
function ConvertProjectToRoServer(aProject: IOTAProject):boolean;

function ExecuteAndWait(const aApp, aCmdLine:string; aWait:boolean=true):dword;

function GetServiceBuilderPath: string;
procedure LaunchServiceBuilder(const aProjectName, aParams: string; aWait:boolean=false);
procedure LaunchServiceBuilderForCurrentProject(const aAdditionalParameters:string; aOnlyLaunchForROServer:boolean=false; aWait:boolean=false);

procedure LaunchServiceTester;

function GetTemplateDir: string;
function GetBinDir: string;
function GetTemplateConfigFileName : string;
function GetTemplateOptionsFileName : string;

procedure CompileProject;
function GetProjectExe(aProject: IOTAProject): string;

implementation

uses SysUtils, Dialogs, ShellAPI, Controls, uRORes, {$IFDEF LINUX}
  fCustomIDEMessagesFormKylix, {$ELSE}
  fCustomIDEMessagesForm, {$ENDIF}uROResWriter, Forms, uROClasses, Registry,
  uEWMenuManager, uEWOTAHelpers;

function GetProjectExe(aProject: IOTAProject): string;
var
  dirname: string;
begin
  ChDir(ExtractFilePath(aProject.FileName));

  dirname := Trim(aProject.ProjectOptions.Values['OutputDir']);
  if (dirname='') then begin
    dirname := ExtractFilePath(aProject.FileName)
  end
  else begin
    // Checks for relative paths
    if (dirname[1]='.') then dirname := ExtractFilePath(aProject.FileName)+dirname;
  end;

  result := IncludeTrailingPathDelimiter(dirname)+ChangeFileExt(ExtractFileName(aProject.FileName), '.exe');
end;

// Service access helpers

function CodeGenLanuageFromProjectPersonality(aProject: IOTAProject): TROCodeGenLanguage;
begin
  {$IFDEF DELPHI9UP}
  if aProject.Personality = sPersonalityDelphiWin32 then
    result := cglDelphiWin32
  else if aProject.Personality = sPersonalityCppBuilderWin32 then
    result := cglCppWin32
  else
    raise Exception.Create('Unsupported project type '+aProject.Personality);
  {$ELSE}
  result := cglDelphiWin32
  {$ENDIF}
end;

function ModuleServices: IOTAModuleServices;
begin
  result := (BorlandIDEServices as IOTAModuleServices);
end;

function CurrentProject: IOTAProject;
var
  services: IOTAModuleServices;
  module: IOTAModule;
  project: IOTAProject;
  projectgroup: IOTAProjectGroup;
  multipleprojects: Boolean;
  i: Integer;
begin
  result := nil;

  multipleprojects := False;
  services := ModuleServices;

  if (services = nil) then Exit;

  for I := 0 to (services.ModuleCount - 1) do begin
    module := services.Modules[I];
    if (module.QueryInterface(IOTAProjectGroup, ProjectGroup) = S_OK) then begin
      result := ProjectGroup.ActiveProject;
      Exit;
    end

    else if module.QueryInterface(IOTAProject, Project) = S_OK then begin
      if (result = nil) then
        result := Project // Found the first project, so save it
      else
        multipleprojects := True; // It doesn't look good, but keep searching for a project group
    end;
  end;

  if multipleprojects then result := nil;
end;

function MessageServices: IOTAMessageServices;
begin
  result := (BorlandIDEServices as IOTAMessageServices);
end;

function Services: IOTAServices;
begin
  result := (BorlandIDEServices as IOTAServices);
end;

function ActionServices: IOTAActionServices;
begin
  result := (BorlandIDEServices as IOTAActionServices)
end;

//  Module helpers

function ModuleFileName(const aModule: IOTAModule): string;
begin
  result := aModule.FileName;
  { AleF: removed for Delphi5
  result := '';

  with aModule do
    for i := 0 to ModuleFileCount-1 do
      if Supports(ModuleFileEditors[i], IOTASourceEditor, editor) then begin
        result := editor.FileName;
        Exit;
      end;}
end;

function ModuleDir(const aModule: IOTAModule): string;
begin
  result := IncludeTrailingBackslash(ExtractFilePath(ModuleFileName(aModule)))
end;

function ModuleSourceSize(const aModule: IOTAModule): integer;
begin
  result := Length(ReadModuleSource(aModule));
end;

{ TIDEMessageList }

{$IFDEF DELPHI7UP}

procedure TIDEMessageList.Add(aMessageType: TIDEMessageType;
  const aMessageStr: string;
  const aFileName: string = '';
  const aPrefixStr: string = '');
var
  lGroup: IOTAMessageGroup;
  lDummyLineRef: pointer;
  lPrefix: string;
begin
  with BorlandIDEServices as IOTAMessageServices60 do begin
    lGroup := GetGroup(str_ProductName);
    if not Assigned(lGroup) then lGroup := AddMessageGroup(str_ProductName);

    lPrefix := aPrefixStr;
    if lPrefix = '' then lPrefix := 'Note';
    AddToolMessage(aFilename, aMessageStr, lPrefix, -1, -1, nil, lDummyLineRef, lGroup);
  end; { with }
end;
{$ELSE}

procedure TIDEMessageList.Add(aMessageType: TIDEMessageType;
  const aMessageStr: string;
  const aFileName: string = '';
  const aPrefixStr: string = '');
var
  msg: TIDEMessage;
begin
  msg := TIDEMessage.Create(aMessageType, aMessageStr, aFileName, aPrefixStr);
  inherited Add(msg);
end;
{$ENDIF}

procedure TIDEMessageList.ClearMessages;
{$IFDEF DELPHI7UP}
var
  lGroup: IOTAMessageGroup;
begin
  with BorlandIDEServices as IOTAMessageServices60 do begin
    lGroup := GetGroup(str_ProductName);
    if not Assigned(lGroup) then lGroup := AddMessageGroup(str_ProductName);
    RemoveMessageGroup(lGroup);
  end;
end;
{$ELSE}
begin
end;
{$ENDIF}

constructor TIDEMessageList.Create(const aPrefixStr: string);
begin
  inherited Create;
  fPrefixStr := aPrefixStr;
end;

destructor TIDEMessageList.Destroy;
begin
  inherited;
end;

procedure TIDEMessageList.FlushMessages;
begin
  {$IFNDEF DELPHI7UP}
  IDEMessageForm.FillList(Self);
  Clear;
  {$ENDIF DELPHI7UP}
end;

// Project helpers

function FindModule(const aProject: IOTAProject; const aModuleName: string): IOTAModule;
var
  i: integer;
begin
  result := nil;
  for i := 0 to aProject.GetModuleCount - 1 do
    if (CompareText(aModuleName, aProject.GetModule(i).FileName) = 0) then begin
      result := aProject.GetModule(i).OpenModule;
      Exit;
    end;
end;

function FindModuleByUnitName(const aProject: IOTAProject; const aModuleName: string): IOTAModule;
var
  i: integer;
begin
  result := nil;
  for i := 0 to aProject.GetModuleCount - 1 do
    if (CompareText(ExtractFileName(aModuleName), ExtractFileName(aProject.GetModule(i).FileName)) = 0) then begin
      result := aProject.GetModule(i).OpenModule;
      Exit;
    end;
end;

function TIDEMessageList.GetItems(Index: integer): TIDEMessage;
begin
  result := TIDEMessage(inherited Items[Index]);
end;

{ TIDEMessage }

constructor TIDEMessage.Create(aMessageType: TIDEMessageType;
  const aMessageStr, aFileName, aPrefixStr: string);
begin
  fMessageType := aMessageType;
  fMessageStr := aMessageStr;
  fFileName := aFileName;
  fPrefixStr := aPrefixStr;
end;

// File names helpers

function ExtractRODLFileName(const Source: string): string;
var
  src: string;
  i, lNameStartIndex, idx: integer;
begin
  result := '';
  
  src := UpperCase(Source);
  idx := Pos(kw_RODLGenerationDelphi, src);
  if idx = 0 then idx := Pos(kw_RODLGenerationCpp, src); // allow C++-style comment in Delphi, too
  if idx = 0 then exit;

  lNameStartIndex := 0;

  for i := idx to Length(src) do begin
    case src[i] of
      ':': if (lNameStartIndex = 0) then lNameStartIndex := i + 1;
      '}',#13, #10, '|': begin
          if lNameStartIndex = 0 then
            raise Exception.Create('Invalid #ROGEN directive, RODL filename not spcified.');
          result := Trim(Copy(Source, lNameStartIndex, i-lNameStartIndex));
          break;
        end;

    end;
  end;
end;

function FindFirstRodlProject: IOTAProject;
var
  i: integer;
  lServices: IOTAModuleServices;
  lProject: IOTAProject;
begin
  result := nil;

  lServices := ModuleServices;

  if (lServices = nil) then Exit;

  for i := 0 to (lServices.ModuleCount - 1) do begin
    if lServices.Modules[i].QueryInterface(IOTAProject, lProject) = S_OK then begin
      if ProjectIsRodlProject(lProject) then begin
        result := lProject;
        exit;
      end;
    end;
  end;
end;

function ProjectIsRodlProject(aProject: IOTAProject):boolean;
var
  lSource:string;
begin
  result := false;
  if Assigned(aProject) then begin
    lSource := ReadModuleSource(aProject);
    result := ExtractRODLFileName(lSource) <> '';
  end;
end;

function ConvertProjectToRoServer(aProject: IOTAProject):boolean;
var
  lSource, lUsesClause: string;
  lUsesStarts, lUsesEnds: Integer;
begin
  result := false;
  if Assigned(aProject) and not ProjectIsRodlProject(aProject) then begin

    lSource := ReadModuleSource(aProject);

    case CodeGenLanuageFromProjectPersonality(aProject) of
      cglDelphiWin32: begin
          lSource := StringReplace(lSource, 'uses',
            'uses'#13#10+
            '  uROCOMInit,',
          [rfIgnoreCase]);

          lUsesStarts := Pos('uses', lSource);
          lUsesEnds := Pos(';', Copy(lSource, lUsesStarts, Length(lSource) - lUsesStarts));
          lUsesClause := Copy(lSource, lUsesStarts, lUsesEnds);

          lSource := StringReplace(lSource, lUsesClause, lUsesClause + #13#10#13#10 +
            '{#ROGEN:' + ExtractFileName(ChangeFileExt(aProject.FileName,'.rodl'))+'} // RemObjects: Careful, do not remove!'#13#10+
            '{$R RODLFile.res}',
          [rfIgnoreCase]);
        end;

      cglCppWin32: begin
          Insert('#include <uROCOMInit.hpp>'#13#10, lSource, Pos('#include', lSource));

          lSource := StringReplace(lSource,'#pragma hdrstop',
            '#pragma hdrstop'#13#10+
            '//#ROGEN:'+ExtractFileName(ChangeFileExt(aProject.FileName,'.rodl'))+' | RemObjects: Careful, do not remove!'#13#10+
            '#pragma resource "RODLFile.res"',
          [rfIgnoreCase]);
        end;

    end;
    result := true;
    WriteModuleSource(aProject,lSource, '');
  end;
end;

function ReadRegistryValue(aBaseKey:HKEY; aPath:string; aName:string; aDefault:string=''):string;
begin
  with TRegistry.Create(KEY_READ) do try
    RootKey := aBaseKey;
    if OpenKey(aPath, False) then
      if ValueExists(aName) then
        result := ReadString(aName)
      else
        result := aDefault;
  finally
    Free;
  end;
end;

function GetServiceBuilderPath: string;
var reg: TRegIniFile;
begin
  reg := TRegIniFile.Create('Software\RemObjects\RemObjects SDK');
  try
    result := reg.ReadString('ServiceBuilder', 'FullPath', GetBinDir+'ROServiceBuilder3.exe');
  finally
    reg.Free;
  end;
end;

function GetServiceTesterPath: string;
begin
  {result := ReadRegistryValue(HKEY_CURRENT_USER,'Software\RemObjects\RemObjects SDK for Delphi','InstallDir','');
  if result = '' then
    raise Exception.Create('Cannot find RemObjects SDK for Delphi location in Registry.'#13#13'Please make sure RemObjects SDK is installed properly.');
  result := IncludeTrailingBackslash(result)+'Bin\ROServiceTester.exe';
  if not FileExists(result) then
    raise Exception.CreateFmt('Cannot find ServiceTester at "%s".'#13#13'Please make sure RemObjects SDK is installed properly.', [result]);}
  result := IncludeTrailingPathDelimiter(ExtractFilePath(GetServiceBuilderPath()))+'ROServiceTester.exe';
  if not FileExists(result) then
    raise Exception.CreateFmt('Cannot find ServiceTester at "%s".'#13#13'Please make sure RemObjects SDK is installed properly.', [result]);
end;

{----------------------------------------------------------------------------}
// Taken from eFiles.pas from the eLibrary 6.0
function ExecuteAndWait(const aApp, aCmdLine:string; aWait:boolean=true):dword;
var StartupInfo:TStartupInfo;
    ProcessInfo:TProcessInformation;
    lApp:string;
    s:array[0..MAX_PATH] of char;
begin
  GetStartupInfo(Startupinfo);

  ExpandEnvironmentStrings(pChar(aApp),@s,MAX_PATH);
  lApp := string(pChar(@s));

  if CreateProcess(pChar(lApp),
                   pChar('"'+lApp+'" '+aCmdLine),
                   nil,nil,false,0,nil,
                   pChar(GetCurrentDir),
                   StartupInfo,
                   ProcessInfo) then begin
    CloseHandle(ProcessInfo.hThread);

    if aWait then begin
    { Wait till app terminates, but don't block main thread. }
    while WaitForSingleObject(ProcessInfo.hProcess,100) = WAIT_TIMEOUT do
      Application.ProcessMessages();
    GetExitCodeProcess(ProcessInfo.hProcess,result);
    end;
    CloseHandle(ProcessInfo.hProcess);
  end
  else raise Exception.CreateFmt('could not create process %s %s: %d',[lApp,CmdLine,GetLastError]);
end;

procedure LaunchServiceBuilder(const aProjectName, aParams: string; aWait:boolean=false);
var
  lExeName: string;
begin
  lExeName := GetServiceBuilderPath();

  if aWait then begin
    ExecuteAndWait(lExename, aParams);
  end
  else begin
    ShellExecute(0, 'open', PChar(lExeName), PChar(aParams), PChar(ExtractFilePath(aProjectName)), SW_NORMAL);
  end;
end;

procedure LaunchServiceTester;
var
  lExeName: string;
begin
  lExeName := GetServiceTesterPath();
  ShellExecute(0, 'open', PChar(lExeName), nil, nil, SW_NORMAL);
end;

procedure LaunchServiceBuilderForCurrentProject(const aAdditionalParameters:string; aOnlyLaunchForROServer:boolean=false; aWait:boolean=false);
var prj : IOTAProject;
    fname,
    lParams,
    src: string;
begin
  // TODO: Clean up these hardcoded things
  prj := CurrentProject;

  if Assigned(prj) then begin
    src := ReadModuleSource(prj);
    fname := ModuleDir(prj)+ExtractRODLFileName(src);

    if (ExtractFileName(fname)<>'') then begin
      {$IFDEF SB2}
      lParams := Format('/rodlfile:"%s" /projectname:"%s" /autosave '+aAdditionalParameters, [fname, ExtractFileName(prj.FileName)])
      {$ELSE}
      lParams := Format('"%s" /ns /projectname:"%s" /autosave '+aAdditionalParameters, [fname, ExtractFileName(prj.FileName)])
      {$ENDIF}
    end
    else begin
      if aOnlyLaunchForROServer then
        RaiseError('The current project is not a RemObjects Server');
      lParams := '/ns '+aAdditionalParameters;
    end;
    LaunchServiceBuilder(prj.FileName, lParams, aWait);

  end
  else begin
    if aOnlyLaunchForROServer then
      RaiseError('The current project is not a RemObjects Server');
    LaunchServiceBuilder('', '/ns')
  end;
end;

function GenerateRESFromRODL(const RODLFileName: string; aMessageList: TIDEMessageList): boolean;
var {outname, }
  lAttributes: Integer;
  resname {, pars}: string;
    //res : integer;
  resdata, rodldata: TFileStream;
begin
  rodldata := nil;
  resdata := nil;

  result := false;
  try
    try
      resname := IncludeTrailingBackslash(ExtractFilePath(RODLFileName)) + res_RODLFile + '.res';

      {$IFDEF MSWINDOWS}
      if FileExists(resname) then begin
        lAttributes := FileGetAttr(resname);
        if (lAttributes and faReadOnly) = faReadOnly then begin
          case MessageDlg(Format('%s is readonly, overwrite anyway?',[ExtractFileName(resname)]),
                        mtConfirmation, [mbYes, mbCancel, mbIgnore], 0) of
            mrCancel: Abort();
            mrIgnore: begin
                result := true;
                exit;
              end;
            mrYes: FileSetAttr(resname, lAttributes xor faReadOnly);
          end;
        end;
      end;
      {$ENDIF}

      resdata := TFileStream.Create(resname, fmCreate);
      rodldata := TFileStream.Create(RODLFileName, fmOpenRead + fmShareDenyNone);
      rodldata.Position := 0;

      WriteRES(rodldata, resdata, res_RODLFile);

      result := FileExists(resname);
    except
      on E: EAbort do raise;
      on E: Exception do begin
        MessageDlg('The following error occourred while trying to generate the resource file.'#13 +
          E.Message, mtError, [mbOK], 0);
        result := FALSE;
      end;
    end;
  finally
    rodldata.Free;
    resdata.Free;
  end;
{  try
    // Creates an rc file called RODLFile.rc and saves it where the RODL file is located
    outname := IncludeTrailingBackslash(ExtractFilePath(RODLFileName))+res_RODLFile+'.rc';

    with TStringList.Create do try
      Add(Format('%s RCDATA "%s"', [res_RODLFile, RODLFileName]));
      SaveToFile(outname);
    finally
      Free;
    end;

    resname := ChangeFileExt(outname, '.RES');
    DeleteFile(resname);

    if FileExists(resname) then begin
      aMessageList.Add(mError,'The file '+resname+' could not be deleted');
    end;

    pars := '"'+outname+'" "'+resname+'"';
    res := ShellExecute(0, 'open', 'BRCC32', PChar(pars), NIL, SW_HIDE);
    aMessageList.Add(mInfo, 'BRCC32 '+pars);

    if (res<=32) then begin
      aMessageList.Add(mError,Format('ShellExecute returned %s', [res]));
      result := FALSE;
    end
    else result := TRUE;
  except
    on E:Exception do begin
      MessageDlg('The following error occourred while trying to generate the resource file.'#13+
                 E.Message, mtError, [mbOK], 0);
      result := FALSE;
    end;
  end;}
end;

procedure CompileProject;
var
  Actions: IOTAEditActions;
  ModuleServices: IOTAModuleServices;
  Module: IOTAModule;
  SourceEdit: IOTASourceEditor;
  FileCount: Integer;
  cnt: Integer;
begin
  ModuleServices := BorlandIDEServices as IOTAModuleServices;

  Module := ModuleServices.CurrentModule;

  FileCount := Module.GetModuleFileCount;
  if not FileCount>0 then Exit;

  for cnt := 0 to FileCount - 1 do
    if Module.GetModuleFileEditor(cnt).QueryInterface(IOTASourceEditor, SourceEdit) = S_OK then begin
      if SourceEdit.EditViews[0].QueryInterface(IOTAEditActions, Actions) = S_OK then
        Actions.CompileProject;
      exit;
    end;
end;


function GetDllPath: String;
var TheFileName : array[0..MAX_PATH] of char;
begin
  FillChar(TheFileName, SizeOf(TheFileName), #0);
  {$IFDEF KYLIX}System.{$ENDIF}GetModuleFileName(hInstance, TheFileName, sizeof(TheFileName));
  Result := ExtractFilePath(TheFileName);
end;

function GetTemplateDir: string;
begin
  result := ReadRegistryValue(HKEY_CURRENT_USER,'Software\RemObjects\RemObjects SDK for Delphi','InstallDir','');
  Result := IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(Result) + 'Templates');
(*
  //ToDo: use a more reliable way to find templates; possibly using the same technique as GetServiceBuilderPath()
  // This function strips the "DCU\Dx" part of the path where the BPL is
  result := ExtractFilePath(GetDllPath);
  {$IFDEF DELPHI10UP}
  result := IncludeTrailingBackslash(Copy(result,1,Length(result)-8))+{$IFDEF KYLIX}'Templates/'{$ELSE}'Templates\'{$ENDIF};
  {$ELSE}
  result := IncludeTrailingBackslash(Copy(result,1,Length(result)-7))+{$IFDEF KYLIX}'Templates/'{$ELSE}'Templates\'{$ENDIF};
  {$ENDIF}
*)
end;

function GetBinDir: string;
begin
  // TODO: Fix this adding a registry key.

  // This function strips the "DCU\Dx" part of the path where the BPL is
  result := ExtractFilePath(GetDllPath);
  result := IncludeTrailingBackslash(Copy(result,1,Length(result)-7))+'Bin\';
end;

function GetTemplateConfigFileName : string;
begin
  result := GetTemplateDir+'Config.ini';
end;

function GetTemplateOptionsFileName : string;
begin
  result := GetTemplateDir+'TemplateOptions.ini';
end;

end.