1FileDB

DB in a File (One of my best library codes so far)
Saves/Reads/Deletes certain Row/Table/DB from a file using set of functions
Suggested is to read the DB once to prevent delays in page load.
Attached is a sample of fdb file used


Public

Tested

My Own Work

<%
'
' 1FileDB
' Uses simple file to save DB, file extension is fdb
' Reads DB into public variable as text, to work with
' Once you finish your work, remember to save back to fdb using SavetoFile
' Danger! when too big means we might see some delays??? INVESTIGATE
' Refer to 1FileDB.fdb for an example
'
' Functions
' F1db_TableRead, F1db_TableSave, F1db_TableDelete, F1db_RowRead, F1db_RowSave, F1db_RowDelete
' F1db_DBRead, F1db_DBSave
'
'  F1db_DBRead (Filename)
'  F1db_DBSave (Filename, WholeContent)
'  F1db_TableRead (FullDB, TableName)
' F1db_TableSave (FullDB, TableName, TableBody)
' F1db_TableDelete (FullDB, TableName)
' F1db_RowRead (FullDB, TableName, RowID)
' F1db_RowSave (FullDB, TableName, RowID, RowID_Sepa_Body)
' F1db_RowDelete (FullDB, TableName, RowID)
'
' By: ANmar Amdeen
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>            Variables             <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>                                  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Set FSO  = Server.CreateObject("scripting.FileSystemObject")
SepaCol = "{{$C$}}"
SepaRow = "{{$R$}}"
FDBFull = "/1FileDB.fdb"
FDBTable1 = "TeamTable"

' Reading whole DB from fdb into string
TeamText = ReadFromFile_UTF8(FDBFull)

' Reading table1 from wholeDB string into Table string
ArrTeam = F1db_TableRead(TeamText, FDBTable1)
NewDB = ""
If Uid > "" Then ' Adding this user if we are logged in
LiiNew = F1db_RowRead(TeamText, FDBTable1, inuser_id)
If inuser_id = CutString(LiiNew, "", SepaCol, 1) Then
TeamUID = inuser_id
UserPrivacy = 2
LiiNew = inuser_id & SepaCol & inuser_1stname & SepaCol & inuser_lastname & SepaCol & _
inuser_email & SepaCol & inuser_headline & SepaCol & _
inuser_connections & SepaCol & inuser_picurl & SepaCol & inuser_Profilelink & SepaCol & _
TimeinSQL & vbcrlf
NewTab = F1db_RowSave(TeamText, FDBTable1, LiiNew)
NewDB = F1db_TableSave(TeamText, FDBTable1, NewTab)
End If
End If
If NewDB > "" Then SavetoFile FDBFull, NewDB


' Below is imported from ToolsRV, to check the security level of this user
PrLev1 = "Public"
PrLev2 = "HRCTeam only"
PrLev3 = "ANmar only"
PrLev4 = "2nd Team"
UserPrivacy = 1 ' 1=public, 2=team, 3=ANmar, 4=Team2
PrivacyLevels = PrLev1 & SepaCol & PrLev2
If TeamUID = ANmarsLid Then
PrivacyLevels = PrLev1 & SepaCol & PrLev2 & SepaCol & PrLev4 & SepaCol & PrLev3
UserPrivacy = 3
End If

%>
<%
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>            1FileDB.fdb           <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>                                  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Declare public variable with whole DB into text
'   Danger! when too big means we might have issues
' Needs to read entire DBFile 1st into string to avoid re-reading it everytime
'
' Function F1db_TableRead (FullDB, TableName)
' Function F1db_TableSave (FullDB, TableName, TableBody)
' Function F1db_TableDelete(FullDB, TableName)
' Function F1db_RowRead (FullDB, TableName, RowID)
' Function F1db_RowSave (FullDB, TableName, RowID, RowID_Sepa_Body)
' Function F1db_RowDelete (FullDB, TableName, RowID)
Function F1db_TableRead(FullDB, TableName)
TableAll = ""
Found1 = Instr(1, FullDB, TableName & "{" & vbcrlf)
CutStart = Found1 + Len(TableName & "{" & vbcrlf)
Found9 = instr(CutStart, FullDB, vbcrlf & "/}" & TableName & vbcrlf)
CutEnds = Found9 - CutStart
If Found1 > 0 And Found9 > Found1 Then TableAll = Mid(FullDB, CutStart, CutEnds)
F1db_TableRead = TableAll
End Function
Function F1db_TableSave(FullDB, TableName, TableBody)
Found1 = Instr(1, FullDB, TableName & "{" & vbcrlf)
CutStart = Found1 + Len(TableName & "{" & vbcrlf)
Found9 = instr(Found1, FullDB, vbcrlf & "/}" & TableName & vbcrlf)
If Found1 = 0 Then
N1DB = FullDB & vbcrlf & TableName & "{" & vbcrlf & TableBody & vbcrlf & "/}" & TableName & vbcrlf
Else
If Found9 = 0 Then ' We have an empty table marks
End If
N1DB = Left(FullDB, Found1 - 1) & vbcrlf & _
TableName & "{" & vbcrlf & _
TableBody & vbcrlf & "/}" & TableName & vbcrlf & _
Mid(FullDB, Found9 + Len("/}" & TableName) + 2, Len(FullDB))
End If
F1db_TableSave = Replace(N1DB, vbcrlf & vbcrlf, vbcrlf)
End Function
Function F1db_TableDelete(FullDB, TableName)
Found1 = Instr(1, FullDB, TableName & "{" & vbcrlf)
CutStart = Found1 + Len(TableName & "{" & vbcrlf)
Found9 = instr(CutStart, FullDB, vbcrlf & "/}" & TableName & vbcrlf)
N1DB = FullDB
If Found1 > 0 Then
N1DB = Left(FullDB, Found1 - 1) & vbcrlf & _
Mid(FullDB, Found9 + Len("/}" & TableName) + 2, Len(FullDB))
End If
F1db_TableDelete = Replace(N1DB, vbcrlf & vbcrlf, vbcrlf)
End Function
Function F1db_RowRead(FullDB, TableName, RowID)
TableAll = F1db_TableRead(FullDB, TableName)
Numme = 0
X1 = 0
RowIDRow = ""
If IsNumeric(RowID) Then Numme = 1
For Each TabRow in Split(TableAll, vbcrlf)
ThisID = CutString(TabRow, "", SepaCol, 1)
X1 = X1 + 1
If Numme = 1 Then
ThisID  = Fix(ThisID)
If X1 = RowID Then RowIDRow = TabRow
End If
If ThisID = RowID Then
RowIDRow  = TabRow
Exit For
End If
Next
F1db_RowRead = RowIDRow
End Function
Function F1db_RowSave(FullDB, TableName, RowID_Sepa_Body)
TableAll = F1db_TableRead(FullDB, TableName)
RowIDRow = ""
Numme = 0
ReplaceID = CutString(RowID_Sepa_Body, "", SepaCol,1)
If IsNumeric(ReplaceID) Then Numme = 1
NewBody  = RowID_Sepa_Body
If TableAll > "" Then
NewBody = ""
For Each TabRow in Split(TableAll, vbcrlf)
ThisID = CutString(TabRow, "", SepaCol, 1)
Found2 = 0
If Numme = 1 Then
If Fix(ThisID) = Fix(ReplaceID) Then Found2 = 1
ElseIf Numme = 0 Then
If UCase(ThisID) = UCase(ReplaceID) Then Found2 = 1
End If
NotAssu = TabRow
If Found2 = 1 Then NotAssu = RowID_Sepa_Body
If NewBody > "" Then NewBody = NewBody & vbcrlf
NewBody  = NewBody & NotAssu
Next
If Found2= 0 Then
NewBody  = TableAll & vbcrlf & RowID_Sepa_Body
End If
End If
F1db_RowSave = NewBody
End Function
Function F1db_RowDelete(FullDB, TableName, RowID)
TableAll = F1db_TableRead(FullDB, TableName)
NewBody = ""
Numme = 0
If IsNumeric(RowID) Then Numme = 1
If TableAll > "" Then
For Each TabRow in Split(TableAll, vbcrlf)
ThisID = CutString(TabRow, "", SepaCol, 1)
Found2 = 0
If Numme = 1 Then
If Fix(ThisID) = Fix(RowID) Then Found2 = 1
ElseIf Numme = 0 Then
If UCase(ThisID) = UCase(RowID) Then Found2 = 1
End If
If Found2 = 0 Then
If NewBody > "" Then NewBody = NewBody & vbcrlf
NewBody  = NewBody & TabRow
End If
Next
End If
F1db_RowDelete = NewBody
End Function

Function F1db_DBRead(FileName)
Dim objStream, strData
Rett = ""
Set objStream  = CreateObject("ADODB.Stream")
objStream.CharSet  = "utf-8"
objStream.Open
objStream.LoadFromFile(Server.MapPath(FileName))
Rett  = objStream.ReadText()
objStream.Close
Set objStream  = Nothing
ReadFromFile_UTF8 = Rett
End Function
Function F1db_DBSave(FileName, Content)
If Content > "" Then
' Set FSO  = Server.CreateObject("scripting.FileSystemObject")
Set myFile  = fso.CreateTextFile(Server.MapPath(FileName), true)
myFile.WriteLine(Content)
myFile.Close
End If
End Function
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>                                  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>            1FileDB.fdb           <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


%>




Filename
Filename, WholeContent
FullDB, TableName
FullDB, TableName, TableBody
FullDB, TableName, RowID
FullDB, TableName, RowID, RowID_Sepa_Body

Views 3382 Downloads 1199

Classic ASP Texts + Strings
ANmarAmdeen
755
Attachments
Revisions

v1.0