david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
740 lines
22 KiB
ObjectPascal
740 lines
22 KiB
ObjectPascal
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.
|
|
|