From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:52:02 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>MS_SQLServerConnection</name> <environment>Database</environment> <super>Database.ODBCConnection</super> <private>false</private> none <imports></imports> <category>StoreSqlServer</category> <attributes> <package>StoreSqlServer</package> </attributes> </class> <class> <name>SQLAssistSQLServer</name> <environment>Store</environment> <super>Store.SQLAssist</super> <private>false</private> none <imports></imports> <category>StoreSqlServer</category> <attributes> <package>StoreSqlServer</package> </attributes> </class> <comment> Store.SQLAssistSQLServer
Sql generator for SqlServer.
</comment> <class> <name>SQLServerBroker</name> <environment>Store</environment> <super>Store.SQLBroker</super> <private>false</private> none <imports></imports> <category>StoreSqlServer</category> <attributes> <package>StoreSqlServer</package> </attributes> </class> <comment> Store.SQLServerBroker
Interface to SqlServer database. Class Variables: Signals <ExceptionSet of signals> SqlServer signals.
</comment> <name>Signals</name> <environment>Store.SQLServerBroker</environment> <private>false</private> <constant>false</constant> <category>signals</category> <attributes> <package>StoreSqlServer</package> </attributes> <methods> Database.MS_SQLServerConnection class <category>accessing</category>
kind "Answer a symbol representing the type of DMBS the receiver provides services for." ^#'MS_SQL Server'
storeBroker "Answer a broker class for Store" ^Store.SQLServerBroker
</methods> <methods> Store.SQLAssistSQLServer <category>private</category>
removePrimaryKeyColumn: anArray " In SQL Server #PrimaryKey column is identity type. It will be inserted automaticaly" ^ anArray select: [ :col | (col equivalentTo: 'primarykey' ignoreCase: true) not ]
removePrimaryKeyValue: anArray " In SQL Server #PrimaryKey column is identity type. It will be inserted automaticaly" ^ anArray select: [ :col | (col equivalentTo: ':primarykey' ignoreCase: true) not ]
</methods> <methods> Store.SQLServerBroker class <category>accessing</category>
currentTimestampSQLString ^'SELECT GETUTCDATE()'
databaseName ^'MS_SQLServer'
fullSeqTableName: aClass ^ (self fullTableName: aClass), 'Seq'
fullTableName: aClass ^ aClass databaseName, '.', (self tableNameWithPrefix: aClass)
getBlobData: aData ^ReadStream on: aData
indexNameFor: aClass ^(self tableNameWithPrefix: aClass), '.', (self tableNameWithPrefix: aClass), aClass indexName.
needsSequenceFor: aClass ^ false
sequenceGeneratorSession: session forClass: aClass | newSession | session notNil ifTrue: [ session dismiss]. ^self safelyExecuteBlock: [ newSession := self getNewSession. newSession bindOutput: nil; bindInput: nil; prepare: ( self nextIDQuery: aClass ); blockFactor: 1. newSession ]
tableOwner ^ DbRegistry tablePrefix
useDatabase: dbName [ self processSQL: ( 'USE ' , dbName ) asString. ] on: Error do: [ :exception | Dialog warn: (self messageFor: exception). exception pass ]
useDatabaseForClass: aClass self useDatabase: aClass databaseName
</methods> <methods> Store.SQLServerBroker class <category>private</category>
executeSQL: aString self sessionExecute: [ :session | session prepare: aString. session execute. ].
sessionExecute: aBlock | session | Cursor database showWhile:[ [ session := self connection getSession connect. session blockFactor: 1. aBlock value: session. session disconnect. ] on: self connectionClass externalDatabaseErrorSignal do: [ :exception | Dialog warn: (self messageFor: exception). exception return ]. ].
typeToStringMap ^( Dictionary new) at: #String put: 'varchar (255) null'; at: #PrimaryKey put: 'int not null'; at: #PrimaryKeyInteger put: 'int not null'; at: #PrimaryKeyString put: 'varchar (255) not null'; at: #PrimaryKeyShortString put: 'varchar (50) not null'; at: #PrimaryKeyChar put: 'char(1)'; at: #Text put: 'text null'; at: #Long put: 'int null'; at: #BinData put: 'image'; at: #Integer put: 'int null'; at: #Char put: 'char(1)'; at: #String32 put: 'varchar (32)' ; yourself.
</methods> <methods> Store.SQLServerBroker class <category>error handling</category>
alreadyExistErrors ^ Array with: self objectAlreadyExistisErrorNumber with: self indexAlreadyInTableErrorNumber
brokerSignals ^Signals isNil ifTrue: [ Signals := self signalCollection] ifFalse: [ Signals ]
databaseAlreadyExistsErrorNumber ^ 1801
databaseDoesntExistErrorNumber ^ 911
doesNotExistErrors ^ Array with: self objectAlreadyGoneErrorNumber with: self indexDoesntExistInSystemCatalogErrorNumber
indexAlreadyInTableErrorNumber ^ 1913
indexDoesntExistInSystemCatalogErrorNumber ^ 3703
invalidObjectErrorNumber ^ 208
loginAlreadyExistsErrorNumber ^ 15025
objectAlreadyExistisErrorNumber ^ 2714
objectAlreadyGoneErrorNumber ^ 3701
signalCollection ^ ( ExceptionSet new: 4) add: self connectionClass unableToExecuteSQLSignal; add: self connectionClass connectionNotOpenSignal; add: self connectionClass externalDatabaseInformationSignal; add: self connectionClass unableToPrepareSignal; yourself
userAlreadyExistsInDBErrorNumber ^ 15023
</methods> <methods> Store.SQLServerBroker class <category>drop objects</category>
dropDatabase: dbName Transcript show: 'Dropping database ' , dbName; cr. self process: 'USE master'. [ self processSQL: ('DROP database ' , dbName) asString. Transcript show: 'Database dropped'; cr. ] on: Error do: [ :exception | | err | (( err := exception parameter first ) notNil and: [ err dbmsErrorCode == self databaseDoesntExistErrorNumber]) ifTrue: [ Dialog warn: (self messageFor: exception). exception pass]. Dialog warn: (self messageFor: exception). ]
dropDatabaseFor: aClass self dropDatabase: aClass databaseName.
dropIndexForClass: aClass self dropIndexForClass: aClass index: aClass indexName.
dropIndexForClass: aClass index: aName self useDatabaseForClass: aClass. self performDrop: [self processSQL: 'DROP INDEX ' , (self tableNameWithPrefix: aClass) , '.' , aName] for: aClass name , aName
dropLogin: aName Transcript show: 'Dropping login ' , aName; cr. self process: ' USE master'. [ self processSQL: ('EXEC sp_droplogin ', aName ) ] on: Error do: [ :exception | Dialog warn: (self messageFor: exception). exception pass ]
dropSequenceForClass: aClass self dropTable: (self fullSeqTableName: aClass)
dropTableForClass: aClass self dropTable: ( self fullTableName: aClass)
dropUser: aName Transcript show: 'Dropping user ' , aName; cr. [ self processSQL: ('EXEC sp_dropuser ', aName ) ] on: Error do: [ :exception | Dialog warn: (self messageFor: exception). exception pass ]
dropViewForClass: aClass self useDatabaseForClass: aClass. self dropView: ( self tableNameWithPrefix: aClass).
performDrop: aBlock for: aName [ aBlock value ] on: self connectionClass unableToExecuteSQLSignal do: [ :exception | | err | ((err := exception parameter at: 1) dbmsErrorCode == self objectAlreadyGoneErrorNumber or: [ err dbmsErrorCode == self indexDoesntExistInSystemCatalogErrorNumber]) ifTrue: [ Transcript show: aName, ' already gone.'; cr. exception return ] ifFalse: [Dialog warn: (self messageFor: exception). exception pass] ].
</methods> <methods> Store.SQLServerBroker class <category>create objects 6.5</category>
addUserToDatabase: aDatabase self addUser: self tableOwner toDatabase: aDatabase. self processSQL: 'GRANT CREATE TABLE, CREATE VIEW, CREATE DEFAULT, CREATE PROCEDURE TO ', self tableOwner.
addUserToDB self addUserToDatabase: self fileNameForBlobs. self addUserToDatabase: self fileNameForClasses.
createDatabase: dbName onDevice: aDeviceName "Creates a new database. You must be in the master database to create a new database." "Device Is the logical name of the database device on which you want to put a database" Transcript show: 'Create database ' , dbName, ' on device ', aDeviceName; cr. self processSQL: ( 'CREATE DATABASE ' , dbName, ' ON ', aDeviceName) asString.
createDatabase: dbName onDevice: aDeviceName logOn: aLogDevice "Creates a new database. You must be in the master database to create a new database." "Device Is the logical name of the database device on which you want to put a database" "Log device is the name of the device that stores the database log" Transcript show: 'Create database ' , dbName, ' on device ', aDeviceName, ' log on ', aLogDevice; cr. self processSQL: ( 'CREATE DATABASE ' , dbName, ' ON ', aDeviceName, ' LOG ON ', aLogDevice) asString.
createDatabase: dbName onDevice: aDeviceName logOn: aLogDevice databaseSize: size "Creates a new database. You must be in the master database to create a new database." "Device Is the logical name of the database device on which you want to put a database" "Log device is the name of the device that stores the database log" Transcript show: 'Create database ' , dbName, ' on device ', aDeviceName, ' log on ', aLogDevice; cr. self processSQL: ( 'CREATE DATABASE ' , dbName, ' ON ', aDeviceName, ' = ', (self spaceStringFor: size), ' LOG ON ', aLogDevice) asString.
createDatabaseDevice65: aName path: aPath devNumber: aNumber size: aSize "Creates a device on which a database or multiple databases can be placed. A device is an operating-system file that SQL Server pre-allocates for database use. devNumber - Is the virtual device number. This number must be unique among the database devices associated with SQL Server. Values can be from 1 through 255; 0 is reserved for the MASTER database device. " | aStream | Transcript show: 'Create database device ' , aName, ' path ', aPath; cr. aStream := (String new: 100) writeStream. aStream nextPutAll: 'DISK INIT NAME = ' , aName, ', PHYSNAME = ''', aPath, ''', VDEVNO = '. aNumber printOn: aStream. aStream nextPutAll: ', SIZE = ', (self spaceStringFor: (self spaceIn2KFor: aSize)). self process: 'USE MASTER' asString. self process: aStream contents.
createPhysicalSpaces65 "Create the SQL Server device spaces used by Store." | aDict path account | aDict := Dictionary new. (self getParamsForDBDevices: aDict) isNil ifTrue: [ ^ false]. path := aDict at: #path. path isEmpty ifTrue: [ ^false ]. [ account := self isNewAccountCreated. "creating a Blob log device for Blob database" self createDatabaseDevice: ( aDict at: #logBlobName) path: (path asFilename constructString: ( aDict at: #logBlobName)) devNumber: (aDict at: #logBlobDev) size: self spaceForLogs. self createDatabase: ( aDict at: #logBlobName) onDevice: ( aDict at: #logBlobName). "creating a Class log device for Class database" self createDatabaseDevice: ( aDict at: #logClassName) path: (path asFilename constructString: ( aDict at: #logClassName)) devNumber: (aDict at: #logClassDev) size: self spaceForLogs. self createDatabase: ( aDict at: #logClassName) onDevice: ( aDict at: #logClassName). "creating database for BLOB" self createDatabaseDevice: ( aDict at: #blobName) path: (path asFilename constructString: ( aDict at: #blobName)) devNumber: (aDict at: #blobDev) size: self spaceForBlobs. self createDatabase: ( aDict at: #blobName) onDevice: ( aDict at: #blobName) logOn: ( aDict at: #logBlobName) databaseSize: self spaceForBlobs. "creating database for classes" self createDatabaseDevice: ( aDict at: #className) path: (path asFilename constructString: ( aDict at: #className)) devNumber: (aDict at: #classDev) size: self spaceForClasses. self createDatabase: ( aDict at: #className) onDevice: ( aDict at: #className) logOn: ( aDict at: #logClassName) databaseSize: self spaceForClasses. account ifTrue: [ self addUserToDB]. ] on: Error do: [ :exp | Dialog warn: exp description. ^false ]. ^true.
getParamsForDBDevices: aDict | path blobDevName classDevName blobDevNumber classDevNumber spec logBlobDevName logBlobDevNumber logClassDevName logClassDevNumber | path := nil asValue. blobDevName := (self fileNameForBlobs, '.dat') asValue. classDevName := (self fileNameForClasses, '.dat') asValue. logBlobDevName := (self fileNameForBlobs, 'Log.dat') asValue. logClassDevName := (self fileNameForClasses, 'Log.dat') asValue. blobDevNumber := 20 asValue. classDevNumber := 21 asValue. logBlobDevNumber := 22 asValue. logClassDevNumber := 23 asValue. spec := self createDevicesSpec. [ | dialog res | res := false. dialog := SimpleDialog new. dialog builder aspectAt: #path put: path. dialog builder aspectAt: #blobDevName put: blobDevName. dialog builder aspectAt: #classDevName put: classDevName. dialog builder aspectAt: #logBlobDevName put: logBlobDevName. dialog builder aspectAt: #logClassDevName put: logClassDevName. dialog builder aspectAt: #blobDevNumber put: blobDevNumber. dialog builder aspectAt: #classDevNumber put: classDevNumber. dialog builder aspectAt: #logBlobDevNumber put: logBlobDevNumber. dialog builder aspectAt: #logClassDevNumber put: logClassDevNumber. dialog builder add: (UISpecification from: spec). dialog preOpen. dialog builder openDialog. dialog accept value ifFalse: [^nil ]. path value isNil ifTrue: [ Dialog warn: 'You must specify path to create devices.' for: dialog builder window.] ifFalse: [res := true. aDict at: #blobName put: blobDevName value; at: #className put: classDevName value; at: #blobDev put: blobDevNumber value; at: #classDev put: classDevNumber value; at: #logBlobName put: logBlobDevName value; at: #logClassName put: logClassDevName value; at: #logBlobDev put: logBlobDevNumber value; at: #logClassDev put: logClassDevNumber value; at: #path put: path value.]. res ] whileFalse. ^aDict.
spaceForBlobsN "MB" ^ 16
spaceForClassesN "MB" ^32
spaceIn2KFor: aNumber "Specifies the size, in 2K blocks, of the database device. If you are planning to use the new database device to create a new database, the minimum size is 1 MB." ^ aNumber * 1024 / 2
spaceStringFor: aNumber | aStream | aStream := (String new: 5) writeStream. aNumber printOn: aStream. ^ aStream contents.
</methods> <methods> Store.SQLServerBroker class <category>private-accessing</category>
dismissSession: aSession ^ aSession dismiss
</methods> <methods> Store.SQLServerBroker class <category>grant statements</category>
availableGrantedPermissions "Lists permissions granted. When permissions are granted on a table or a view, the permission list can include one or more of the following items: " ^ 'SELECT, INSERT, DELETE, UPDATE' asString
availableGrantedStatements "Lists statements granted. The statement list can include the following statements" ^ #('CREATE DATABASE' 'CREATE DEFAULT' 'CREATE PROCEDURE' 'CREATE RULE' 'CREATE TABLE' 'CREATE VIEW' 'DUMP DATABASE' 'DUMP TRANSACTION')
grant: aPermissionList on: aTableName columnList: aColumnList to: aUserNameList "Assigns permissions to users." | aStream | aStream := (String new: 100) writeStream. aStream nextPutAll: 'GRANT ' . aPermissionList do: [ :each | aStream nextPutAll: (each, ', ')]. aStream skip: -2. aStream nextPutAll: (' ON ' , aTableName, ' ( ' ). aColumnList do: [ :each | aStream nextPutAll: (each, ', ')]. aStream skip: -2. aStream nextPutAll: ( ' ) ', ' TO '). aUserNameList do: [ :each | aStream nextPutAll: (each, ', ')]. aStream skip: -2. self processGrantStatement: aStream contents.
grantDBAccess: aDatabase self grantDBAccess: aDatabase to: self tableOwner. self processGrantStatement: 'GRANT CREATE TABLE, CREATE VIEW, CREATE DEFAULT, CREATE PROCEDURE TO ', self tableOwner.
grantDBAccess: aDatabase to: anAccount "Adds a security account in the current database " Transcript show: 'Granting DB access ' , anAccount, ' to DB ', aDatabase; cr. self useDatabase: aDatabase. self processGrantStatement: ( 'EXEC sp_grantdbaccess ' , anAccount, ', ', anAccount ) asString.
grantForClass: aClass permissions: aPermissionList columns: aColumnList toUsers: aUserNameList self useDatabaseForClass: aClass. super grantForClass: aClass permissions: aPermissionList columns: aColumnList toUsers: aUserNameList
grantForClass: aClass permissions: aPermissionList toUsers: aUserNameList self useDatabaseForClass: aClass. super grantForClass: aClass permissions: aPermissionList toUsers: aUserNameList.
grantForSeqClass: aClass permissions: aPermissionList toUsers: aUserNameList self useDatabaseForClass: aClass. super grantForSeqClass: aClass permissions: aPermissionList toUsers: aUserNameList
grantSequencePermissionsOn: aClass "Do nothing"
processGrantStatement: aString [ self processSQL: aString ] on: Error do: [ :exception | (exception parameter first dbmsErrorCode == self userAlreadyExistsInDBErrorNumber) ifTrue: [ Transcript show: exception parameter first dbmsErrorString; cr. exception return ] ifFalse: [ Dialog warn: (self messageFor: exception). DbRegistry goOffLine. exception pass ] ]
revokeDBAccess: aDatabase account: anAccount "Revokes a security account from the current database " Transcript show: 'Revoke DB access ' , anAccount, ' from DB ', aDatabase; cr. self useDatabase: aDatabase. self process: ( 'EXEC sp_revokedbaccess ' , anAccount, ', ', anAccount ) asString.
revokeForClass: aClass permissions: aPermissionList fromUsers: aUserNameList self useDatabaseForClass: aClass. super revokeForClass: aClass permissions: aPermissionList fromUsers: aUserNameList
</methods> <methods> Store.SQLServerBroker class <category>performance tuning</category>
createNonClusteredIndex: anIndex onTable: aTableName columns: aColumnsString "Creates an index on a given table that either changes the physical ordering of the table or provides the optimizer with a logical ordering of the table to increase efficiency for queries. When creating an index for the primary key, use the table- and column-level PRIMARY KEY constraint provided with the CREATE TABLE statement. " self process: ('CREATE NONCLUSTERED INDEX ' , anIndex, ' ON ' , aTableName, '( ', aColumnsString, ' )') asString.
dropIndex: anIndex onTable: aTableName "Removes an index from a database." self process: ('DROP INDEX ' , aTableName, '.', anIndex) asString.
</methods> <methods> Store.SQLServerBroker class <category>queries</category>
newSQLFor: aClass ^ self sqlAssistClass newSQLFor: aClass table: (self fullTableName: aClass)
nextIDQuery: aClass "Return the auto-sequenced IDENTITY column value most recently inserted. SQLServer assigned unique IDENTITY when row was inserted. This method retrieves it." ^ 'SELECT @@IDENTITY'
sqlAssistClass ^SQLAssistSQLServer
</methods> <methods> Store.SQLServerBroker class <category>create objects</category>
addIdentityFor: aColumn " For #PrimaryKey columns we add identity property. Identity columns are commonly used in conjunction with PRIMARY KEY constraints to serve as the unique row identifier for the table. " ^ (aColumn equivalentTo: 'primarykey' ignoreCase: true) ifTrue: [ ' IDENTITY (1,1) '] ifFalse: [ String new]
addLogin: aName self addLogin: aName password: aName
addLogin: aName password: aPass "Create SQL Server login account" Transcript show: 'Add login for ' , aName; cr. self process: 'USE master'. [ self processSQL: ( 'EXEC sp_addlogin ' , aName, ', ', aPass ) asString. ] on: Error do: [ :exception | | err | ((err := exception parameter first) dbmsErrorCode == self loginAlreadyExistsErrorNumber) ifTrue: [ Transcript show: err dbmsErrorString; cr. exception return ] ifFalse: [Dialog warn: (self messageFor: exception). exception pass] ].
addRoleToDB: aDatabase "Add the roles to the database" Transcript show: 'Add the role to the db ' , aDatabase; cr. self useDatabase: aDatabase. self process: ( 'EXEC sp_addrole ' , self tableOwner ) asString.
addRoleToDB: aDatabase role: aName "Add the roles to the database" Transcript show: 'Add the role to the db ' , aDatabase; cr. self useDatabase: aDatabase. self process: ( 'EXEC sp_addrole ' , aName ) asString.
addUser: anUser toDatabase: aDatabase "Add a username with the same login ID" Transcript show: 'Add user ' , anUser, 'To database ', aDatabase; cr. self useDatabase: aDatabase. self process: ( 'EXEC sp_adduser ' , anUser ) asString.
addUser: anUser toGroup: grName "Add the login accounts as database user accounts" Transcript show: 'Add user ' , anUser, ' to group ', grName; cr. self process: ( 'EXEC sp_adduser ' , anUser, ', ', anUser, ', ', grName ) asString.
addUser: anUser toGroup: grName toDatabase: dbName "Add the login accounts as database user accounts" Transcript show: 'Add user ' , anUser, ' to group ', grName, ' to database ' , dbName; cr. self process: ('USE ', dbName) asString. self process: ( 'EXEC sp_adduser ' , anUser, ', ', anUser, ', ', grName ) asString.
addUserGroup: grName toDatabase: dbName "Add user groups" Transcript show: 'Add user group ' , grName, ' to database ', dbName; cr. self process: ('USE ', dbName) asString. self process: ( 'EXEC sp_adduser ' , grName) asString.
chooseSQLServerVersion ^ Dialog choose: 'What SQL Server version do you want?' fromList: #('SQLServer 6.5' 'SQLServer 7') values: #(65 7) lines: 8 cancel: [#noChoice]
createDatabase: dbName onDevice: aDeviceName size: size "Creates a new database. You must be in the master database to create a new database. Device Is the logical name of the database device on which you want to put a database We check to see if the server version is 7.x. If it is greater, then we have the ability to do collations, if not then we fall back to the non collation create string" | createStatement array versionString | Transcript show: 'Creating database ' , dbName; cr. array := self processSQL: 'SELECT RIGHT(LEFT(@@VERSION,26),6)'. versionString := array first first. createStatement := ((versionString findString: '7.' startingAt: 1) > 0) ifTrue: [self sqlForNoColationOn: aDeviceName size: size name: dbName] ifFalse: [self sqlForColationOn: aDeviceName size: size name: dbName]. [self processSQL: createStatement] on: Error do: [:exception | | errors messageStream | messageStream := (String new: 100) writeStream. ((errors := exception parameter) notNil and: [errors isEmpty not]) ifTrue: [errors first dbmsErrorCode == self databaseAlreadyExistsErrorNumber ifTrue: [Transcript show: errors first dbmsErrorString; cr. exception return]. errors do: [:each | messageStream nextPutAll: each dbmsErrorString; cr]] ifFalse: [messageStream nextPutAll: exception errorString; cr]. Dialog warn: messageStream contents. exception pass]
createDatabaseSequence: aClass " Do nothing "
createDatabaseTable: aClass "Creates a new table." "database.[owner].]table_name - table name Is the name of the new table. Table names must conform to the rules for identifiers and must be unique within the database and for its owner." | aKeyCollection aStream | aKeyCollection := OrderedCollection new. aStream := (String new: 100) writeStream. aStream nextPutAll: (self createDatabaseTableColumnsFor: aClass keyNames: aKeyCollection). aStream nextPutAll: (self createTablePrimaryKeySectionFor: aClass keys: aKeyCollection). self createTable: (self fullTableName: aClass) columns: ' (', aStream contents, ') '.
createLogin self addLogin: self tableOwner
createMethodRetrievalIndex: aClass "Creates an index on a given table that either changes the physical ordering of the table or provides the optimizer with a logical ordering of the table to increase efficiency for queries." self createIndex: aClass indexName onTable: (self fullTableName: aClass) columns: aClass indexColumnNames
createNewAccount "Create the SQL Server security account." | str res | (self tableOwner equivalentTo: 'dbo' ignoreCase: true) ifTrue: [ ^ false]. str := (String new: 50) writeStream. str nextPutAll: 'Press Yes to create a new account: ', self tableOwner, ' password: ', self tableOwner;cr. str nextPutAll: 'Press No to use the dbo account';cr. str nextPutAll:'Press Cancel to cancel the installation'. res := Dialog choose: str contents labels: (Array with: 'Yes' with: 'No' with: 'Cancel') values: #(#yes #no #cancel) default: #maybe. res == #yes ifTrue: [ self createLogin. ^ true]. res == #no ifTrue: [ DbRegistry updateTablePrefix: 'dbo'. ^ false]. res == #cancel ifTrue: [ Error raiseSignal: 'Installation was canceled'].
createNewAccountDialog "Create the SQL Server security account." |dialog account password spec | (self tableOwner equivalentTo: 'dbo' ignoreCase: true) ifTrue: [ ^ false]. account := self tableOwner asValue. password := self tableOwner asValue. spec := self createNewAccountSpec. dialog := SimpleDialog new. dialog builder aspectAt: #account put: account. dialog builder aspectAt: #password put: password. dialog builder add: (UISpecification from: spec). dialog preOpen. dialog builder openDialog. dialog value inspect. " ^ account value isNil ifTrue: [ ] ifFalse: [ at: #account put: account value; at: #password put: password value; ]. " " res := Dialog choose: str contents labels: (Array with: 'Yes' with: 'No' with: 'Cancel') values: #(#yes #no #cancel) default: #maybe. res == #yes ifTrue: [ self createLogin. ^ true]. res == #no ifTrue: [ DbRegistry updateTablePrefix: 'dbo'. ^ false]. res == #cancel ifTrue: [ Error raiseSignal: 'Installation was canceled']. "
createPhysicalSpaces "Create the SQL Server device spaces used by Store." ^self createPhysicalSpaces7 " res := self chooseSQLServerVersion. res == 7 ifTrue: [ ^self createPhysicalSpaces7]. res == 65 ifTrue: [ ^self createPhysicalSpaces65]. ^ false. "
createPhysicalSpaces7 "Create the SQL Server device spaces used by Store." | path blobName className account | path := Dialog request: 'Please, enter directory for the data files.' initialAnswer: ''. path isEmpty ifTrue: [ ^false ]. blobName := path asFilename constructString: self fileNameForBlobs, '.mdf'. className := path asFilename constructString: self fileNameForClasses, '.mdf'. ^ [ account := self isNewAccountCreated. "creating database for BLOB" self createDatabase: self fileNameForBlobs onDevice: blobName size: self spaceForBlobs. "creating database for classes" self createDatabase: self fileNameForClasses onDevice: className size: self spaceForClasses. account ifTrue: [ self grantDBAccess ]. true ] on: Error do: [ :exp | false ].
createSourcesViewForClass: aClass "Creates a virtual table that represents an alternative way of looking at the data in one or more tables. You can use views as security mechanisms by granting permission on a view but not on underlying tables." self useDatabaseForClass: aClass. self createView: ( self tableNameWithPrefix: aClass ) selectStatement: ( self createViewSelectWithSourcesSQLForClass: aClass ). self grantForClass: aClass permissions: #('SELECT') toUsers: #('PUBLIC').
createTablePrimaryKeySectionFor: aClass keys: aKeyCollection | aStream pkStream | aStream := (String new: 100 ) writeStream. aKeyCollection isEmpty ifFalse: [aStream nextPutAll: 'PRIMARY KEY CLUSTERED('. pkStream := (String new: 100) writeStream. aKeyCollection do: [:each | pkStream nextPutAll: each , ', ']. pkStream skip: -2. aStream nextPutAll: pkStream contents , ')'; cr. ]. ^ aStream contents.
createViewForClass: aClass "Creates a virtual table that represents an alternative way of looking at the data in one or more tables. You can use views as security mechanisms by granting permission on a view but not on underlying tables." self useDatabaseForClass: aClass. self createView: ( self tableNameWithPrefix: aClass ) selectStatement: (self createViewSelectSQLForClass: aClass).
createViewSelectWithSourcesSQLForClass: aClass "Create the sql for a view that retrieves method comments in a join" "Modified so that it could keep better track of which columns were associated with which table, permitting the possibility of a view which joined the same table twice, and to allow the view class to specify which table the definition key was in" | aStream linkClasses mainClass definitionClasses refColumnNames allColumnNames items allColumns | aStream := (String new: 100) writeStream. linkClasses := aClass subCollectionClasses. mainClass := aClass referencedClass. definitionClasses := aClass definitionClasses. refColumnNames := self allColumnsFor: mainClass. allColumnNames := self allColumnsFor: aClass. items := OrderedCollection new. refColumnNames do: [:each | items add: each -> ((self tableNameWithPrefix: mainClass), '.', each)]. 1 to: linkClasses size do: [ :i | | eachLink eachDef defColumnNamesForViewList defColumnNamesForMatching linkColumnNames | eachLink := linkClasses at: i. eachDef := definitionClasses at: i. defColumnNamesForViewList := (aClass aliasedDefReferenceColumnNamesCollection at: i) asOrderedCollection. defColumnNamesForMatching := (aClass defReferenceColumnNamesCollection at: i) asOrderedCollection. refColumnNames := refColumnNames select: [:each | allColumnNames includes: each]. defColumnNamesForMatching size to: 1 by: -1 do: [ :j | (allColumnNames includes: (defColumnNamesForMatching at: j)) ifFalse: [ defColumnNamesForMatching removeIndex: j. defColumnNamesForViewList removeIndex: j ] ]. linkColumnNames := (self allColumnsFor: eachLink) select: [:each | allColumnNames includes: each]. linkColumnNames do: [:each | items add: each -> ((self tableNameWithPrefix: eachLink), '.', each)]. defColumnNamesForMatching with: defColumnNamesForViewList do: [:instVarName :columnName | items add: instVarName -> ((self fullTableName: eachDef), '.', columnName)]]. allColumns := self allColumnsFor: aClass. allColumns do: [ :each | | match | match := items detect: [:eachAssociation | eachAssociation key = each] ifNone: [nil]. match isNil ifFalse: [ aStream nextPutAll: match value. each == allColumns last ifFalse: [ aStream nextPutAll: ', ' ] ] ]. self printTableListAndWhereClauseForViewWithSourcesFrom: mainClass to: definitionClasses via: linkClasses for: aClass on: aStream. ^ aStream contents
defWhereClauseFor: aClass withDefClass: defClass | position defRefClass column defIsOptional | position := aClass definitionClasses indexOf: defClass. defRefClass := aClass definitionReferenceClasses at: position. column := aClass definitionReferenceColumns at: position. defIsOptional := aClass definitionsAreOptional at: position. ^'(', (self tableNameWithPrefix: defRefClass) , '.' , (self columnName: column for: defClass), ' = ', (self fullTableName: defClass) , '.' , (self columnName: 'primaryKey' for: defClass), ((defIsOptional not or: [self ansiOuterJoins]) ifTrue: [')'] ifFalse: [' (+))']).
grantDBAccess self grantDBAccess: self fileNameForBlobs. self grantDBAccess: self fileNameForClasses.
installPhysicalSpaces "Create the SQL Server device spaces used by Store." | path blobName className account | DbRegistry goToScript ifFalse: [ (Dialog confirm: 'Create data files?') ifFalse: [ ^true ]]. path := Dialog request: 'Please, enter directory for the databases.' initialAnswer: ''. path isEmpty ifTrue: [ ^nil ]. blobName := path asFilename constructString: self fileNameForBlobs, '.mdf'. className := path asFilename constructString: self fileNameForClasses, '.mdf'. Transcript show: ' '; cr. Transcript show: 'Starting installation...';cr. ^ [ account := self isNewAccountCreated. "creating database for BLOB" self createDatabase: self fileNameForBlobs onDevice: blobName size: self spaceForBlobs. "creating database for classes" self createDatabase: self fileNameForClasses onDevice: className size: self spaceForClasses. account ifTrue: [ self grantDBAccess ]. true ] on: Error do: [ :exp | nil ].
isLoginExist: aName self process: ' USE master'. ^ [ self processSQL: ( 'EXEC sp_addlogin ' , aName, ', ', aName ) asString. self processSQL: ('EXEC sp_droplogin ', aName ). false ] on: Error do: [ :exception | | err | ((err := exception parameter first) dbmsErrorCode == self loginAlreadyExistsErrorNumber) ifTrue: [ Transcript show: err dbmsErrorString; cr. exception return: true] ifFalse: [exception return: false] ].
isNewAccountCreated (self tableOwner equivalentTo: 'dbo' ignoreCase: true) ifTrue: [ ^ false]. ^ DbRegistry goToScript ifFalse: [(self isLoginExist: self tableOwner) ifTrue: [ true] ifFalse: [ self createNewAccount ]] ifTrue: [self createLogin. true ]
printTableListAndWhereClauseForViewWithSourcesFrom: mainClass to: definitionClasses via: linkClasses for: aClass on: aStream aStream nextPutAll: ' FROM '. aStream nextPutAll: (self tableNameWithPrefix: mainClass). self ansiOuterJoins ifTrue: [ linkClasses with: definitionClasses do: [ :eachLink :eachDefinition | | defIsOptional | defIsOptional := aClass definitionsAreOptional at: (linkClasses indexOf: eachLink). defIsOptional ifTrue: [aStream nextPutAll: ' LEFT OUTER JOIN '] ifFalse: [aStream nextPutAll: ' JOIN ']. aStream nextPutAll: (self tableNameWithPrefix: eachLink). aStream nextPutAll: ' ON ('. aStream nextPutAll: (self collWhereClauseFor: aClass from: mainClass collClass: eachLink). aStream nextPutAll: ') '. defIsOptional ifTrue: [aStream nextPutAll: ' LEFT OUTER JOIN '] ifFalse: [aStream nextPutAll: ' JOIN ']. aStream nextPutAll: (self fullTableName: eachDefinition). aStream nextPutAll: ' ON ('. aStream nextPutAll: (self defWhereClauseFor: aClass withDefClass: eachDefinition). aStream nextPutAll: ') '] ] ifFalse: [ aStream nextPutAll: ', '. linkClasses , definitionClasses do: [:each | aStream nextPutAll: (self tableNameWithPrefix: each). each == definitionClasses last ifFalse: [aStream nextPutAll: ', ']]. aStream nextPutAll: ' WHERE '. linkClasses with: definitionClasses do: [ :eachLink :eachDefinition | eachLink == linkClasses first ifFalse: [aStream nextPutAll: ' AND ']. aStream nextPutAll: (self collWhereClauseFor: aClass from: mainClass collClass: eachLink). aStream nextPutAll: ' AND ' , (self defWhereClauseFor: aClass withDefClass: eachDefinition) ] ]
spaceForLogs ^ 8
sqlForColationOn: aDeviceName size: size name: dbName ^'CREATE DATABASE ' , dbName , ' ON ( NAME = ' , dbName , '_dat, ' , ' FILENAME = ''' , aDeviceName , ''', ' , ' SIZE = ' , size , ') COLLATE Latin1_General_CS_AS'
sqlForNoColationOn: aDeviceName size: size name: dbName ^'CREATE DATABASE ' , dbName , ' ON ( NAME = ' , dbName , '_dat, ' , ' FILENAME = ''' , aDeviceName , ''', ' , ' SIZE = ' , size , ')'
</methods> <methods> Store.SQLServerBroker class <category>connection class</category>
connectionClass ^Store.MS_SQLServerConnection
</methods> <methods> Store.SQLServerBroker class <category>sql processing</category>
nextIDForClass: aClass "Answer the next number in the sequence established for artifact. Coerce to Integer (current ODBC mapping yields fixed point)." ^(super nextIDForClass: aClass) asInteger
</methods> <methods> Database.ODBCBuffer <category>accessing</category>
bufferValue ^bufferValue
value: aValue bufferValue := aValue. super value: bufferValue.
</methods> <methods> Database.ODBCSession <category>private-answer set</category>
getLargeObjectData self rowBuffers do: [ :buf | (buf isKindOf: ODBCLargeObjectBuffer) ifTrue: [ buf getData. ] ].
</methods> <methods> Database.ODBCSession <category>private-execution</category>
getParameterValueAddress: prgbValue "SQLParamData is used in conjunction with SQLPutData to supply parameter data at statement execution time." | xif rc | xif := self class xif. rc := xif SQLParamData: self hstmt with: prgbValue. (traceLevel >= 3) ifTrue: [ (self traceStream) print: rc; nextPutAll: ' = SQLParamData( hstmt = '; nextPutAll: (self hstmt referentAddress printStringRadix: 16); nextPutAll: ', prgbValue= '; nextPutAll: (prgbValue referentAddress printStringRadix: 16); nextPutAll: ' )'. self class trace: self emitTrace ]. ^(rc == xif SQL_ERROR) ifTrue: [| errs | errs := self getStatementErrors. self class connectionClass unableToBindSignal raiseWith: errs ] ifFalse: [ rc ].
</methods> <methods> Database.ODBCLargeObjectBuffer <category>binding</category>
bindForInputOld "Prepare the receiver to put data for an unbound parameter." fParamType := bufferSession class xif SQL_PARAM_INPUT. "We won't re-use pointers." (bufferPointer isNil) ifFalse:[ self free]. "Allocate CPointers to hold data and the size of the data " self mallocUsingSelector: bufferSession class xif mallocSelector. "For unbound buffers the data it represents is sent only when the server requests it. To facilitate this process we only bind the receiver's index so that the server can later specify which instance of the receiver that it wants data for." self at: 1 putInteger: bufferIndex. pcbValue contents: bufferSession class xif SQL_DATA_AT_EXEC. ^super bindInputExternal
</methods> <methods> Database.ODBCLargeObjectBuffer <category>private-binding</category>
bindInputExternalOld "Bind the contents of the receiver to the server." | rc xif valueStream | xif := bufferSession class xif. valueStream := ReadStream on: bufferValue. [valueStream atEnd ] whileFalse: [ "Ensure that proper conversion takes place." self at: 1 put: (valueStream nextAvailable: (bufferSession getDataChunkSize min: cbColDef)). rc := xif SQLPutData: bufferSession hstmt with: bufferPointer with: cbColDef. "pcbValue contents." (bufferSession traceLevel >= 3 ) ifTrue: [ (bufferSession traceStream) print: rc; nextPutAll: ' = SQLPutData( hstmt = '; nextPutAll: (bufferSession hstmt referentAddress printStringRadix: 16); nextPutAll: ', rgbValue = '; nextPutAll: (bufferPointer referentAddress printStringRadix: 16); nextPutAll: ', cbValue = '; print: pcbValue contents; nextPutAll: ' )'. bufferSession class trace: bufferSession emitTrace ]. (rc == xif SQL_ERROR or: [ rc == xif SQL_SUCCESS_WITH_INFO ]) ifTrue: [| errs | errs := bufferSession getStatementErrors. errs inspect. ^bufferSession class connectionClass unableToBindSignal raiseWith: errs ] ].
bindOutputExternalOld "Retrieve data from unbound result column. We only copy up to maxBytesToCopy" | rc xif copyIndex maxBytesToCopy cbValue | xif := bufferSession class xif. copyIndex := 0. cbValue := cbValueMax. bufferValue := OrderedCollection new: 0. maxBytesToCopy := (bufferSession getMaxLongData min: cbColDef ). [copyIndex >= maxBytesToCopy ] whileFalse: [ cbValue := ((maxBytesToCopy - copyIndex) min: cbValueMax). rc := xif SQLGetData: bufferSession hstmt with: bufferIndex with: self fCType with: bufferPointer with: cbValue with: pcbValue. (bufferSession traceLevel >= 3 ) ifTrue: [(bufferSession traceStream) print: rc; nextPutAll: ' = SQLGetData( hstmt = '; nextPutAll: (bufferSession hstmt referentAddress printStringRadix: 16); nextPutAll: ' )'. bufferSession class trace: bufferSession emitTrace ]. ((rc == xif SQL_ERROR ) or: [ rc == xif SQL_SUCCESS_WITH_INFO ] ) ifTrue: [ | errs | errs := bufferSession getStatementErrors. (errs at: 1) sqlState = '01004' ifTrue: ["Data was truncated. Ensure that we don't copy more than maxBytesToCopy." pcbValue contents: (maxBytesToCopy min: cbValueMax) ] ifFalse: [ ^bufferSession class connectionClass unableToBindSignal raiseWith: errs ] ]. ((rc == xif SQL_SUCCESS ) or: [ rc == xif SQL_NO_DATA_FOUND ]) ifTrue: ["All the data for the receiver has been received. Ensure that we don't copy more than maxBytesToCopy." pcbValue contents: (maxBytesToCopy min: pcbValue contents). copyIndex := maxBytesToCopy + 1. ] ifFalse: [ copyIndex := copyIndex + cbValue]. "Convert the data chunk to an appropriate object and add it." bufferValue add: super value]
getData "Retrieve data from unbound result column. We only copy up to maxBytesToCopy" | rc xif copyIndex maxBytesToCopy cbValue | xif := bufferSession class xif. copyIndex := 0. cbValue := cbValueMax. bufferValue := OrderedCollection new: 0. maxBytesToCopy := bufferSession getMaxLongData min: cbColDef. [copyIndex >= maxBytesToCopy ] whileFalse: [ cbValue := ((maxBytesToCopy - copyIndex) min: cbValueMax). rc := xif SQLGetData: bufferSession hstmt with: bufferIndex with: self fCType with: bufferPointer with: cbValue with: pcbValue. (bufferSession traceLevel >= 3 ) ifTrue: [(bufferSession traceStream) print: rc; nextPutAll: ' = SQLGetData( hstmt = '; nextPutAll: (bufferSession hstmt referentAddress printStringRadix: 16); nextPutAll: ' )'. bufferSession class trace: bufferSession emitTrace ]. ((rc == xif SQL_ERROR ) or: [ rc == xif SQL_SUCCESS_WITH_INFO ] ) ifTrue: [ | errs | errs := bufferSession getStatementErrors. (errs at: 1) sqlState = '01004' ifTrue: ["Data was truncated. Ensure that we don't copy more than maxBytesToCopy." pcbValue contents: (maxBytesToCopy min: cbValueMax) ] ifFalse: [ ^bufferSession class connectionClass unableToBindSignal raiseWith: errs ] ]. ((rc == xif SQL_SUCCESS ) or: [ rc == xif SQL_NO_DATA_FOUND ]) ifTrue: ["All the data for the receiver has been received. Ensure that we don't copy more than maxBytesToCopy." pcbValue contents: (maxBytesToCopy min: pcbValue contents). copyIndex := maxBytesToCopy + 1. ] ifFalse: [ copyIndex := copyIndex + cbValue]. "Convert the data chunk to an appropriate object and add it." bufferValue add: super value]
putData "Bind the contents of the receiver to the server." | rc xif valueStream chunkSize streamToPut | xif := bufferSession class xif. valueStream := ReadStream on: bufferValue. chunkSize := bufferSession getDataChunkSize min: cbColDef. [valueStream atEnd ] whileFalse: [ "Ensure that proper conversion takes place." streamToPut := valueStream nextAvailable: chunkSize. self at: 1 put: streamToPut. rc := xif SQLPutData: bufferSession hstmt with: bufferPointer with: streamToPut size. (bufferSession traceLevel >= 3 ) ifTrue: [ (bufferSession traceStream) print: rc; nextPutAll: ' = SQLPutData( hstmt = '; nextPutAll: (bufferSession hstmt referentAddress printStringRadix: 16); nextPutAll: ', rgbValue = '; nextPutAll: (bufferPointer referentAddress printStringRadix: 16); nextPutAll: ', cbValue = '; print: pcbValue contents; nextPutAll: ' )'. bufferSession class trace: bufferSession emitTrace ]. (rc == xif SQL_ERROR or: [ rc == xif SQL_SUCCESS_WITH_INFO ]) ifTrue: [| errs | errs := bufferSession getStatementErrors. errs inspect. ^bufferSession class connectionClass unableToBindSignal raiseWith: errs ] ].
</methods> <methods> Database.ODBCLargeObjectBuffer <category>accessing</category>
value: aStream cbColDef := aStream contents size. bufferValue := aStream contents. super value: bufferValue. self bindInputExternal.
</methods> <methods> Store.SQLServerBroker class <category>interface specs</category>
createDevicesSpec "UIPainter new openOnClass: self andSelector: #createDevicesSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Creating databases' #min: #(#{Core.Point} 465 470 ) #max: #(#{Core.Point} 465 470 ) #bounds: #(#{Graphics.Rectangle} 295 152 760 622 ) #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 18 11 ) #label: 'To create database devices, please, specify the information:' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 23 49 ) #label: 'Directory:' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 52 101 ) #label: 'Device name:' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 52 186 ) #label: 'Device name:' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 52 124 ) #label: 'Virtual device number:' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 52 211 ) #label: 'Virtual device number:' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 19 80 446 161 ) #label: 'Device for Blobs' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 19 163 446 244 ) #label: 'Device for Classes' ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 378 428 450 452 ) #model: #cancel #label: 'Cancel' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 299 428 371 452 ) #model: #accept #label: 'OK' #isDefault: true #defaultable: true ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 120 49 444 75 ) #name: #path #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #path ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 194 94 404 118 ) #name: #blobDevName #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #blobDevName ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 194 128 296 152 ) #name: #blobDevNumber #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #blobDevNumber #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 194 179 404 203 ) #name: #classDevName #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #classDevName ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 194 213 295 237 ) #name: #classDevNumber #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #classDevNumber #type: #number ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 52 275 ) #label: 'Device name:' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 52 302 ) #label: 'Virtual device number:' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 19 249 446 330 ) #label: 'Device for Blob Log' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 194 264 404 288 ) #name: #logBlobDevName #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #logBlobDevName ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 194 299 296 323 ) #name: #logBlobDevNumber #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #logBlobDevNumber #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 194 352 404 376 ) #name: #logClassDevName #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #logClassDevName ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 52 363 ) #label: 'Device name:' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 52 390 ) #label: 'Virtual device number:' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 19 337 446 418 ) #label: 'Device for Classes Log' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 194 386 296 410 ) #name: #logClassDevNumber #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #logClassDevNumber #type: #number ) ) ) )
createNewAccountSpec "UIPainter new openOnClass: self andSelector: #createNewAccountSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Creating new account' #min: #(#{Core.Point} 317 216 ) #max: #(#{Core.Point} 317 216 ) #bounds: #(#{Graphics.Rectangle} 354 276 671 492 ) #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 27 16 ) #label: 'Enter new account name and password, and press OK. ' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 25 102 ) #label: 'Account Name:' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 33 136 ) #label: 'Password:' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 109 98 282 123 ) #name: #account #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #account ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 109 132 282 157 ) #name: #password #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#ColorValue #white ) ) #model: #password ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 12 78 295 172 ) #label: 'New Account' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 25 35 ) #label: 'Press No to use the dbo account. ' ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 116 184 198 205 ) #model: #accept #label: 'Create' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 210 184 292 205 ) #model: #cancel #label: 'Cancel' #defaultable: true ) ) ) )
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>SQLAssist</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none tableName tableClass sqlStream alias <imports></imports> <category>Store-DB-Broker</category> <attributes> <package>Store-DB-Broker</package> </attributes> </class> <class> <name>ODBCConnection</name> <environment>Database</environment> <super>Database.ExternalDatabaseConnection</super> <private>false</private> none hdbcHolder supportedFunctions generalInformationCache encoding unicodeEncoding <imports></imports> <category>Database-ODBC</category> <attributes> <package>ODBCEXDI</package> </attributes> </class> <class> <name>ODBCBuffer</name> <environment>Database</environment> <super>Database.ExternalDatabaseBuffer</super> <private>false</private> none bufferValue bufferIndex bufferSession fParamType cbColDef ibScale cbValueMax pcbValue getSelector putSelector unicode <imports></imports> <category>Database-Private-ODBC Buffers</category> <attributes> <package>ODBCEXDI</package> </attributes> </class> <class> <name>ODBCLargeObjectBuffer</name> <environment>Database</environment> <super>Database.ODBCBuffer</super> <private>false</private> none <imports></imports> <category>Database-Private-ODBC Buffers</category> <attributes> <package>ODBCEXDI</package> </attributes> </class> <class> <name>ODBCSession</name> <environment>Database</environment> <super>Database.ExternalDatabaseSession</super> <private>false</private> none hstmtHolder resultsCache bindValuePointers mustResendQueryHolder fetchLongResultsAnyOrder maxLongData sqlStatementOptionCache queryIsPROC unicode encoding unicodeEncoding <imports></imports> <category>Database-ODBC</category> <attributes> <package>ODBCEXDI</package> </attributes> </class> <class> <name>SQLBroker</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Store-DB-Broker</category> <attributes> <package>Store-DB-Broker</package> </attributes> </class>