david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
659 lines
20 KiB
ObjectPascal
659 lines
20 KiB
ObjectPascal
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.
|
|
|