unit uROIDETools_laz;

{----------------------------------------------------------------------------}
{ 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.                        }
{----------------------------------------------------------------------------}

{$IFNDEF MSWINDOWS}
{$I ../RemObjects.inc}
{$ELSE}
{$I ..\RemObjects.inc}
{$ENDIF}

interface

uses {$IFDEF MSWINDOWS}Windows, {$ENDIF}
     lResources,
     LazIDEIntf, ProjectIntf,uEWOTAHelpers_laz,
     Classes, Contnrs, 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;


//  Module helpers
{}function ModuleFileName(const aModule: TLazProjectFile): string;
{}function ModuleDir(const aModule: TLazProject): string;
{}function ModuleSourceSize(const aModule: TLazProjectFile): integer;

// Project helpers

{}function CodeGenLanuageFromProjectPersonality(aProject: TLazProject): TROCodeGenLanguage;

{}function FindModule(const aProject: TLazProject; const aModuleName: string): TLazProjectFile;
{}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: TLazProject;
{}function ProjectIsRodlProject(aProject: TLazProject):boolean;
{}function ConvertProjectToRoServer(aProject: TLazProject):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: TLazProject): string;


implementation

uses SysUtils, Dialogs, Controls, uRORes,
  uEWTools, Process,FileUtil,
  fCustomIDEMessagesForm,
  uROResWriter, Forms, uROClasses, Registry,
  uEWMenuManager_laz;


function GetProjectExe(aProject: TLazProject): string;
const
  {$IFDEF MSWINDOWS}
  exe_DefaultExt = '.exe';
  {$ELSE}
  exe_DefaultExt = '.';
  {$ENDIF}
var
  dirname: string;
begin
  ChDir(ExtractFilePath(aProject.MainFile.Filename));

  //dirname := Trim(aProject.ProjectOptions.Values['OutputDir']);
  dirname := '';
  if (dirname='') then begin
    dirname := ExtractFilePath(aProject.MainFile.Filename)
  end
  else begin
    // Checks for relative paths
    if (dirname[1]='.') then dirname := ExtractFilePath(aProject.MainFile.Filename)+dirname;
  end;
  result := IncludeTrailingPathDelimiter(dirname)+ChangeFileExt(ExtractFileName(aProject.MainFile.Filename), exe_DefaultExt);
end;

// Service access helpers

function CodeGenLanuageFromProjectPersonality(aProject: TLazProject): TROCodeGenLanguage;
begin
  result := cglDelphiWin32
end;


//  Module helpers

function ModuleFileName(const aModule: TLazProjectFile): string;
begin
  result := aModule.Filename;
end;

function ModuleDir(const aModule: TLazProject): string;
begin
  result := IncludeTrailingPathDelimiter(ExtractFilePath(ModuleFileName(aModule.MainFile)))
end;

function ModuleSourceSize(const aModule: TLazProjectFile): integer;
begin
  result := Length(aModule.GetSourceText);
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: TLazProject; const aModuleName: string): TLazProjectFile;
begin
  result := FindModuleByUnitName(aProject,aModuleName);
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: TLazProject;
begin
  if ProjectIsRodlProject(CurrentProject) then
    result := CurrentProject
  else
    result := nil;
end;

function ProjectIsRodlProject(aProject: TLazProject):boolean;
var
  lSource:string;
begin
  result := false;
  if Assigned(aProject) then begin
    if aProject.LazCompilerOptions.ExecutableType = cetLibrary then exit;
    lSource := ReadModuleSource(aProject.MainFile);
    result := ExtractRODLFileName(lSource) <> '';
  end;
end;

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

    lSource := ReadModuleSource(aProject.MainFile);

    lSource := StringReplace(lSource, 'uses',
      'uses'#13#10+
      '  uROCOMInit,'#13#10+
      '  {$IFDEF FPC}LResources,{$ENDIF}',
    [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.MainFile.Filename,'.rodl'))+'} // RemObjects: Careful, do not remove!'#13#10+
      '{$IFNDEF FPC}'+#13#10 +
      '{$R RODLFile.res}'+#13#10 +
      '{$ENDIF}',
    [rfIgnoreCase]);

    lSource := StringReplace(lSource, 'begin'+#13#10, 'begin'+#13#10+
      '  {$IFDEF FPC}'+#13#10+
      '  {$I '+res_RODLFile+'.lrs}'+#13#10+
      '  {$ENDIF}'+#13#10,
      [rfIgnoreCase]);
    result := true;
    WriteModuleSource(aProject.MainFile,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 := IncludeTrailingPathDelimiter(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;


function ExecuteAndWait(const aApp, aCmdLine:string; aWait:boolean=true):dword;
var
  lProcess: TProcess;
  lApp: string;
begin
  lProcess:= TProcess.Create(nil);
  try
    lApp := aApp;
    {$IFDEF MSWINDOWS}
    if ExtractFileExt(aApp) = '' then lApp := ChangeFileExt(lApp,'.exe');
    {$ENDIF}
    lApp := FindDefaultExecutablePath(lApp);
    if (pos(' ', lApp)>0) and (Length(lApp)>0) and (lApp[1] <> '"') then
      lApp := '"'+lApp+'"';
    lProcess.CommandLine:=  aApp + ' '+aCmdLine;
    if aWait then
      lProcess.Options := lProcess.Options + [poWaitOnExit]
    else
      lProcess.Options := lProcess.Options - [poWaitOnExit];
    lProcess.Execute;
  finally
    lProcess.Free;
  end;
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
  FillChar(Startupinfo, sizeOf(Startupinfo),0);
  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
    RO_ShellExecute(0, 'open', PChar(lExeName), PChar(aParams), PChar(ExtractFilePath(aProjectName)), SW_NORMAL);
  end;
end;

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

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

  if Assigned(prj) then begin
    src := ReadModuleSource(prj.MainFile);
    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.MainFile.Filename)])
      {$ENDIF}
    end
    else begin
      if aOnlyLaunchForROServer then
        RaiseError('The current project is not a RemObjects Server');
      lParams := '/ns '+aAdditionalParameters;
    end;
    LaunchServiceBuilder(prj.MainFile.Filename, lParams, aWait);
    GenerateRESFromRODL(fname,nil)
  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;
  lrsdata: TFileStream;
begin
  rodldata := nil;
  resdata := nil;

  result := false;
  try
    try
      resname := IncludeTrailingPathDelimiter(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);
      lrsdata := TFileStream.Create(IncludeTrailingPathDelimiter(ExtractFilePath(RODLFileName)) + res_RODLFile + '.lrs', fmCreate);
      rodldata := TFileStream.Create(RODLFileName, fmOpenRead + fmShareDenyNone);

      rodldata.Position := 0;
      BinaryToLazarusResourceCode(rodldata,lrsdata,res_RODLFile,'RODL');

      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;
    lrsdata.Free;
  end;
{  try
    // Creates an rc file called RODLFile.rc and saves it where the RODL file is located
    outname := IncludeTrailingPathDelimiter(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 := RO_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;
begin
  LazarusIDE.DoSaveProject([sfProjectSaving]);
  LazarusIDE.DoBuildProject(crCompile,[]);
end;


function GetDllPath: String;
{$IFDEF MSWINDOWS}
var
  TheFileName : array[0..MAX_PATH] of char;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  FillChar(TheFileName, SizeOf(TheFileName), #0);
  GetModuleFileName(hInstance, TheFileName, sizeof(TheFileName));
  Result := ExtractFilePath(TheFileName);
{$ELSE}
  Result := '';
{$ENDIF}
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 := IncludeTrailingPathDelimiter(Copy(result,1,Length(result)-8))+{$IFDEF KYLIX}'Templates/'{$ELSE}'Templates\'{$ENDIF};
  {$ELSE}
  result := IncludeTrailingPathDelimiter(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 := IncludeTrailingPathDelimiter(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.