I've beautified the code a little more, and made it little more comprehensible with some flexibility. I've updated the original links. Here is the code from the main file,
Code: Select all
IncludeFile "Dependencies\JetBlue_h.pbi"
IncludeFile "Dependencies\CheckFileAccess.pbi"
IncludeFile "Dependencies\WalkDirectoryTree.pbi"
IncludeFile "Dependencies\MemoryToHex.pbi"
IncludeFile "Dependencies\VariantTimeToSystemTime.pbi"
Structure _JET_coltyp_lookup_struct_
type.l
new_type.l
type_name$
EndStructure
Global Dim JetColtypes._JET_coltyp_lookup_struct_(0), jtArray_size.l
Macro AddJETColumntypes(typeval, newtypeval = #False, typenameval = "")
JetColtypes(jtArray_size)\type = typeval
If newtypeval
JetColtypes(jtArray_size)\new_type = newtypeval
EndIf
If typenameval <> ""
JetColtypes(jtArray_size)\type_name$ = typenameval
EndIf
jtArray_size+1
ReDim JetColtypes(jtArray_size)
EndMacro
Procedure.s GetJETColumnType(typeval.l)
For k=0 To ArraySize(JetColtypes())
If JetColtypes(k)\type = typeval
ProcedureReturn JetColtypes(k)\type_name$
EndIf
Next
EndProcedure
Procedure Jet_ColtypDIC()
AddJETColumntypes(#JET_coltypBit, #PB_Byte, "JET_coltyp.Bit (bool)")
AddJETColumntypes(#JET_coltypUnsignedByte, #PB_Byte, "JET_coltyp.UnsignedByte (byte)")
AddJETColumntypes(#JET_coltypShort, #PB_Word, "JET_coltyp.Short (short)")
AddJETColumntypes(#JET_coltypLong, #PB_Long, "JET_coltyp.Long (int)")
AddJETColumntypes(#JET_coltypCurrency, #PB_Quad, "JET_coltyp.Currency (long)")
AddJETColumntypes(#JET_coltypIEEESingle, #PB_Float, "JET_coltyp.IEEESingle (float)")
AddJETColumntypes(#JET_coltypIEEEDouble, #PB_Double, "JET_coltyp.IEEEDouble (double)")
AddJETColumntypes(#JET_coltypDateTime, #PB_Float, "JET_coltyp.DateTime (DateTime)")
AddJETColumntypes(#JET_coltypBinary, #PB_Byte, "JET_coltyp.Binary (byte[])")
AddJETColumntypes(#JET_coltypText, #PB_String, "JET_coltyp.Text (string)")
AddJETColumntypes(#JET_coltypLongBinary, #PB_Long, "JET_coltyp.LongBinary (byte[])")
AddJETColumntypes(#JET_coltypLongText, #PB_String, "JET_coltyp.LongText (string)")
AddJETColumntypes(#JET_coltypUnsignedLong, #PB_Long, "VistaColtyp.UnsignedLong (uint)")
AddJETColumntypes(#JET_coltypLongLong, #PB_Quad, "VistaColtyp.LongLong (long)")
AddJETColumntypes(#JET_coltypGUID, #PB_Quad, "VistaColtyp.GUID (Guid)")
AddJETColumntypes(#JET_coltypUnsignedShort, #PB_Unicode, "VistaColtyp.UnsignedShort (ushort)")
AddJETColumntypes(#JET_coltypUnsignedLongLong, #PB_Quad, "Windows10Coltyp.UnsignedLongLong (ulong)")
EndProcedure
Procedure ViewESE()
Global.s StoredTempPath, StoredLogFilePath, StoredSystemPath, StoredBaseName, tempDir,
JET_DbFilePart, tempDir, pfvInstanceName = "ViewESE", tbDatabase, JET_TableName = "MSysObjects"
Global.l StoredLogFileSize, StoredCircularLog
Global.s NewList Tables()
; the system parameters
;Global.s pfvInstanceName = ""
Global.s pfvTempPath = ""
Global.s pfvLogFilePath = ""
Global.s pfvSystemPath = ""
Global.s pfvBaseName = ""
Global.l pfvLogFileSize = 0
Global.l pfvCircularLog = 1
Jet_ColtypDIC()
ProcedureReturn 1
EndProcedure
;poke around to detect the system parameters
Procedure DetectSystemParameters(JET_DbFile.s)
Protected.s RootPath, File, NewList GetFiles.s()
JET_DbFilePart = GetFilePart(JET_DbFile)
RootPath = GetPathPart(JET_DbFile)
; find the temp database file For the TempPath
If StoredTempPath = ""
StoredTempPath = RootPath
If WalkDirectoryTree(StoredTempPath, GetFiles(), "*.edb")
ForEach GetFiles()
File = GetFiles()
If File <> JET_DbFile
StoredTempPath = GetPathPart(File)
Break
EndIf
Next
EndIf
; If READ ONLY
If Not CheckFileAccess(StoredTempPath, #FILE_WRITE_DATA) = #FILE_WRITE_DATA
StoredTempPath = tempDir
CreateDirectory(StoredTempPath)
EndIf
EndIf
; find the checkpoint files for the SystemPath
If StoredSystemPath = ""
StoredSystemPath = RootPath
If WalkDirectoryTree(StoredSystemPath, GetFiles(), "*.chk")
ForEach GetFiles()
StoredSystemPath = GetPathPart(GetFiles())
Break
Next
EndIf
If WalkDirectoryTree(StoredSystemPath, GetFiles(), "*.jcp")
ForEach GetFiles()
StoredSystemPath = GetPathPart(GetFiles())
Break
Next
EndIf
; If READ ONLY
If Not CheckFileAccess(StoredSystemPath, #FILE_WRITE_DATA) = #FILE_WRITE_DATA
StoredSystemPath = tempDir
CreateDirectory(StoredSystemPath)
EndIf
EndIf
; find the log files For the LogFilePath
If StoredLogFilePath = ""
StoredLogFilePath = RootPath + "LogFiles\"
If WalkDirectoryTree(StoredLogFilePath, GetFiles(), "*.log")
ForEach GetFiles()
StoredLogFilePath = GetPathPart(GetFiles())
Break
Next
EndIf
If WalkDirectoryTree(StoredLogFilePath, GetFiles(), "*.jtx")
ForEach GetFiles()
StoredLogFilePath = GetPathPart(GetFiles())
Break
Next
EndIf
; If READ ONLY
If Not CheckFileAccess(StoredLogFilePath, #FILE_WRITE_DATA) = #FILE_WRITE_DATA
StoredLogFilePath = tempDir
CreateDirectory(StoredLogFilePath)
EndIf
EndIf
; find the base name For the files
If StoredBaseName = ""
If WalkDirectoryTree(rootPath, GetFiles(), "*.chk")
ForEach GetFiles()
File = GetFilePart(GetFiles())
Break
Next
EndIf
If WalkDirectoryTree(rootPath, GetFiles(), "*.jcp")
ForEach GetFiles()
File = GetFilePart(GetFiles())
Break
Next
EndIf
pCount.b = CountString(File, ".")
pPos.b = 1
For k=0 To pCount
pPos = FindString(File, ".", pPos)
Next
StoredBaseName = Mid(File, pPos+1)
If Len(StoredBaseName) <> 3 : StoredBaseName = "edb" : EndIf
EndIf
; find the size of the log files
If StoredLogFileSize = 0
StoredLogFileSize = 512
If WalkDirectoryTree(rootPath, GetFiles(), "*.log")
ForEach GetFiles()
StoredLogFileSize = FileSize(GetFiles()) / 1024
Break
Next
EndIf
If WalkDirectoryTree(rootPath, GetFiles(), "*.jtx")
ForEach GetFiles()
StoredLogFileSize = FileSize(GetFiles()) / 1024
Break
Next
EndIf
EndIf
EndProcedure
IncludeFile "Dependencies\ADO.Net DataTable.pbi"
; reset all stored parameters
Procedure ResetParameters()
; do a little cleanup
If tempDir <> "" And FileSize(tempDir) = -2
DeleteDirectory(tempDir, "", #PB_FileSystem_Recursive)
EndIf
tempDir = GetEnvironmentVariable("TEMP")+"\edb_tmp"+Random(4000, 1000)+"\"
; copy the beginning values
StoredTempPath = pfvTempPath
StoredBaseName = pfvBaseName
StoredLogFilePath = pfvLogFilePath
StoredSystemPath = pfvSystemPath
StoredLogFileSize = pfvLogFileSize
StoredCircularLog = pfvCircularLog
EndProcedure
Procedure.b RetrieveColumnAsBoolean(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected.b JET_RetrV, JET_reqsize.l
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, JET_StrucPtr, 1, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
Debug "JetRetrieveColumn(): " + JetErrorMessage(JET_ret)
EndIf
If JET_ret <> #JET_wrnColumnNull
JET_RetrV = Bool(PeekB(JET_StrucPtr))
Else
JET_RetrV = 0
EndIf : ProcedureReturn JET_RetrV
EndProcedure
Procedure.b RetrieveColumnAsByte(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected.b JET_RetrV, JET_reqsize.l
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, JET_StrucPtr, 1, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
Debug "JetRetrieveColumn(): " + JetErrorMessage(JET_ret)
EndIf
If JET_ret <> #JET_wrnColumnNull
JET_RetrV = PeekB(JET_StrucPtr)
EndIf : ProcedureReturn JET_RetrV
EndProcedure
Procedure.w RetrieveColumnAsInt16(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected.w JET_RetrV, JET_reqsize.l
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, JET_StrucPtr, 2, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
Debug "JetRetrieveColumn(): " + JetErrorMessage(JET_ret)
EndIf
If JET_ret <> #JET_wrnColumnNull
JET_RetrV = PeekW(JET_StrucPtr)
EndIf : ProcedureReturn JET_RetrV
EndProcedure
Procedure.l RetrieveColumnAsInt32(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected.l JET_RetrV, JET_reqsize.l
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, JET_StrucPtr, 4, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
Debug "JetRetrieveColumn(): " + JetErrorMessage(JET_ret)
EndIf
If JET_ret <> #JET_wrnColumnNull
JET_RetrV = PeekL(JET_StrucPtr)
EndIf : ProcedureReturn JET_RetrV
EndProcedure
Procedure.q RetrieveColumnAsInt64(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected.q JET_RetrV, JET_reqsize.l
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, JET_StrucPtr, 8, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
Debug "JetRetrieveColumn(): " + JetErrorMessage(JET_ret)
EndIf
If JET_ret <> #JET_wrnColumnNull
JET_RetrV = PeekQ(JET_StrucPtr)
EndIf : ProcedureReturn JET_RetrV
EndProcedure
Procedure.f RetrieveColumnAsFloat(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected.f JET_RetrV, JET_reqsize.l
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, JET_StrucPtr, 4, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
Debug "JetRetrieveColumn(): " + JetErrorMessage(JET_ret)
EndIf
If JET_ret <> #JET_wrnColumnNull
JET_RetrV = PeekF(JET_StrucPtr)
EndIf : ProcedureReturn JET_RetrV
EndProcedure
Procedure.d RetrieveColumnAsDouble(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected.d JET_RetrV, JET_reqsize.l
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, JET_StrucPtr, 8, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
Debug "JetRetrieveColumn(): " + JetErrorMessage(JET_ret)
EndIf
If JET_ret <> #JET_wrnColumnNull
JET_RetrV = PeekD(JET_StrucPtr)
EndIf : ProcedureReturn JET_RetrV
EndProcedure
Procedure.s RetrieveColumnAsDateTime(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected.s JET_RetrV, JET_reqsize.l, OADate2Sys.i, SystemTime.SYSTEMTIME
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, JET_StrucPtr, 8, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
Debug "JetRetrieveColumn(): " + JetErrorMessage(JET_ret)
EndIf
If JET_ret <> #JET_wrnColumnNull
If VariantTimeToSystemTime(PeekD(JET_StrucPtr), @SystemTime)
OADate2Sys = Date(SystemTime\wYear, SystemTime\wMonth, SystemTime\wDay, SystemTime\wHour, SystemTime\wMinute, SystemTime\wSecond)
If OADate2Sys <> -1
JET_RetrV = FormatDate("%yyyy/%mm/%dd %hh:%ii:%ss", OADate2Sys)
EndIf
EndIf
EndIf : ProcedureReturn JET_RetrV
EndProcedure
Procedure.s RetrieveColumn(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected iPtr.i, JET_ret.l, JET_RetrV.s, JET_reqsize.l = #BUF_SIZE
iPtr = JET_StrucPtr
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, iPtr, JET_reqsize, @JET_reqsize, 0, pJET_retinfo)
If JET_ret = #JET_wrnBufferTruncated
; OK, our general purpose buffer isn't large enough
iPtr = AllocateMemory(JET_reqsize)
; do it again
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, iPtr, JET_reqsize, @JET_reqsize, 0, pJET_retinfo)
EndIf
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
If iPtr <> JET_StrucPtr : FreeMemory(iPtr) : EndIf
Debug "JetRetrieveColumn: " + JetErrorMessage(JET_ret)
ProcedureReturn ""
EndIf
If JET_ret <> #JET_wrnColumnNull And JET_reqsize <> 0
JET_RetrV = "0x"+MemoryToHex(iPtr, JET_reqsize)
EndIf
If iPtr <> JET_StrucPtr : FreeMemory(iPtr) : EndIf
ProcedureReturn JET_RetrV
EndProcedure
Procedure.s RetrieveColumnAsString(JET_SessID, JET_TableID, dtColID.l, CodePage.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected iPtr.i, JET_RetrV.s, JET_reqsize.l
iPtr = JET_StrucPtr
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, iPtr, #BUF_SIZE, @JET_reqsize, 0, pJET_retinfo)
If JET_ret = #JET_wrnBufferTruncated
; our general purpose buffer isn't large enough
iPtr = AllocateMemory(JET_reqsize)
; do it again
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, iPtr, JET_reqsize, @JET_reqsize, 0, pJET_retinfo)
If JET_ret <> 0
Debug "JetRetrieveColumn(#JET_wrnBufferTruncated): " + JetErrorMessage(JET_ret)
EndIf
EndIf
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
If iPtr <> JET_StrucPtr : FreeMemory(iPtr) : EndIf
Debug "JetRetrieveColumn: " + JetErrorMessage(JET_ret)
EndIf
; If Not null
If JET_ret <> #JET_wrnColumnNull
; Decode the strings based upon ANSI vs Unicode Code Page
; Yes, I know... this isn't very Locale aware. I guess the
; "Globalization Police" will have To arrest me!
If Codepage = 1200
JET_RetrV = PeekS(JET_StrucPtr, (JET_reqsize/2)-1, #PB_Unicode)
Else
JET_RetrV = PeekS(JET_StrucPtr, JET_reqsize, #PB_Ascii)
EndIf
EndIf
If iPtr <> JET_StrucPtr : FreeMemory(iPtr) : EndIf
ProcedureReturn JET_RetrV
EndProcedure
Procedure.s RetrieveColumnAsGUID(JET_SessID, JET_TableID, dtColID.l, pJET_retinfo)
Shared.i JET_StrucPtr
Protected iPtr.i, JET_ret.l, JET_RetrV.s, JET_reqsize.l = #BUF_SIZE
iPtr = JET_StrucPtr
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, iPtr, JET_reqsize, @JET_reqsize, 0, pJET_retinfo)
If JET_ret = #JET_wrnBufferTruncated
; OK, our general purpose buffer isn't large enough
iPtr = AllocateMemory(JET_reqsize)
; do it again
JET_ret = JetRetrieveColumn(JET_SessID, JET_TableID, dtColID, iPtr, JET_reqsize, @JET_reqsize, 0, pJET_retinfo)
EndIf
If JET_ret <> 0 And JET_ret <> #JET_wrnColumnNull
If iPtr <> JET_StrucPtr : FreeMemory(iPtr) : EndIf
Debug "JetRetrieveColumn: " + JetErrorMessage(JET_ret)
ProcedureReturn ""
EndIf
If JET_reqsize <> 0
JET_RetrV = Space(76)
StringFromGUID2_(iPtr, JET_RetrV, 76)
EndIf
If iPtr <> JET_StrucPtr : FreeMemory(iPtr) : EndIf
ProcedureReturn JET_RetrV
EndProcedure
; Open an table in an ESE database And copy the contents into a DataTable
Procedure.b GetTable(JET_DbFile.s, JET_TableName.s, Val3.s = "")
Shared.i JET_InstID, JET_SessID, JET_TableID, JET_StrucPtr
Shared.l JET_dbID, JET_ret, JET_pagesize, JET_reqsize, JET_reqsize2
; fill in the blanks For the system parameters
DetectSystemParameters(JET_DbFile)
; match the Page size
JET_ret = JetGetDatabaseFileInfo(JET_DbFile, @JET_pagesize, 4, #JET_DbInfoPageSize)
If JET_ret <> 0 : Debug "JetGetDatabaseFileInfo: " +JetErrorMessage(JET_ret) : EndIf
; set the page size (Note: this is a Global setting, so the inst_id is ignored)
JET_ret = JetSetSystemParameter(@JET_InstID, 0, #JET_paramDatabasePageSize, JET_pagesize, #Null$)
If JET_ret <> 0 : Debug "JetSetSystemParameter: " + JetErrorMessage(JET_ret) : EndIf
; The simple job of opening a Table requires quite a few commands.
; Here is the typical sequence:
;
; JetCreateInstance()
; JetInit()
; JetBeginSession()
; JetAttachDatabase()
; JetOpenDatabase()
; JetOpenTable()
; JetCloseTable()
; JetCloseDatabase()
; JetDetachDatabase()
; JetEndSession()
; JetTerm() ' also destroys the Instance
; The simple job of opening a Table requires quite a few commands.
JET_ret = JetCreateInstance(@JET_InstID, pfvInstanceName)
If JET_ret <> 0 : Debug "JetCreateInstance: " + JetErrorMessage(JET_ret) : EndIf
; set a few parameters... the location of the Log/Temp/Check directories
JET_ret = JetSetSystemParameter(@JET_InstID, 0, #JET_paramTempPath, 0, StoredTempPath)
If JET_ret <> 0 : Debug "JetSetSystemParameter 2: " + JetErrorMessage(JET_ret) : EndIf
JET_ret = JetSetSystemParameter(@JET_InstID, 0, #JET_paramLogFilePath, 0, StoredLogFilePath)
If JET_ret <> 0 : Debug "JetSetSystemParameter 3: " + JetErrorMessage(JET_ret) : EndIf
JET_ret = JetSetSystemParameter(@JET_InstID, 0, #JET_paramSystemPath, 0, StoredSystemPath)
If JET_ret <> 0 : Debug "JetSetSystemParameter 4: " + JetErrorMessage(JET_ret) : EndIf
JET_ret = JetSetSystemParameter(@JET_InstID, 0, #JET_paramBaseName, 0, StoredBaseName)
If JET_ret <> 0 : Debug "JetSetSystemParameter 5: " + JetErrorMessage(JET_ret) : EndIf
JET_ret = JetSetSystemParameter(@JET_InstID, 0, #JET_paramLogFileSize, StoredLogFileSize, #Null$)
If JET_ret <> 0 : Debug "JetSetSystemParameter 6: " + JetErrorMessage(JET_ret) : EndIf
JET_ret = JetSetSystemParameter(@JET_InstID, 0, #JET_paramCircularLog, StoredCircularLog, #Null$)
If JET_ret <> 0 : Debug "JetSetSystemParameter 7: " + JetErrorMessage(JET_ret) : EndIf
JET_ret = JetSetSystemParameter(@JET_InstID, 0, #JET_paramAccessDeniedRetryPeriod, 1000, #Null$)
If JET_ret <> 0 : Debug "JetSetSystemParameter 8: " + JetErrorMessage(JET_ret) : EndIf
; initialize the instance
JET_ret = JetInit(@JET_InstID)
If JET_ret <> 0 : Debug "JetInit: " + JetErrorMessage(JET_ret) : EndIf
; start the session
JET_ret = JetBeginSession(JET_InstID, @JET_SessID, #Null$, #Null$)
If JET_ret <> 0 : Debug "JetBeginSession: " + JetErrorMessage(JET_ret) : EndIf
; attach the database file
JET_ret = JetAttachDatabase(JET_SessID, JET_DbFile, #JET_bitDbReadOnly)
If JET_ret <> 0 : Debug "JetAttachDatabase: " + JetErrorMessage(JET_ret) : EndIf
; open the database
JET_ret = JetOpenDatabase(JET_SessID, JET_DbFile, #Null$, @JET_dbID, #JET_bitDbReadOnly)
If JET_ret <> 0 : Debug "JetOpenDatabase: " + JetErrorMessage(JET_ret) : EndIf
; open the table
JET_ret = JetOpenTable(JET_SessID, JET_dbID, JET_TableName, 0, 0, #JET_bitTableReadOnly, @JET_TableID)
If JET_ret <> 0 : Debug "JetOpenTable: " + JetErrorMessage(JET_ret) : EndIf
; This is kinda strange... To get the schema of a table, you use the
; JetGetTableColumnInfo function which JET_returns a listing of column IDs
; that Map To parts of the schema. The actual schema itself is JET_returned
; in a temporary table. So, now that you know the column IDs To the temp
; table, you can Read the records of the temp table To get the schema
; of the real table. Whew!
Protected JET_collist.JET_COLUMNLIST, pJET_retinfo.JET_RETINFO
JET_StrucPtr = AllocateMemory(SizeOf(JET_collist))
JET_ret = JetGetTableColumnInfo(JET_SessID, JET_TableID, #Null$, JET_StrucPtr, SizeOf(JET_collist), #JET_ColInfoListSortColumnid)
If JET_ret <> 0 : Debug "JetGetTableColumnInfo: " + JetErrorMessage(JET_ret) : EndIf
If Not JET_ret
;' do some pointer magic to populate the structure
CopyStructure(JET_StrucPtr, JET_collist, JET_COLUMNLIST)
; clean up
FreeMemory(JET_StrucPtr)
; Set the cursor at the begining of the temp table. Probably Not nesseccary,
; but what the heck...
JET_ret = JetMove(JET_SessID, JET_collist\tableid, #JET_MoveFirst, 0)
If JET_ret <> 0 : Debug "JetMove: " + JetErrorMessage(JET_ret) : EndIf
; allocate a buffer For the colum names, et al
JET_StrucPtr = AllocateMemory(#JET_cbNameMost)
pJET_retinfo\cbStruct = SizeOf(pJET_retinfo)
; If there are multiple values, we get only the first one
pJET_retinfo\itagSequence = 1
; Loop thru each record in the temp table To build our ADO.Net DataTable
AddTable2Database(JET_TableName, 1)
Protected.s col_name
Protected.l col_type, col_id, col_grbit, col_cbMax, CodePage
While JET_ret=0
; column grbit
JET_ret = JetRetrieveColumn(JET_SessID, JET_collist\tableid, JET_collist\columnidgrbit, JET_StrucPtr, 4, @JET_reqsize, 0, @pJET_retinfo)
If JET_ret <> 0 : Debug "JetRetrieveColumn 3: " + JetErrorMessage(JET_ret) : EndIf
col_grbit = PeekL(JET_StrucPtr)
; column cbMax
; JET_ret = JetRetrieveColumn(JET_SessID, JET_collist\tableid, JET_collist\columnidcbMax, JET_StrucPtr, 4, @JET_reqsize, 0, @pJET_retinfo)
; If JET_ret <> 0 : Debug "JetRetrieveColumn 4: " + JetErrorMessage(JET_ret) : EndIf
; col_cbMax = PeekL(JET_StrucPtr)
; column name
JET_ret = JetRetrieveColumn(JET_SessID, JET_collist\tableid, JET_collist\columnidcolumnname, JET_StrucPtr, #JET_cbNameMost, @JET_reqsize, 0, @pJET_retinfo)
If JET_ret <> 0 : Debug "JetRetrieveColumn: " + JetErrorMessage(JET_ret) : EndIf
If SizeOf(Character) = 2 : JET_reqsize2 = JET_reqsize / 2 : Else : JET_reqsize2 = JET_reqsize : EndIf
col_name = PeekS(JET_StrucPtr, JET_reqsize2)
; column Data type
JET_ret = JetRetrieveColumn(JET_SessID, JET_collist\tableid, JET_collist\columnidcoltyp, JET_StrucPtr, 4, @JET_reqsize, 0, @pJET_retinfo)
If JET_ret <> 0 : Debug "JetRetrieveColumn 1: " + JetErrorMessage(JET_ret) : EndIf
col_type = PeekL(JET_StrucPtr)
; column ID
JET_ret = JetRetrieveColumn(JET_SessID, JET_collist\tableid, JET_collist\columnidcolumnid, JET_StrucPtr, 4, @JET_reqsize, 0, @pJET_retinfo)
If JET_ret <> 0 : Debug "JetRetrieveColumn 2: " + JetErrorMessage(JET_ret) : EndIf
col_id = PeekL(JET_StrucPtr)
; build the ADO.Net DataColumn
Select col_type
Case #JET_coltypBit, #JET_coltypUnsignedByte, #JET_coltypShort, #JET_coltypLong,
#JET_coltypCurrency, #JET_coltypIEEESingle, #JET_coltypIEEEDouble, #JET_coltypDateTime,
#JET_coltypBinary, #JET_coltypLongBinary, #JET_coltypUnsignedLong, #JET_coltypLongLong,
#JET_coltypGUID, #JET_coltypUnsignedShort, #JET_coltypUnsignedLongLong
Case #JET_coltypText, #JET_coltypLongText
; record the Code Page so we can distinguish between ANSI
; And Unicode strings later on in the program
JET_ret = JetRetrieveColumn(JET_SessID, JET_collist\tableid, JET_collist\columnidCp, JET_StrucPtr, 4, @JET_reqsize, 0, @pJET_retinfo)
If JET_ret <> 0 : Debug "#JET_coltypText: JetRetrieveColumn: " + JetErrorMessage(JET_ret) : EndIf
CodePage = PeekL(JET_StrucPtr)
Default
Debug "GetTables #1: Unsupported column type " + Str(col_type)
EndSelect
; Add Column INFO into our ADO.Net DataTable
AddColumn2Database(col_name, col_id, col_type, col_grbit, col_cbMax)
If CodePage <> 0 : dt()\DataColumn()\Codepage = CodePage : EndIf
JET_ret = JetMove(JET_SessID, JET_collist\tableid, #JET_MoveNext, 0)
Wend
FreeMemory(JET_StrucPtr)
JetCloseTable(JET_SessID, JET_collist\tableid)
; OK, now we know the column names And datatypes of the table, we can *finally* Read
; the records And copy the Data into our ADO.Net DataTable
JET_ret = JetMove(JET_SessID, JET_TableID, #JET_MoveFirst, 0)
If JET_ret <> 0 : Debug "JetMove: " + JetErrorMessage(JET_ret) : EndIf
; Allocate a sufficiently large buffer to handle most needs. If needed, we allocate
; another buffer For larger requirements
JET_StrucPtr = AllocateMemory(#BUF_SIZE)
Protected Retr.b, Retr2.w, Retr3.l, Retr4.i, Retr5.f, Retr6.d, Retr7.q, Retr8.s
While JET_ret=0
ForEach dt()\DataColumn()
AddElement(dt()\DataColumn()\Row_Text())
Select dt()\DataColumn()\Col_type
Case #JET_coltypBit
Retr = RetrieveColumnAsBoolean(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
dt()\DataColumn()\Row_Text() = Str(Retr)
Case #JET_coltypUnsignedByte
Retr = RetrieveColumnAsByte(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
dt()\DataColumn()\Row_Text() = Str(Retr)
Case #JET_coltypShort, #JET_coltypUnsignedShort
Retr2 = RetrieveColumnAsInt16(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
If Retr2 : dt()\DataColumn()\Row_Text() = Str(Retr2) : EndIf
Case #JET_coltypLong, #JET_coltypUnsignedLong
Retr3 = RetrieveColumnAsInt32(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
If Retr3 : dt()\DataColumn()\Row_Text() = Str(Retr3) : EndIf
Case #JET_coltypCurrency
Retr7 = RetrieveColumnAsInt64(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
dt()\DataColumn()\Row_Text() = Str(Retr7)
Case #JET_coltypLongLong, #JET_coltypUnsignedLongLong
Retr7 = RetrieveColumnAsInt64(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
dt()\DataColumn()\Row_Text() = Str(Retr7)
Case #JET_coltypIEEESingle
Retr5 = RetrieveColumnAsFloat(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
dt()\DataColumn()\Row_Text() = Str(Retr5)
Case #JET_coltypIEEEDouble
Retr6 = RetrieveColumnAsDouble(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
dt()\DataColumn()\Row_Text() = Str(Retr6)
Case #JET_coltypDateTime ; RetrieveColumnAsDateTime
Retr8 = RetrieveColumnAsDateTime(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
dt()\DataColumn()\Row_Text() = Retr8
Case #JET_coltypBinary, #JET_coltypLongBinary
Retr8 = RetrieveColumn(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
If Retr8 <> "0" : dt()\DataColumn()\Row_Text() = Retr8 : EndIf
Case #JET_coltypText, #JET_coltypLongText
Retr8 = RetrieveColumnAsString(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, dt()\DataColumn()\Codepage, pJET_retinfo)
If Retr8 <> "0" : dt()\DataColumn()\Row_Text() = Retr8 : EndIf
Case #JET_coltypGUID
Retr8 = RetrieveColumnAsGUID(JET_SessID, JET_TableID, dt()\DataColumn()\Col_ID, pJET_retinfo)
dt()\DataColumn()\Row_Text() = Retr8
Default
Debug "GetTables #2: Unsupported column type " + Str(dt()\DataColumn()\Col_type) + " ("+GetJETColumnType(dt()\DataColumn()\Col_type)+")"
EndSelect
Next
JET_ret = JetMove(JET_SessID, JET_TableID, #JET_MoveNext, 0)
Wend
EndIf
; Free the memory we allocated And destroy the temporary table that got
; automatically created by the JetGetTableColumnInfo command.
If JET_StrucPtr : FreeMemory(JET_StrucPtr) : EndIf
; close the table
JET_ret = JetCloseTable(JET_SessID, JET_TableID)
If JET_ret <> 0 : Debug JetErrorMessage(JET_ret) : EndIf
; close the database
JET_ret = JetCloseDatabase(JET_SessID, JET_dbID, #JET_bitDbReadOnly)
If JET_ret <> 0 : Debug JetErrorMessage(JET_ret) : EndIf
; detach the database file
JET_ret = JetDetachDatabase(JET_SessID, JET_DbFile)
If JET_ret <> 0 : Debug JetErrorMessage(JET_ret) : EndIf
; End the session
JET_ret = JetEndSession(JET_SessID, 0)
If JET_ret <> 0 : Debug JetErrorMessage(JET_ret) : EndIf
; terminate the instance
JET_ret = JetTerm(JET_InstID)
If JET_ret <> 0 : Debug JetErrorMessage(JET_ret) : EndIf
ProcedureReturn 1
EndProcedure
Procedure SizeWindowHandler()
ResizeGadget(2, #PB_Ignore, #PB_Ignore, WindowWidth(EventWindow())-20, WindowHeight(EventWindow())-StatusBarHeight(0)-60)
EndProcedure
Procedure Int_Main()
Global.s tbDatabase, JET_TableName
If OpenWindow(0, 0, 0, 370, 340, "DataTables Viewer", #PB_Window_SystemMenu | #PB_Window_ScreenCentered| #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
If CreateStatusBar(0, WindowID(0))
AddStatusBarField(#PB_Ignore)
EndIf
FrameGadget(0, 10, 5, 280, 43, "Tables")
ComboBoxGadget(1, 18, 20, 250, 21)
ListIconGadget(2, 10, 50, WindowWidth(0)-20, WindowHeight(0)-StatusBarHeight(0)-60, "", 120, #PB_ListIcon_GridLines)
RemoveGadgetColumn(2, 0)
If JET_TableName = "MSysObjects" : RetrieveTables() : EndIf
ForEach Tables()
AddGadgetItem(1, -1, Tables())
If Tables() = JET_TableName : Id2.b = CountGadgetItems(1)-1 : EndIf
Next : SetGadgetState(1, Id2)
; PostEvent(#PB_Event_Gadget, 0, 1)
TableState.b = GetGadgetState(1)
If TableState < 0 : TableState = 0 : EndIf
PopulateListView(TableState)
BindEvent(#PB_Event_SizeWindow, @SizeWindowHandler())
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case 1
ClearGadgetItems(2)
For k=0 To ListSize(dt()\DataColumn())
RemoveGadgetColumn(2, 0)
Next : k=0
ClearList(dt()) : AddTable2Database(GetGadgetText(1), 1)
If ESENT_Init()
ViewESE()
If GetTable(tbDatabase, GetGadgetText(1))
TableState.b = GetGadgetState(1)
If TableState < 0 : TableState = 0 : EndIf
PopulateListView(TableState)
EndIf
ESENT_End()
EndIf
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
EndProcedure
; Get the list of Table names in the database
Procedure OpenJetDatabase(JETDatabasePath.s)
; new database, so clear any existing stored parameters
ResetParameters()
Global NewList Tables.s()
GetTable(JETDatabasePath, "MSysObjects")
EndProcedure
CompilerIf #PB_Compiler_IsMainFile
tbDatabase = GetEnvironmentVariable("SYSTEMROOT")+"\SoftwareDistribution\DataStore\DataStore.edb"
;- ESENT_Init()
If ESENT_Init()
Oleaut32_Init()
ViewESE()
; Open ESE Database file And store all its Table contents into the DataTable
OpenJetDatabase(tbDatabase)
; Jump to specific Table or REM line to use default Table "MSysObjects".
; JET_TableName = "tbUpdates"
; GetTable(tbDatabase, JET_TableName)
ESENT_End() : Oleaut32_End()
Int_Main()
EndIf
CompilerEndIf