' Gambas class file STATIC PRIVATE $cType AS Collection PUBLIC Server AS CServer PUBLIC Database AS String PRIVATE $sKey AS String STATIC PUBLIC SUB _init() $cType = NEW Collection $cType[gb.Boolean] = "Boolean" $cType[gb.Integer] = "Integer" $cType[gb.Long] = "Long" $cType[gb.Float] = "Float" $cType[gb.Date] = "Date" $cType[gb.String] = "String" $cType[db.Serial] = "Serial" $cType[db.Blob] = "Blob" END PUBLIC SUB Form_Open() DIM sProject AS String sProject = File.Name(FMain.Project) lblProject.Text = "" & sProject & "
" & File.Dir(FMain.Project) lblServer.Text = Server.Name lblDatabase.Text = Database imgIcon.Picture = FMain.GetProjectIcon(FMain.Project, 48) $sKey = Replace("/Code" &/ sProject &/ Server.Key &/ Database, " ", "_") 'txtModule.Text = FMain.Config.ReadString($sKey &/ "Module", "MDatabase") 'txtProcedure.Text = FMain.Config.ReadString($sKey &/ "Procedure", "CreateDatabase") 'chkUpdate.Value = FMain.Config.ReadString($sKey &/ "AutoUpdate", FALSE) txtModule.Text = Settings[$sKey &/ "Module", "MDatabase"] txtProcedure.Text = Settings[$sKey &/ "Procedure", "CreateDatabase"] chkUpdate.Value = Settings[$sKey &/ "AutoUpdate", FALSE] END PRIVATE FUNCTION WriteConfig(bCheck AS Boolean) AS Boolean DIM sModule AS String DIM sProc AS String sModule = Trim(txtModule.Text) IF NOT sModule THEN IF bCheck THEN Message.Warning(("Please enter a module name.")) txtModule.SetFocus RETURN TRUE ENDIF ELSE 'FMain.Config.WriteString($sKey &/ "Module", sModule) Settings[$sKey &/ "Module"] = sModule ENDIF sProc = Trim(txtProcedure.Text) IF NOT sProc THEN IF bCheck THEN Message.Warning(("Please enter a procedure name.")) txtProcedure.SetFocus RETURN TRUE ENDIF ELSE 'FMain.Config.WriteString($sKey &/ "Procedure", sProc) Settings[$sKey &/ "Procedure"] = sProc ENDIF 'FMain.Config.WriteString($sKey &/ "AutoUpdate", chkUpdate.Value) Settings[$sKey &/ "AutoUpdate"] = chkUpdate.Value END PUBLIC SUB btnGenerate_Click() IF WriteConfig(TRUE) THEN RETURN IF GenerateCode(Server, Database) THEN RETURN ME.Close(TRUE) END STATIC PUBLIC FUNCTION GenerateCode(hServer AS CServer, sDatabase AS String) AS Boolean DIM sKey AS String DIM sPath AS String DIM sModule AS String DIM sProc AS String DIM sTemp AS String DIM hFile AS File DIM hTemp AS File DIM bWaitEnd AS Boolean DIM sLine AS String DIM bDone AS Boolean sKey = "/Code" &/ FMain.Project &/ hServer.Key &/ sDatabase 'sModule = FMain.Config.ReadString(sKey &/ "Module", "MDatabase") sModule = Settings[sKey &/ "Module", "MDatabase"] 'sProc = FMain.Config.ReadString(sKey &/ "Procedure", "CreateDatabase") sProc = Settings[sKey &/ "Procedure", "CreateDatabase"] sPath = FMain.Project &/ sModule & ".module" sTemp = Temp$() OPEN sTemp FOR CREATE AS #hTemp bDone = FALSE IF Exist(sPath) THEN OPEN sPath FOR READ AS #hFile WHILE NOT Eof(hFile) LINE INPUT #hFile, sLine IF bWaitEnd THEN IF UCase(Trim(sLine)) = "END" THEN bWaitEnd = FALSE ENDIF CONTINUE ENDIF IF sLine LIKE ("PROCEDURE " & sProc & "(*") THEN bWaitEnd = TRUE DumpCode(hTemp, sProc, hServer, sDatabase) bDone = TRUE CONTINUE ENDIF PRINT #hTemp, sLine WEND CLOSE #hFile ELSE PRINT #hTemp,"' Gambas module file\n" ENDIF IF NOT bDone THEN DumpCode(hTemp, sProc, hServer, sDatabase) CLOSE #hTemp TRY KILL sPath COPY sTemp TO sPath TRY KILL sTemp CATCH Message.Error(("Cannot generate Gambas code.") & "\n" & Subst(("Server: &1"), hServer.Name) & "\n" & Subst(("Database: &1"), sDatabase) & "\n\n" & Error.Text) RETURN TRUE END STATIC PRIVATE SUB DumpCode(hFile AS File, sProc AS String, hServer AS CServer, sDatabase AS String) DIM hConn AS CConnection DIM sType AS String DIM hTable AS Table DIM hField AS Field DIM hIndex AS Index DIM sField AS String DIM bIndex AS Boolean DIM bFirst AS Boolean hConn = NEW CConnection(hServer, sDatabase, TRUE) hConn.Open PRINT #hFile, "PROCEDURE " & sProc & "(hConn AS Connection, sDatabase AS String)\n" PRINT #hFile, " ' Generated by the Gambas database manager - "; Now; "\n" PRINT #hFile, " DIM hTable AS Table\n" FOR EACH hTable IN hConn.Handle.Tables IF hTable.System THEN CONTINUE WITH hTable PRINT #hFile, " hTable = hConn.Tables.Add(\"" & .Name & "\""; IF .Type THEN PRINT #hFile, ", \"" & .Type & "\""; PRINT #hFile, ")\n" PRINT #hFile, " WITH hTable\n" FOR EACH hField IN hTable.Fields WITH hField PRINT #hFile, " .Fields.Add(\"" & .Name & "\", db." & $cType[.Type]; IF .Type = gb.String THEN PRINT #hFile, ", " & .Length; IF .Default THEN PRINT #hFile, ", \"" & .Default & "\""; ENDIF ELSE IF NOT IsNull(.Default) THEN PRINT #hFile, ", , "; IF .Type = gb.Date THEN PRINT #hFile, "CDate(\"" & CStr(.Default) & "\")"; ELSE IF .Type = gb.Boolean THEN PRINT #hFile, If(.Default, "TRUE", "FALSE"); ELSE PRINT #hFile, CStr(.Default); ENDIF ENDIF PRINT #hFile, ")" END WITH NEXT PRINT #hFile, "\n .PrimaryKey = [ "; bFirst = FALSE FOR EACH sField IN .PrimaryKey IF bFirst THEN PRINT #hFile, ", "; PRINT #hFile, "\"" & sField & "\""; bFirst = TRUE NEXT PRINT #hFile, " ]\n" bIndex = FALSE FOR EACH hIndex IN hTable.Indexes WITH hIndex IF .Primary THEN CONTINUE PRINT #hFile, " .Indexes.Add(\"" & .Name & "\", \"" & .Fields & "\""; IF .Unique THEN PRINT #hFile, ", TRUE"; PRINT #hFile, ")" bIndex = TRUE END WITH NEXT IF bIndex THEN PRINT #hFile END WITH PRINT #hFile, " .Update\n" PRINT #hFile, " END WITH\n" NEXT PRINT #hFile, "END\n" END PUBLIC SUB btnClose_Click() IF chkUpdate.Value THEN WriteConfig(FALSE) ENDIF ME.Close END