Componentes.Terceros.RemObj.../internal/5.0.24.615/1/RemObjects SDK for Delphi/Source/IDE/uROIDEMenu.pas

552 lines
18 KiB
ObjectPascal

unit uROIDEMenu;
{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Delphi IDE Integration
{
{ compiler: Delphi 5 and up
{ platform: Win32
{
{ (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
{ Service Builder command line parameters:
/rodlfile:filename : File to load
/projectname:dpr-file-name : Just for display; implies /autosave
/autosave : Auto-save change when SB loses focus or is closed
/register : Quite, register filetypes (.rodl to lauch with SB)
/import-wsdl:file-or-url : Auto-import the WSDL into the specified (or empty) RODL file
/import : Show a selection box to determine what type of file to import.
}
uses
Forms, Classes, Windows, SysUtils,
{$IFDEF DELPHI6UP}DesignEditors, DesignIntf, {$ELSE} DsgnIntf,{$ENDIF}
ToolsApi, Menus, Contnrs, ComObj, Graphics,
uEWMenuManager;
type
{ TMenuItemInfo }
TMenuItemInfo = record
Caption,
ShortCut : string;
Menu:TEWMenuItem;
ImageIndex:integer;
Personalities:TEWPersonalitySet;
end;
resourcestring sMakeServerCaption = 'T&urn %s into a RemObjects SDK Server';
const MAX_MENU_ITEM = 14;
var
MenuItems : array[0..MAX_MENU_ITEM] of TMenuItemInfo = (
(Caption: '&Service Builder'; ShortCut: 'CTRL+ALT+U'; Menu:nil; ImageIndex: 0; Personalities: [pDelphiWin32, pCppBuilderWin32, pNone]),
(Caption: '&Import RemObjects SDK Service...'; ShortCut: 'CTRL+ALT+I'; Menu:nil; ImageIndex: 1; Personalities: [pDelphiWin32, pCppBuilderWin32]),
(Caption: 'Import SOAP &Web Service...'; ShortCut: ''; Menu:nil; ImageIndex: 7; Personalities: [pDelphiWin32, pCppBuilderWin32]),
(Caption: '-'; ShortCut: ''; Menu:nil; ImageIndex: -1; Personalities: [pDelphiWin32, pCppBuilderWin32, pNone]),
(Caption: 'Service &Tester'; ShortCut: ''; Menu:nil; ImageIndex: 5; Personalities: [pDelphiWin32, pCppBuilderWin32, pNone]),
(Caption: '-'; ShortCut: ''; Menu:nil; ImageIndex: -1; Personalities: [pDelphiWin32]),
(Caption: '&Hide Preprocessor Window'; ShortCut: ''; Menu:nil; ImageIndex: -1; Personalities: [pDelphiWin32]),
(Caption: '-'; ShortCut: ''; Menu:nil; ImageIndex: -1; Personalities: [pDelphiWin32]),
(Caption: '&Regenerate Units from RODL'; ShortCut: 'CTRL+ALT+E'; Menu:nil; ImageIndex: 2; Personalities: [pDelphiWin32, pCppBuilderWin32]),
(Caption: 'Regenerate &Async Unit from RODL'; ShortCut: 'CTRL+ALT+A'; Menu:nil; ImageIndex: 2; Personalities: [pDelphiWin32, pCppBuilderWin32]),
(Caption: sMakeServerCaption; ShortCut: ''; Menu:nil; ImageIndex: 3; Personalities: [pDelphiWin32, pCppBuilderWin32]),
(Caption: '-'; ShortCut: ''; Menu:nil; ImageIndex: -1; Personalities: [pDelphiWin32, pCppBuilderWin32]),
(Caption: 'Launc&h Server Executable'; ShortCut: 'CTRL+ALT+F9'; Menu:nil; ImageIndex: 4; Personalities: [pDelphiWin32, pCppBuilderWin32]),
(Caption: '-'; ShortCut: ''; Menu:nil; ImageIndex: -1; Personalities: [pDelphiWin32, pNone]),
//(Caption: 'Check for New &Versions'; ShortCut: ''; Menu:nil; ImageIndex: -1; Personalities: [pDelphiWin32, pCppBuilderWin32, pNone]),
(Caption: 'A&bout RemObjects SDK'; ShortCut: ''; Menu:nil; ImageIndex: 6; Personalities: [pDelphiWin32, pCppBuilderWin32, pNone])
//(Caption: '&Import Services'; ShortCut: 'CTRL+ALT+S')
);
const
mi_RODLEditor = 0;
mi_ImportServicesRODL = 1;
mi_ImportServicesWSDL = 2;
mi_ServiceTester = 4;
mi_HidePreprocessor = 6;
mi_Regenerate = 8;
mi_RegenerateAsync = 9;
mi_ConvertToServer = 10;
mi_ConvertToServerSeparator = 11;
mi_LaunchExe = 12;
mi_LaunchExeSeparator = 13;
//mi_CheckVersion = 14;
mi_About = 14;
type
{ TROMenuWizard }
TROMenuWizard = class(TInterfacedObject, IOTAWizard, IOTANotifier)
private
fROMenu: TEWMenu;
fHidePreprocessorItem: TEWMenuItem;
fVersionService:string;
procedure OnHidePreprocessorClick(Sender: TObject);
procedure ImportService(const aType:string);
protected
{ Misc }
procedure CreateMenuItems;
procedure ShowServiceBuilder(Sender : TObject);
procedure ImportServicesRODL(Sender: TObject);
procedure ImportServicesWSDL(Sender: TObject);
procedure LaunchServiceTester(Sender: TObject);
procedure OnRegenerateUnits(Sender: TObject);
procedure OnRegenerateAsyncUnit(Sender: TObject);
procedure OnMenuPopup(Sender: TObject);
procedure OnConvertToServer(Sender: TObject);
procedure OnAbout(Sender: TObject);
procedure OnLaunchEXE(Sender: TObject);
procedure OnCheckForNewVersion(Sender: TObject);
{ IOTANotifier}
procedure AfterSave;
procedure BeforeSave;
procedure Destroyed;
procedure Execute;
procedure Modified;
{ IOTAWizard }
function GetState: TWizardState;
function GetIDString: string;
function GetName: string;
public
constructor Create;
destructor Destroy; override;
end;
procedure Register;
var
gRemObjectsMenu:TMenuItem;
implementation
uses
ShellAPI, Controls, Registry, Dialogs,
uRODL, uROIDETools, uRODLToXML, uRODLToPascalIntf, uRODLGenTools,
uRORODLNotifier, uROPleaseWaitForm, uROIDEData, fROAbout,
fCustomIDEMessagesForm, uROProductVersionInfo, uROClasses, uRODLConvertersUtils;
{$R Resources.BDS.res}
procedure RegisterAboutInfo;
const
lProductName = 'RemObjects SDK ''Vinci'' for Delphi';
begin
{$IFDEF BDS}
{$IFDEF BDS3}
SplashScreenServices.AddPluginBitmap(lProductName, LoadBitmap(HInstance, 'SPLASH2005'));
{$ELSE}
if (BorlandIDEServices as IOTAServices).GetProductIdentifier = 'CodeGear Delphi for Microsoft Windows' then
SplashScreenServices.AddPluginBitmap(lProductName, LoadBitmap(HInstance, 'SPLASH2007'))
else
SplashScreenServices.AddPluginBitmap(lProductName, LoadBitmap(HInstance, 'SPLASH2006'));
{$ENDIF}
(BorlandIDEServices as IOTAAboutBoxServices).AddPluginInfo(lProductName, lProductName+#13#10'Copyright RemObjects Software 2002-2007 .'#13#10'All rights reserved.'#13#10'http://www.remobjects.com/ro.', LoadBitmap(HInstance, 'ABOUT'));
{$ENDIF BDS}
end;
procedure Register;
begin
RegisterAboutInfo;
RegisterPackageWizard(TROMenuWizard.Create);
end;
{ TROMenuWizard }
constructor TROMenuWizard.Create;
begin
inherited Create;
CreateMenuItems;
end;
destructor TROMenuWizard.Destroy;
begin
if Assigned(fROMenu) then begin
MenuManager.DestroyMenu(fROMenu);
end;
gRemObjectsMenu := nil;
inherited;
end;
function TROMenuWizard.GetIDString: string;
begin
Result := '{137E9A72-CBF8-485F-9421-212866E99084}';
end;
function TROMenuWizard.GetName: string;
begin
Result := 'ROMenuWizard';
end;
// The following are stubs that Delphi never calls.
procedure TROMenuWizard.AfterSave;
begin
end;
procedure TROMenuWizard.BeforeSave;
begin
end;
procedure TROMenuWizard.Destroyed;
begin
end;
procedure TROMenuWizard.Execute;
begin
end;
function TROMenuWizard.GetState: TWizardState;
begin
Result := [];
end;
procedure TROMenuWizard.Modified;
begin
end;
procedure TROMenuWizard.CreateMenuItems;
var
lItem : TEWMenuItem;
i : Integer;
lCaption: string;
begin
lCaption := 'Rem&Objects SDK';
with TRegistry.Create(KEY_READ) do try
RootKey := HKEY_CURRENT_USER;
if OpenKey('\Software\RemObjects\RemObjects SDK for Delphi\IDE Integration', False) then
if ValueExists('Menu Caption') then
lCaption := ReadString('Menu Caption');
if ValueExists('VersionService URL') then
fVersionService := ReadString('VersionService URL');
finally
Free;
end;
fROMenu := MenuManager.CreateMenu(lCaption);
fROMenu.OnPopup := OnMenuPopup;
gRemObjectsMenu := fROMenu.Menu;
with TIdeData.Create(nil) do try
for i := 0 to High(MenuItems) do begin
lItem := fROMenu.CreateMenuItem(MenuItems[i].Caption, -1, MenuItems[i].Personalities);
lItem.MenuItem.ShortCut := TextToShortCut(MenuItems[i].ShortCut);
lItem.MenuItem.Tag := i;
if MenuItems[i].ImageIndex > -1 then
lItem.SetGlyph(iml_Actions, MenuItems[i].ImageIndex);
MenuItems[i].Menu := lItem;
case i of
mi_RODLEditor : lItem.MenuItem.OnClick := ShowServiceBuilder;
mi_ImportServicesRODL : lItem.MenuItem.OnClick := ImportServicesRODL;
mi_ImportServicesWSDL : lItem.MenuItem.OnClick := ImportServicesWSDL;
mi_ServiceTester : lItem.MenuItem.OnClick := LaunchServiceTester;
mi_Regenerate : lItem.MenuItem.OnClick := OnRegenerateUnits;
mi_RegenerateAsync : lItem.MenuItem.OnClick := OnRegenerateAsyncUnit;
mi_ConvertToServer : lItem.MenuItem.OnClick := OnConvertToServer;
//mi_CheckVersion : lItem.MenuItem.OnClick := OnCheckForNewVersion;
mi_About : lItem.MenuItem.OnClick := OnAbout;
mi_LaunchExe : lItem.MenuItem.OnClick := OnLaunchEXE;
mi_HidePreprocessor : begin
lItem.MenuItem.OnClick := OnHidePreprocessorClick;
fHidePreprocessorItem := lItem;
end;
else lItem.MenuItem.OnClick := nil;
end;
end;
{$IFDEF DELPHI7UP}
MenuItems[mi_HidePreprocessor].Menu.Visible := False;
MenuItems[mi_HidePreprocessor+1].Menu.Visible := False; // separator;
{$ENDIF}
finally
Free();
end;
end;
procedure TROMenuWizard.OnMenuPopup(Sender: TObject);
var lCurrentProjectIsRodlProject :boolean;
lRodlProject: IOTAProject;
lProject: IOTAProject;
begin
lCurrentProjectIsRodlProject := ProjectIsRodlProject(CurrentProject());
lRodlProject := FindFirstRodlProject;
MenuItems[mi_Regenerate].Menu.Visible := lCurrentProjectIsRodlProject;
MenuItems[mi_RegenerateAsync].Menu.Visible := lCurrentProjectIsRodlProject;
MenuItems[mi_LaunchExe].Menu.Visible := assigned(lRodlProject) or lCurrentProjectIsRodlProject;
//MenuItems[mi_LaunchExeSeparator].Menu.Visible := assigned(lRodlProject) or lCurrentProjectIsRodlProject;
{ D7 menu cannot hide separators itself }
if lCurrentProjectIsRodlProject then begin
MenuItems[mi_RODLEditor].Menu.MenuItem.Caption := 'Edit &Service Library';
end
else begin
MenuItems[mi_RODLEditor].Menu.MenuItem.Caption := '&Service Builder';
end;
if DisplayIDEMessageForm and fHidePreprocessorItem.MenuItem.Checked
then fHidePreprocessorItem.MenuItem.Checked := FALSE;
lProject := CurrentProject;
if Assigned(lProject) then begin
MenuItems[mi_ConvertToServer].Menu.Visible := not lCurrentProjectIsRodlProject;
MenuItems[mi_ConvertToServer].Menu.MenuItem.Caption := Format(sMakeServerCaption,[ChangeFileExt(ExtractFileName(lProject.GetFileName),'')]);
end
else begin
MenuItems[mi_ConvertToServer].Menu.Visible := false;
end;
MenuItems[mi_ConvertToServerSeparator].Menu.Visible := (MenuItems[mi_ConvertToServer].Menu.Visible or MenuItems[mi_Regenerate].Menu.Visible);
end;
resourcestring
sConvertedLaunchSB = 'Your Project was converted into a RemObjects server.'#13#13+
'Would you like to launch ServiceBuilder to define your Service, now?';
procedure TROMenuWizard.OnConvertToServer(Sender: TObject);
begin
if ConvertProjectToRoServer(CurrentProject()) then begin
if MessageDlg(sConvertedLaunchSB,mtConfirmation,[mbYes,mbNo],0) = idYes then begin
LaunchServiceBuilderForCurrentProject('');
end;
end;
end;
procedure TROMenuWizard.OnRegenerateUnits(Sender: TObject);
begin
with TRORODLNotifier.Create do try
GenerateUnits(CurrentProject, [utIntf, utInvk, utImpl]);
finally
Free();
end;
end;
procedure TROMenuWizard.OnRegenerateAsyncUnit(Sender: TObject);
begin
with TRORODLNotifier.Create do try
GenerateUnits(CurrentProject, [utAsync]);
finally
Free();
end;
end;
procedure TROMenuWizard.ShowServiceBuilder(Sender: TObject);
begin
LaunchServiceBuilderForCurrentProject('');
end;
procedure TROMenuWizard.LaunchServiceTester(Sender: TObject);
begin
uROIDETools.LaunchServiceTester();
end;
procedure TROMenuWizard.ImportServicesRODL(Sender: TObject);
begin
ImportService('Import.Rodl');
end;
procedure TROMenuWizard.ImportServicesWSDL(Sender: TObject);
begin
ImportService('Import.Soap.Wsdl');
end;
procedure TROMenuWizard.ImportService(const aType:string);
var params, lUnitName, lRodlName : string;
tempdir : array[0..1000] of char;
lModule : IOTAModule;
lProject: IOTAProject;
lLibrary: TRODLLibrary;
begin
//if not GetImportInputs(loc) then Exit;
Windows.GetTempPath(SizeOf(tempdir), tempdir);
lRodlName := IncludeTrailingBackslash(tempdir)+GUIDToString(NewGUID)+'.rodl';
DeleteFile(lRodlName);
lProject := CurrentProject;
{$IFDEF SB2}
if assigned(lProject) then begin
params := Format('/import /rodlfile:"%s" /autosave /projectname:"(Import Service for %s)"', [lRodlName,ExtractFileName(lProject.FileName)]);
end
else begin
params := Format('/import /rodlfile:"%s" /autosave', [lRodlName]);
end;
{$ELSE}
if assigned(lProject) then begin
params := Format('"%s" /ns /import:%s /autosave /projectname:"(Importing Service for %s)"', [lRodlName,aType,ExtractFileName(lProject.FileName)]);
end
else begin
params := Format('"%s" /ns /import:%s /autosave', [lRodlName,aType]);
end;
{$ENDIF SB2}
//params := Format('/import-wsdl:%s /rodlfile:%s /autosave', [loc, fname]);
//params := Format('/import /rodlfile:%s /autosave', [fname]);
//ShowMessage(params);
with TPleaseWaitForm.Create(Application,'Importing via the ServiceBuilder...') do try
Show();
LaunchServiceBuilder(lProject.FileName,Params,true);
Hide();
finally
Free();
end;
if FileExists(lRodlName) then try
lLibrary := LoadLibraryFromXml(lRodlName);
try
lUnitname := ExtractFilePath(lProject.FileName)+GetTargetFileName(lLibrary, nil, cgtIntf, CodeGenLanuageFromProjectPersonality(lProject));
// Checks if the module is already in the project
try
lModule := FindModuleByUnitName(lProject, lUnitname);
except
on E:EFOpenError do lModule := nil;
else raise;
end;
if assigned(lModule) then begin
case MessageDlg(Format('A unit named "%s" already exists in the project.'#13+
'Do you want to overwrite the file?', [ExtractFileName(lUnitname)]),
mtWarning, [mbYes, mbCancel], 0) of
mrCancel: Abort;
mrYes: { no-op};
end
end
else if FileExists(lUnitName) then begin
case MessageDlg(Format('A unit named "%s" already exists, but is not part of the project.'#13+
'Do you want to overwrite the file?', [ExtractFileName(lUnitname)]),
mtWarning, [mbYes, mbCancel], 0) of
mrCancel: Abort;
mrYes: { no-op};
end
end;
//ToDo: handle read-only files
{$IFNDEF REMOBJECTS_CODEGEN2}
if CodeGenLanuageFromProjectPersonality(lProject) = cglCppWin32 then begin
{$ENDIF}
GenerateUnitToFile(lRodlName, nil, cgtIntf, CodeGenLanuageFromProjectPersonality(lProject), '', lUnitName);
lProject.AddFile(lUnitName, true);
//ToDo: properly load from stream into lModule
{$IFNDEF REMOBJECTS_CODEGEN2}
end
else begin
with TRODLToIntf.Create(lRodlName,ChangeFileExt(ExtractFileName(lUnitName), '')) do try
Buffer.SaveToFile(lUnitName);
lProject.AddFile(lUnitName, true);
finally
Free;
end;
end;
{$ENDIF not REMOBJECTS_CODEGEN2}
finally
FreeAndNil(lLibrary);
end;
finally
DeleteFile(lRodlName);
end;
end;
procedure TROMenuWizard.OnAbout(Sender: TObject);
begin
with TAboutForm.Create(Application) do try
Position := poScreenCenter;
ShowModal();
finally
Free();
end
end;
procedure TROMenuWizard.OnCheckForNewVersion(Sender: TObject);
begin
GetVersionInfos(fVersionService);
end;
procedure TROMenuWizard.OnHidePreprocessorClick(Sender : TObject);
var
lMenuItem: TMenuItem;
begin
lMenuItem := MenuItems[mi_HidePreprocessor].Menu.MenuItem;
lMenuItem.Checked := not lMenuItem.Checked;
DisplayIDEMessageForm := not lMenuItem.Checked;
if not DisplayIDEMessageForm and IDEMessageForm.Visible then IDEMessageForm.Close;
end;
{$IFDEF DELPHI5}
const
PathDelim = '\';
function IncludeTrailingPathDelimiter(const S: string): string;
begin
Result := S;
if not IsPathDelimiter(Result, Length(Result)) then
Result := Result + PathDelim;
end;
{$ENDIF}
procedure TROMenuWizard.OnLaunchEXE(Sender: TObject);
var
dirname, exename: string;
lProject: IOTAProject;
begin
if ProjectIsRodlProject(CurrentProject()) then
lProject := CurrentProject()
else
lProject := FindFirstRodlProject();
if not assigned(lProject) then exit; // shouldn't happen if menu was active
exename := GetProjectExe(lProject);
if not FileExists(exename) then begin
case MessageDlg(Format('The file %s does not exist. Would you like to compile the project now?', [exename]), mtWarning, [mbYes, mbCancel], 0) of
idYes:begin
if lProject.ProjectBuilder.BuildProject(cmOTAMake, true, true) then
ShellExecute(0, 'open', PChar(exename), NIL, PChar(dirname), SW_NORMAL);
end;
idCancel:;
end;
end
else begin
ShellExecute(0, 'open', PChar(exename), NIL, PChar(dirname), SW_NORMAL);
end;
end;
end.