////////////////////////////////////////////////// // SQL Server Data Access Components // Copyright © 1998-2007 Core Lab. All right reserved. // SDAC Design ////////////////////////////////////////////////// {$IFNDEF CLR} {$I Sdac.inc} unit MSDesign; {$ENDIF} interface uses {$IFDEF MSWINDOWS} Windows, Messages, Graphics, Controls, Forms, Dialogs, Registry, StdCtrls, {$IFDEF CLR} Borland.Vcl.Design.DesignEditors, Borland.Vcl.Design.DesignIntf, Borland.Vcl.Design.FldLinks, {$ELSE} {$IFDEF VER6P}DesignIntf, DesignEditors,{$ELSE}DsgnIntf,{$ENDIF} {$IFNDEF BCB}{$IFDEF VER5P}FldLinks,{$ENDIF} ColnEdit,{$ENDIF} {$ENDIF} {$ENDIF} SysUtils, Classes, TypInfo, DADesign, DBAccess, MSAccess, SdacVcl; type { ------------ SDac property editors ----------- } TMSConnectStringPropertyEditor = class(TStringProperty) protected FForm: TForm; FSucceeded: boolean; FConnectString: string; procedure DoActivate(Sender: TObject); public function GetAttributes: TPropertyAttributes; override; procedure Edit; override; end; TMSServerNamePropertyEditor = class (TStringProperty) public function GetAttributes: TPropertyAttributes; override; procedure GetValues(Proc: TGetStrProc); override; function AutoFill: Boolean; override; end; TMSDatabaseNamePropertyEditor = class (TStringProperty) protected procedure GetDialogOptions(Dialog: TOpenDialog); virtual; public procedure Edit; override; function GetAttributes: TPropertyAttributes; override; procedure GetValues(Proc: TGetStrProc); override; end; {$IFNDEF STD} TMSQueuePropertyEditor = class(TStringProperty) public function GetAttributes: TPropertyAttributes; override; procedure GetValues(Proc: TGetStrProc); override; end; TMSServicePropertyEditor = class(TStringProperty) public function GetAttributes: TPropertyAttributes; override; procedure GetValues(Proc: TGetStrProc); override; end; TMSContractPropertyEditor = class(TStringProperty) public function GetAttributes: TPropertyAttributes; override; procedure GetValues(Proc: TGetStrProc); override; end; TMSTargetDatabaseNamePropertyEditor = class(TStringProperty) public function GetAttributes: TPropertyAttributes; override; procedure GetValues(Proc: TGetStrProc); override; end; TMSTableNamesEditor = class(TStringProperty) public function GetAttributes: TPropertyAttributes; override; procedure Edit; override; end; {$ENDIF} TMSConnectDialogPropertyEditor = class(TComponentProperty) private FCheckProc: TGetStrProc; procedure CheckComponent(const Value: string); public procedure GetValues(Proc: TGetStrProc); override; end; { ------------ SDac component editors ----------- } TMSConnectionEditor = class(TDAConnectionEditor) protected FQueryAnalyserIndex: integer; FManagementStudioIndex: integer; procedure InitVerbs; override; public procedure ExecuteVerb(Index: integer); override; end; TMSDataSetEditor = class(TDADataSetEditor); TMSQueryEditor = class(TMSDataSetEditor) protected FQueryAnalyserIndex: integer; FManagementStudioIndex: integer; procedure InitVerbs; override; public procedure ExecuteVerb(Index: integer); override; end; TMSSQLEditor = class(TDASQLEditor) protected procedure InitVerbs; override; end; TMSTableEditor = class(TMSDataSetEditor) protected procedure InitVerbs; override; end; TMSStoredProcEditor = class(TMSDataSetEditor) protected procedure InitVerbs; override; public procedure ExecuteVerb(Index: integer); override; end; TMSUpdateSQLEditor = class(TDAUpdateSQLEditor) protected procedure InitVerbs; override; end; TMSScriptEditor = class(TDASQLEditor) protected procedure InitVerbs; override; end; {$IFNDEF STD} TMSDumpEditor = class(TDAComponentEditor) protected procedure InitVerbs; override; end; {$ENDIF} TMSConnectionList = class (TDAConnectionList) protected function GetConnectionType: TCustomDAConnectionClass; override; end; {$IFDEF VER6P} TMSDesignNotification = class(TDADesignNotification) public procedure ItemInserted(const ADesigner: IDesigner; AItem: TPersistent); override; function CreateConnectionList: TDAConnectionList; override; procedure SelectionChanged(const ADesigner: IDesigner; const ASelection: IDesignerSelections); override; function GetConnectionPropertyName: string; override; end; {$ENDIF} procedure Register; type TServerTool = (stQueryAnalyser, stManagementStudio); procedure RunServerTool(ServerTool: TServerTool; Connection: TMSConnection; const SQL: TStrings = nil); procedure RunServerToolConnection(ServerTool: TServerTool; Connection: TMSConnection; const SQLText: string); procedure RunServerToolDataSet(ServerTool: TServerTool; DataSet: TCustomMSDataSet); procedure RunServerToolMSSQL(ServerTool: TServerTool; MSSQL: TMSSQL); function IsServerToolInstalled(ServerTool: TServerTool): boolean; implementation uses {$IFDEF CLR}System.Text, WinUtils, {$ENDIF} {$IFNDEF CLR} ToolsAPI,{$ENDIF} MSMenu, ShellAPI, ActiveX, ComObj, DB, DAConsts, OLEDBIntf, OLEDBC, OLEDBAccess, MSDesignUtils, MSConnectionEditor, MSQueryEditor, MSSQLEditor, MSStoredProcEditor, DATableEditor, MSUpdateSQLEditor, DAScriptEditor, MSScript{$IFNDEF STD}, MSLoader, MSDump, MSServiceBroker, MSDumpEditor, MSNamesEditor{$ENDIF}; var TmpFiles: TStringList; function GetServerToolCommand(ServerTool: TServerTool): string; type TRegKeyString = record Root: HKEY; Path, KeyName: string; AdditionalPath: string; end; TRegKeyArray = array[0..1] of TRegKeyString; const QAKeyPaths: TRegKeyArray = ((Root: HKEY_LOCAL_MACHINE; Path: 'SOFTWARE\Microsoft\Microsoft SQL Server\80\Tools\ClientSetup'; KeyName: 'SQLPath'; AdditionalPath: '\Binn\isqlw'), (Root: HKEY_CLASSES_ROOT; Path: 'SQLFile\Shell\open\command'; KeyName: ''; AdditionalPath: '\isqlw')); MMSKeyPaths: TRegKeyArray = ((Root: HKEY_LOCAL_MACHINE; Path: 'SOFTWARE\Microsoft\Microsoft SQL Server\90\Tools\ClientSetup'; KeyName: 'SQLPath'; AdditionalPath: '\Binn\VSShell\Common7\IDE\sqlwb'), (Root: HKEY_CLASSES_ROOT; Path: 'sqlwb.sql.9.0\Shell\Open\Command'; KeyName: ''; AdditionalPath: '\sqlwb')); var Reg: TRegistry; i: integer; KeyPaths: TRegKeyArray; begin case ServerTool of stQueryAnalyser: begin Result := 'isqlw'; KeyPaths := QAKeyPaths; end; stManagementStudio: begin Result := 'sqlwb'; KeyPaths := MMSKeyPaths; end else Assert(False); end; Reg := TRegistry.Create{$IFDEF VER5P}(KEY_READ){$ENDIF}; try for i := Low(KeyPaths) to High(KeyPaths) do begin Reg.RootKey := KeyPaths[i].Root; if Reg.OpenKeyReadOnly(KeyPaths[i].Path) then begin Result := Reg.ReadString(KeyPaths[i].KeyName); Reg.CloseKey; if Result <> '' then begin Result := Result + KeyPaths[i].AdditionalPath; Break; end; end; end; finally Reg.Free; end; end; function IsServerToolInstalled(ServerTool: TServerTool): boolean; var Cmd: string; begin Cmd := GetServerToolCommand(ServerTool); Result := FileExists(Cmd + '.exe'); end; procedure RunServerTool(ServerTool: TServerTool; Connection: TMSConnection; const SQL: TStrings = nil); var Cmd, CmdParam: string; {$IFDEF CLR} TmpPath, TmpFileName: StringBuilder; SqlFileHandle: TOpenedFile; {$ELSE} TmpPath, TmpFileName: array[0..MAX_PATH] of char; SqlFileHandle: integer; {$ENDIF} SqlFileName: string; Code: integer; begin if Connection = nil then DatabaseError(SConnectionNotDefined); CmdParam := ''; //'-1'; if Connection.Server <> '' then CmdParam := CmdParam + ' -S ' + Connection.Server; if Connection.Database <> '' then CmdParam := CmdParam + ' -d ' + Connection.Database; if Connection.Authentication = auWindows then CmdParam := CmdParam + ' -E' else begin if Connection.Username <> '' then CmdParam := CmdParam + ' -U ' + Connection.Username; CmdParam := CmdParam + ' -P ' + Connection.Password; end; if (SQL <> nil) and (SQL.Count > 0) then begin {$IFDEF CLR} TmpPath := StringBuilder.Create(MAX_PATH); TmpFileName := StringBuilder.Create(MAX_PATH); Assert(GetTempPath(MAX_PATH, TmpPath) <> 0, 'Error in call GetTempPath'); Assert(GetTempFileName(TmpPath.ToString, 'sql'#0, 0, TmpFileName) <> 0, 'Error in call GetTempFileName'); if ServerTool = stManagementStudio then begin SqlFileName := ChangeFileExt(TmpFileName.ToString, '.sql'); SqlFileHandle := FileCreate(SqlFileName); //Assert(SqlFileHandle > 0); FileClose(SqlFileHandle); TmpFiles.Add(SqlFileName); SQl.SaveToFile(SqlFileName); end else SQl.SaveToFile(TmpFileName.ToString); TmpFiles.Add(TmpFileName.ToString); case ServerTool of stQueryAnalyser: CmdParam := CmdParam + ' -f ' + TmpFileName.ToString; stManagementStudio: CmdParam := '"' + SqlFileName + '" ' + CmdParam; else Assert(False); end; {$ELSE} Assert(GetTempPath(MAX_PATH, TmpPath) <> 0, 'Error in call GetTempPath'); Assert(GetTempFileName(TmpPath, 'sql'#0, 0, TmpFileName) <> 0, 'Error in call GetTempFileName'); if ServerTool = stManagementStudio then begin SqlFileName := ChangeFileExt(TmpFileName, '.sql'); SqlFileHandle := FileCreate(SqlFileName); Assert(SqlFileHandle > 0); FileClose(SqlFileHandle); TmpFiles.Add(SqlFileName); SQl.SaveToFile(SqlFileName); end else SQl.SaveToFile(TmpFileName); TmpFiles.Add(TmpFileName); case ServerTool of stQueryAnalyser: CmdParam := CmdParam + ' -f ' + StrPas(TmpFileName); stManagementStudio: CmdParam := '"' + SqlFileName + '" ' + CmdParam; else Assert(False); end; {$ENDIF} end; Cmd := GetServerToolCommand(ServerTool); {$IFDEF CLR} Code := ShellExecute(0, '', Cmd, CmdParam, '', SW_SHOWNORMAL); {$ELSE} Code := ShellExecute(0, nil, @Cmd[1], @CmdParam[1], nil, SW_SHOWNORMAL); {$ENDIF} if Code <= 32 then raise Exception.CreateFmt('Error executing "%s %s". Code = %d', [Cmd, CmdParam, Code]); end; procedure RunServerToolConnection(ServerTool: TServerTool; Connection: TMSConnection; const SQLText: string); var SQL: TStringList; begin SQL := TStringList.Create; try SQL.Add(SQLtext); RunServerTool(ServerTool, Connection, SQL); finally SQL.Free; end; end; procedure RunServerToolDataSet(ServerTool: TServerTool; DataSet: TCustomMSDataSet); begin RunServerToolConnection(ServerTool, DataSet.Connection, TMSAccessUtils.GetOLEDBSQL(DataSet)); end; procedure RunServerToolMSSQL(ServerTool: TServerTool; MSSQL: TMSSQL); begin RunServerToolConnection(ServerTool, MSSQL.Connection, TMSAccessUtils.GetOLEDBSQL(MSSQL)); end; { TMSConnectStringProperty } function TMSConnectStringPropertyEditor.GetAttributes: TPropertyAttributes; begin Result := [paDialog]; end; procedure TMSConnectStringPropertyEditor.DoActivate(Sender: TObject); var DataInit: IDataInitialize; DBPrompt: IDBPromptInitialize; DataSource: IUnknown; InitStr: {$IFDEF CLR}string{$ELSE}PWideChar{$ENDIF}; InitialString: WideString; begin FSucceeded := False; DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize; InitialString := FConnectString; if Pos('Provider=', FConnectString) = 0 then begin if InitialString <> '' then InitialString := InitialString + ';'; InitialString := InitialString + 'Provider=SQLOLEDB.1'; end; DataInit.GetDataSource(nil, CLSCTX_INPROC_SERVER, {$IFDEF CLR} InitialString, {$ELSE} PWideChar(InitialString), {$ENDIF} IID_IUnknown, DataSource); DBPrompt := CreateComObject(CLSID_DataLinks) as IDBPromptInitialize; if Succeeded(DBPrompt.PromptDataSource(nil, FForm.Handle, DBPROMPTOPTIONS_PROPERTYSHEET + DBPROMPTOPTIONS_DISABLE_PROVIDER_SELECTION, 0, nil, nil, IID_IUnknown, DataSource)) then begin InitStr := nil; DataInit.GetInitializationString(DataSource, True, InitStr ); FConnectString := InitStr; FSucceeded := True; end; PostMessage(FForm.Handle, WM_CLOSE, 0, 0); end; procedure TMSConnectStringPropertyEditor.Edit; begin FConnectString := TMSConnection(GetComponent(0)).ConnectString; FForm := TForm.Create(nil); try FForm.BorderStyle := bsNone; FForm.Position := poScreenCenter; FForm.Width := 10; FForm.Height := 10; FForm.OnActivate := DoActivate; FForm.ShowModal; finally FForm.Free; end; if FSucceeded then begin {Cannot move to DoActivate} TMSConnection(GetComponent(0)).ConnectString := FConnectString; Modified; end; end; { TMSServerNamePropertyEditor } function TMSServerNamePropertyEditor.GetAttributes: TPropertyAttributes; begin Result := [paValueList]; end; function TMSServerNamePropertyEditor.AutoFill: Boolean; begin Result := False; end; procedure TMSServerNamePropertyEditor.GetValues(Proc: TGetStrProc); var List: TStringList; i: integer; OldCursor: TCursor; Connection: TMSConnection; IsEverywhere: boolean; begin List := TStringList.Create; OldCursor := Screen.Cursor; Screen.Cursor := crSQLWait; try Connection := nil; if GetComponent(0) is TMSConnection then Connection := GetComponent(0) as TMSConnection; IsEverywhere := (Connection <> nil) and (Connection.Options.Provider = prCompact); if not IsEverywhere then GetServerList(List); for i := 0 to List.Count - 1 do Proc(List[i]); finally List.Free; Screen.Cursor := OldCursor; end; end; { TMSDatabaseNamePropertyEditor } procedure TMSDatabaseNamePropertyEditor.GetDialogOptions(Dialog: TOpenDialog); begin {$IFDEF LINUX} Dialog.Filter := 'All Files (*)|*'; {$ENDIF} {$IFDEF MSWINDOWS} Dialog.Filter := 'MS SQL Database Files (*.sdf)|*.sdf|All Files (*.*)|*.*'; {$ENDIF} Dialog.Options := Dialog.Options + [ofPathMustExist]; end; function TMSDatabaseNamePropertyEditor.GetAttributes: TPropertyAttributes; var Connection: TMSConnection; begin Connection := nil; if GetComponent(0) is TMSConnection then Connection := GetComponent(0) as TMSConnection else if GetComponent(0) is TCustomMSDataset then Connection := TCustomMSDataset(GetComponent(0)).Connection as TMSConnection; if Connection = nil then Exit; if Connection.Options.Provider <> prCompact then Result := [paValueList] else Result := [paRevertable, paDialog, paMultiSelect]; end; procedure TMSDatabaseNamePropertyEditor.Edit; var OpenDialog: TOpenDialog; begin OpenDialog := TOpenDialog.Create(nil); GetDialogOptions(OpenDialog); if OpenDialog.Execute then SetValue(OpenDialog.FileName); OpenDialog.Free; end; procedure TMSDatabaseNamePropertyEditor.GetValues(Proc: TGetStrProc); var List: TStringList; Connection: TMSConnection; i: integer; OldConnected: boolean; begin Connection := nil; if GetComponent(0) is TMSConnection then Connection := GetComponent(0) as TMSConnection else if GetComponent(0) is TCustomMSDataset then Connection := TCustomMSDataset(GetComponent(0)).Connection as TMSConnection; if Connection = nil then Exit; OldConnected := Connection.Connected; List := TStringList.Create; try try GetDatabasesList(Connection, List); except Designer.Modified; raise; end; List.Sort; for i := 0 to List.Count - 1 do Proc(List[i]); finally List.Free; if (OldConnected <> Connection.Connected) and (Designer <> nil) then Designer.Modified; end; end; { TMSQueuePropertyEditor } {$IFNDEF STD} function TMSQueuePropertyEditor.GetAttributes: TPropertyAttributes; begin Result := [paValueList]; end; procedure TMSQueuePropertyEditor.GetValues(Proc: TGetStrProc); var List: TStringList; Connection: TMSConnection; ServiceBroker: TMSServiceBroker; i: integer; OldConnected: boolean; begin ServiceBroker := nil; Connection := nil; if GetComponent(0) is TMSServiceBroker then begin ServiceBroker := TMSServiceBroker(GetComponent(0)); Connection := ServiceBroker.Connection; end; if Connection = nil then Exit; OldConnected := Connection.Connected; List := TStringList.Create; try try ServiceBroker.GetQueueNames(List); except Designer.Modified; raise; end; List.Sort; for i := 0 to List.Count - 1 do Proc(List[i]); finally List.Free; if (OldConnected <> Connection.Connected) and (Designer <> nil) then Designer.Modified; end; end; { TMSServicePropertyEditor } function TMSServicePropertyEditor.GetAttributes: TPropertyAttributes; begin Result := [paValueList, paSortList, paMultiSelect]; end; procedure TMSServicePropertyEditor.GetValues(Proc: TGetStrProc); var List: TStringList; Connection: TMSConnection; ServiceBroker: TMSServiceBroker; i: integer; OldConnected: boolean; begin ServiceBroker := nil; Connection := nil; if GetComponent(0) is TMSServiceBroker then begin ServiceBroker := TMSServiceBroker(GetComponent(0)); Connection := ServiceBroker.Connection; end; if Connection = nil then Exit; OldConnected := Connection.Connected; List := TStringList.Create; try try ServiceBroker.GetServiceNames(List); except Designer.Modified; raise; end; for i := 0 to List.Count - 1 do Proc(List[i]); finally List.Free; if (OldConnected <> Connection.Connected) and (Designer <> nil) then Designer.Modified; end; end; { TMSContractPropertyEditor } function TMSContractPropertyEditor.GetAttributes: TPropertyAttributes; begin Result := [paValueList]; end; procedure TMSContractPropertyEditor.GetValues(Proc: TGetStrProc); var List: TStringList; Connection: TMSConnection; ServiceBroker: TMSServiceBroker; i: integer; OldConnected: boolean; begin ServiceBroker := nil; Connection := nil; if GetComponent(0) is TMSServiceBroker then begin ServiceBroker := TMSServiceBroker(GetComponent(0)); Connection := ServiceBroker.Connection; end; if Connection = nil then Exit; OldConnected := Connection.Connected; List := TStringList.Create; try try ServiceBroker.GetContractNames(List); except Designer.Modified; raise; end; List.Sort; for i := 0 to List.Count - 1 do Proc(List[i]); finally List.Free; if (OldConnected <> Connection.Connected) and (Designer <> nil) then Designer.Modified; end; end; { TMSTargetDatabaseNamePropertyEditor } function TMSTargetDatabaseNamePropertyEditor.GetAttributes: TPropertyAttributes; begin Result := [paValueList]; end; procedure TMSTargetDatabaseNamePropertyEditor.GetValues(Proc: TGetStrProc); var List: TStringList; Connection: TMSConnection; i: integer; OldConnected: boolean; begin Connection := nil; if GetComponent(0) is TMSServiceBroker then Connection := TMSServiceBroker(GetComponent(0)).Connection as TMSConnection; if Connection = nil then Exit; OldConnected := Connection.Connected; List := TStringList.Create; try try GetDatabasesList(Connection, List); except Designer.Modified; raise; end; List.Sort; for i := 0 to List.Count - 1 do Proc(List[i]); finally List.Free; if (OldConnected <> Connection.Connected) and (Designer <> nil) then Designer.Modified; end; end; { TMSTableNamesEditor } function TMSTableNamesEditor.GetAttributes: TPropertyAttributes; begin Result := [paDialog]; end; procedure TMSTableNamesEditor.Edit; var Comp: TComponent; Conn: TCustomDAConnection; begin Comp := TComponent(GetComponent(0)); Conn := TMSDesignUtils.GetConnection(Comp); if Conn = nil then Exit; with TMSNamesEditorForm.Create(nil, TMSDesignUtils) do try Connection := Conn as TMSConnection; if Comp is TMSDump then Names := TMSDump(Comp).TableNames else Assert(False); ShowModal; if ModalResult = mrOk then begin if Comp is TMSDump then TMSDump(Comp).TableNames := Names else Assert(False); end; finally Free; end; end; {$ENDIF} { TMSConnectDialogPropertyEditor } procedure TMSConnectDialogPropertyEditor.CheckComponent(const Value: string); var Component: TComponent; begin Component := Designer.GetComponent(Value); if Component <> nil then begin if not (Component is TMSConnectDialog) then Exit; end; FCheckProc(Value); end; procedure TMSConnectDialogPropertyEditor.GetValues(Proc: TGetStrProc); begin FCheckProc := Proc; inherited GetValues(CheckComponent); end; { TMSConnectionEditor } procedure TMSConnectionEditor.ExecuteVerb(Index: integer); begin if (Index = FQueryAnalyserIndex) and (FQueryAnalyserIndex <> -1) then RunServerTool(stQueryAnalyser, Component as TMSConnection) else if (Index = FManagementStudioIndex) and (FManagementStudioIndex <> -1) then RunServerTool(stManagementStudio, Component as TMSConnection) else inherited ExecuteVerb(Index); end; procedure TMSConnectionEditor.InitVerbs; var ServerToolMethod: TVerbMethod; Connection: TMSConnection; begin AddVerb('Connection Editor...', TMSConnectionEditorForm, TMSDesignUtils); Connection := Component as TMSConnection; ServerToolMethod := nil; FQueryAnalyserIndex := -1; FManagementStudioIndex := -1; if (Connection <> nil) and (Connection.Options.Provider <> prCompact) then begin if IsServerToolInstalled(stQueryAnalyser) then FQueryAnalyserIndex := AddVerb('Query Analyzer...', ServerToolMethod); if IsServerToolInstalled(stManagementStudio) then FManagementStudioIndex := AddVerb('Management Studio...', ServerToolMethod); end; end; { TMSQueryEditor } procedure TMSQueryEditor.ExecuteVerb(Index: integer); begin if (Index = FQueryAnalyserIndex) and (FQueryAnalyserIndex <> -1) then RunServerToolDataSet(stQueryAnalyser, Component as TCustomMSDataSet) else if (Index = FManagementStudioIndex) and (FManagementStudioIndex <> -1) then RunServerToolDataSet(stManagementStudio, Component as TCustomMSDataSet) else inherited ExecuteVerb(Index); end; procedure TMSQueryEditor.InitVerbs; var Connection: TMSConnection; ServerToolMethod: TVerbMethod; begin AddVerb('Fields &Editor...', ShowFieldsEditor); AddVerb('MSQuery E&ditor...', TMSQueryEditorForm, TMSDesignUtils); AddVerb('Data Editor...', ShowDataEditor); Connection := (Component as TCustomMSDataSet).Connection; ServerToolMethod := nil; FQueryAnalyserIndex := -1; FManagementStudioIndex := -1; if (Connection <> nil) and (Connection.Options.Provider <> prCompact) then begin if IsServerToolInstalled(stQueryAnalyser) then FQueryAnalyserIndex := AddVerb('Query Analyzer...', ServerToolMethod); if IsServerToolInstalled(stManagementStudio) then FManagementStudioIndex := AddVerb('Management Studio...', ServerToolMethod); end; inherited; end; { TMSSQLEditor } procedure TMSSQLEditor.InitVerbs; begin AddVerb('MSSQL E&ditor...', TMSSQLEditorForm, TMSDesignUtils); end; { TMSStoredProcEditor } procedure TMSStoredProcEditor.ExecuteVerb(Index: integer); begin if Index = GetVerbCount - 1 then ConvertToClass(Designer, Component, TMSQuery) else inherited ExecuteVerb(Index); end; procedure TMSStoredProcEditor.InitVerbs; begin AddVerb('Fields &Editor...', ShowFieldsEditor); AddVerb('MSStoredProc E&ditor...', TMSStoredProcEditorForm, TMSDesignUtils); AddVerb('Data Editor...', ShowDataEditor); AddVerb('Convert to TMSQuery', ShowDataEditor); inherited; end; { TMSTableEditor } procedure TMSTableEditor.InitVerbs; begin AddVerb('Fields &Editor...', ShowFieldsEditor); AddVerb('MSTable E&ditor...', TDATableEditorForm, TMSDesignUtils); AddVerb('Data Editor...', ShowDataEditor); inherited; end; { TMSUpdateSQLEditor } procedure TMSUpdateSQLEditor.InitVerbs; begin inherited; AddVerb('MSUpdateSQL E&ditor...', TMSUpdateSQLEditorForm, TMSDesignUtils); end; { TMSScriptEditor } procedure TMSScriptEditor.InitVerbs; begin inherited; AddVerb('MSScript E&ditor...', TDAScriptEditorForm, TMSDesignUtils); end; { TMSDumpEditor } {$IFNDEF STD} procedure TMSDumpEditor.InitVerbs; begin inherited; AddVerb('MSDump E&ditor...', TMSDumpEditorForm, TMSDesignUtils); end; {$ENDIF} { TMSConnectionList } function TMSConnectionList.GetConnectionType: TCustomDAConnectionClass; begin Result := TMSConnection; end; {$IFDEF VER6P} { TMSDesignNotification } function TMSDesignNotification.CreateConnectionList: TDAConnectionList; begin Result := TMSConnectionList.Create; end; function TMSDesignNotification.GetConnectionPropertyName: string; begin Result := 'Connection'; end; procedure TMSDesignNotification.ItemInserted(const ADesigner: IDesigner; AItem: TPersistent); begin if (AItem <> nil) and ((AItem is TCustomMSDataSet) or (AItem is TMSSQL) or (AItem is TMSScript) {$IFNDEF STD}or (AItem is TMSLoader) or (AItem is TMSDump) or (AItem is TMSServiceBroker){$ENDIF} or (AItem is TMSDataSource)) then FItem := AItem; end; procedure TMSDesignNotification.SelectionChanged(const ADesigner: IDesigner; const ASelection: IDesignerSelections); {$IFDEF CLR} begin end; {$ELSE} var ModuleServices: IOTAModuleServices; CurrentModule: IOTAModule; Project: IOTAProject; ProjectOptions: IOTAProjectOptions; DelphiPath: string; s: string; begin CurrentProjectOutputDir := ''; {$IFDEF CLR} ModuleServices := BorlandIDE.ModuleServices; {$ELSE} ModuleServices :=BorlandIDEServices as IOTAModuleServices; {$ENDIF} CurrentModule := ModuleServices.CurrentModule; if CurrentModule.OwnerCount = 0 then Exit; Project := CurrentModule.Owners[0]; ProjectOptions := Project.ProjectOptions; CurrentProjectOutputDir := Trim(ProjectOptions.Values['OutputDir']); if (CurrentProjectOutputDir <> '') then begin if (CurrentProjectOutputDir[1] = '.') then begin // relative path s := Trim(ExtractFilePath(Project.FileName)); if s = '' then CurrentProjectOutputDir := '' else CurrentProjectOutputDir := IncludeTrailingBackslash(s) + CurrentProjectOutputDir; end else if Pos('$(DELPHI)', UpperCase(CurrentProjectOutputDir)) > 0 then begin DelphiPath := GetEnvironmentVariable('DELPHI'); CurrentProjectOutputDir := StringReplace(CurrentProjectOutputDir, '$(DELPHI)', DelphiPath, [rfReplaceAll, rfIgnoreCase]); end; end else CurrentProjectOutputDir := Trim(ExtractFilePath(Project.FileName)); end; {$ENDIF} {$ENDIF} procedure Register; begin // Register property editors RegisterPropertyEditor(TypeInfo(String), TMSConnection, 'ConnectString', TMSConnectStringPropertyEditor); RegisterPropertyEditor(TypeInfo(String), TMSConnection, 'Server', TMSServerNamePropertyEditor); RegisterPropertyEditor(TypeInfo(String), TMSConnection, 'Database', TMSDatabaseNamePropertyEditor); RegisterPropertyEditor(TypeInfo(TCustomConnectDialog), TMSConnection, 'ConnectDialog', TMSConnectDialogPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSQuery, 'SQL', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSQuery, 'SQLDelete', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSQuery, 'SQLInsert', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSQuery, 'SQLRefresh', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSQuery, 'SQLUpdate', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSSQL, 'SQL', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSStoredProc, 'SQL', nil); RegisterPropertyEditor(TypeInfo(TStrings), TMSStoredProc, 'SQLDelete', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSStoredProc, 'SQLInsert', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSStoredProc, 'SQLRefresh', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSStoredProc, 'SQLUpdate', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSUpdateSQL, 'InsertSQL', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSUpdateSQL, 'ModifySQL', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSUpdateSQL, 'DeleteSQL', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSUpdateSQL, 'RefreshSQL', TDAPropertyEditor); RegisterPropertyEditor(TypeInfo(String), TMSMetadata, 'DatabaseName', TMSDatabaseNamePropertyEditor); RegisterPropertyEditor(TypeInfo(TStrings), TMSScript, 'SQL', TDAPropertyEditor); {$IFNDEF STD} RegisterPropertyEditor(TypeInfo(String), TMSServiceBroker, 'Service', TMSServicePropertyEditor); RegisterPropertyEditor(TypeInfo(String), TMSDump, 'TableNames', TMSTableNamesEditor); {$ENDIF} // Register component editors DARegisterComponentEditor(TMSConnection, TMSConnectionEditor, TMSConnectionEditorForm, TMSDesignUtils); DARegisterComponentEditor(TMSQuery, TMSQueryEditor, TMSQueryEditorForm, TMSDesignUtils); DARegisterComponentEditor(TMSSQL, TMSSQLEditor, TMSSQLEditorForm, TMSDesignUtils); DARegisterComponentEditor(TMSTable, TMSTableEditor, TDATableEditorForm, TMSDesignUtils); DARegisterComponentEditor(TMSStoredProc, TMSStoredProcEditor, TMSStoredProcEditorForm, TMSDesignUtils); DARegisterComponentEditor(TMSUpdateSQL, TMSUpdateSQLEditor, TMSUpdateSQLEditorForm, TMSDesignUtils); DARegisterComponentEditor(TMSScript, TMSScriptEditor, TDAScriptEditorForm, TMSDesignUtils); {$IFNDEF STD} DARegisterComponentEditor(TMSDump, TMSDumpEditor, TMSDumpEditorForm, TMSDesignUtils); {$ENDIF} RegisterComponentEditor(TMSDataSource, TCRDataSourceEditor); Menu.AddItems({$IFDEF CLR}WinUtils{$ELSE}SysInit{$ENDIF}.HInstance); end; procedure ClearTmpFiles; var i: integer; begin if TmpFiles = nil then exit; for i := 0 to TmpFiles.Count - 1 do DeleteFile(TmpFiles[i]); end; {$IFDEF VER6P} var Notificator: TMSDesignNotification; {$ENDIF} initialization TmpFiles := nil; TmpFiles := TStringList.Create; {$IFDEF VER6P} Notificator := TMSDesignNotification.Create; RegisterDesignNotification(Notificator); {$ENDIF} ClearTmpFiles; {$IFDEF VER6P} UnRegisterDesignNotification(Notificator); {$ENDIF} end.