[RESOLVED] Creats an access database

[franki]

Hi All,
I have recently downlodaed some code that displays images which i have found very useful. In the sample app that i downloaded there was a form that let you create access databases. I clicked it and hey presto it created a database! only problem is I have searched through all the code but I cant work out how it does it????. I have included the code below that starts when you click the make database button.
If anyone could help me out I will be over the moon....

Private Sub LaVolpeButton3_Click()
    With frmMain.CommonDialog1
        .DialogTitle = "Create a very new database"
        .Filter = "Archive Design Database |*.mdb"
        .Flags = cdlOFNExplorer Or cdlOFNHideReadOnly
        .FileName = ""
        .ShowSave
    End With
    
    If frmMain.CommonDialog1.FileName = "" Then Exit Sub
    'filecopy copies a file -which file?
    FileCopy App.path & "\shell", frmMain.CommonDialog1.FileName
 
    If TestDb(frmMain.CommonDialog1.FileName) = True Then
        srcDB = frmMain.CommonDialog1.FileName
        lblDatabase.Caption = srcDB
        frmMain.loadcat
        frmMain.ListView1.ListItems.Clear
    End If
    
End Sub

Thanks
Franki

[robbedaya]

I think it doesn't create a database.
I think it just copy's a file called "Shell" (probably an empty database) to the location specified.

[Hack]

I think it doesn't create a database.
I think it just copy's a file called "Shell" (probably an empty database) to the location specified.

I think you are right.

Is there a Shell.mdb with this download?

[franki]

There is a shell file with the download but it does not show the file extension. It will not open up with access but it does open using the visual data manager, and yes it does appear to be an empty mdb file. This is great because i can now make changes to the database and then save it again as an empty database.
Thanks for all your input.
Franki

[franki]

Just a quick one regarding table relationships. In the Visual Data Manager there doesnt seem to be a utility for joining tables together. anyone know how to do it using Vis? (Not access)

[rory]

Dont Know about that .. this is creating a database ..
(Ref to Microsoft ADO Ext. 2.8 For DDL and Security)
(also see attachment for example project)

Dim cat As ADOX.Catalog
    Dim tblNew As ADOX.Table
    Dim idx As ADOX.Index
    Set cat = New ADOX.Catalog
    '// CREATE DATABASE
    cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\myfile.mdb;" & _
                "Jet OLEDB:Database Password=mypass; Jet OLEDB:Encrypt Database=True;"
    Set tblNew = New ADOX.Table
    '// CREATE TABLE
    With tblNew
        .Name = "Table1"
        .ParentCatalog = cat
        .Columns.Append "Table1_Id", adInteger                      ' NUMBER FIELD
        .Columns("Table1_Id").Properties("Autoincrement") = True   
        .Columns("Table1_Id").Properties("Increment") = CLng(1)
        .Columns("Table1_Id").Properties("Seed") = CLng(1)
        .Columns.Append "Table1_Field1", adVarWChar, 255            ' TEXT FIELD
        .Columns.Append "Table1_Field2", adVarWChar, 255            ' TEXT FIELD
        .Columns.Append "Table1_Field3", adInteger                  ' NUMBER FIELD
    End With
    cat.Tables.Append tblNew
    Set idx = New ADOX.Index
    '// SET PRIMARY KEY
    With idx
        .Name = "PrimaryKey"
        .Columns.Append "Table1_Id"
        .PrimaryKey = True
        .Unique = True
    End With
    tblNew.Indexes.Append idx
    Set idx = Nothing
    Set cat = Nothing

[franki]

Neat, I'll have a mess around with that.

[rory]

and just for kicks you can add this to lock the database .. changes the headers so access wont open it .. and then you can also name it anything you want .. just something extra to throw the hackers off .. called in the open and close of the database objects .. i just pulled this out of an existing program i wrote so didnt check it for errors .. (someone else wrote the original "lock")

Public Enum LockDatabase
   LockData = 1
   UnlockData = 2
End Enum
 
'// OPEN DATABASE CONNECTION
'Public Sub Open_Database()
'    Database_UnLock
'    Set objConn = CreateObject("ADODB.Connection")
'    objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
'    App.Path & "\myfile.dll"
'End Sub
 
'// CLOSE DATABASE CONNECTION
' Public Sub Close_Database()
'    If Not objConn Is Nothing Then
'        If objConn.State = adStateOpen Then objConn.Close
'    End If
'    Set objConn = Nothing
'    Database_Lock
'End Sub
 
'// LOCK DATABASE
Public Sub Database_Lock()
    Lock_Database App.Path & "\myfile.dll", 1
End Sub
 
'// PUBLIC SUB ROUTINE: UNLOCK DATABASE
Public Sub Database_UnLock()
    Lock_Database App.Path & "\myfile.dll", 2
End Sub
 
'// LOCK DATABASE PROCESS
Public Sub Lock_Database(sPath As String, iAction As LockDatabase)
    
    Dim hGet        As String
    Dim iFreeFile   As Integer
    Dim iLoop       As Long
    Dim lLoc        As Long
    Dim sString
    Dim lLoop
    
    'If DoesFileExist(App.Path & "\myfile.dll") = True Then
    
        hGet = vbNullString
        iFreeFile = FreeFile()
        Open sPath For Binary As #iFreeFile
        lLoc = 1
        Select Case iAction
            Case 1
                sString = cmdEnc(strEncrKey)
                For lLoop = 5 To 19
                    Put #iFreeFile, lLoop, Mid$(sString, lLoop - 4, 1)
                Next lLoop
            Case 2
                sString = cmdEnc(strEncrKey)
                For lLoop = 5 To 19
                    hGet = hGet & Mid$(sString, lLoop - 4, 1)
                Next lLoop
                lLoc = 1
            
                If cmdDec(hGet) = strEncrKey Then
                    sString = "Standard Jet DB"
                    For lLoop = 5 To 19
                        Put #iFreeFile, lLoop, Mid$(sString, lLoop - 4, 1)
                    Next lLoop
                End If
        End Select
        Close #iFreeFile
    'End If
        
End Sub
 
'// DOES FILE EXIST - FSO
Public Function DoesFileExist(ByVal Filename As String) As Boolean
    On Error Resume Next
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FileExists(Filename)) Then
        DoesFileExist = True
    Else
        DoesFileExist = False
    End If
    Set fso = Nothing
End Function

[Simply Me]

rory, your code is nice but one thing, I tried to download you create database and run it. Now, I tried to delete the create database and it cannot be deleted why?

[rory]

Dunno .. . I can delete the Database file without a problem .. what error are you getting..?

[Simply Me]

ooppss. Im sorry rory, it not your code the causes it. its my computer for some reason it does not allow me.

Anyway, how do I implement the lock and unlock database?

[rory]

same as i put above, you unlock the database before you open it .. and lock it when you close it ... just change the name of the DB to your own ..

I just included the Open and Close Database Subs as an example .. you can use your own ..

The DoesFileExist check can be changed to your own also, its just what I used.

[edit] i commented out the stuff you can change to your own ..

[Simply Me]

I just pasted you code below the code in the zip file and it seems not working. Also the Function DoesFileExist is not checking if it exist. Everytime i clicked the button it says in my immediate window Database created.

[rory]

Ok yeah. its not entierly related .. it takes a little more than that . .. ill post something that combines the 2 of them ..

[Simply Me]

will the creation of database take care also of the relationships?

[rory]

Not in the example i posted, you will need to take it further yourself on that part .. sorry :-)

Here are 2 integrated examples .. both use the lock and unlock subs .. and both use a password when creating the database ..

one of them also goes further using a well known open source VB encryption on the password .. locks yah right out though so you would need to do all Database related stuff within your code .. or add the encrypted pass to text box and copy it .. then use Ctrl-V to paste it into a Database password box ..