2003-06-11 13:59

'
'        ZECREATOR BANK FILE OBJECT
'            zecreator@yahoo.fr
'
'   Stock informations into a file and manage them

     TYPE ZECBANK
      Count AS LONG
      DataName(1000) AS STRING * 20
      DataSize(1000) AS LONG
      DataValue(1000) AS STRING * 65535
     END TYPE

     DIM ZBank AS ZECBANK
     DIM BankOpen AS INTEGER
     DIM ZBFStream AS QFILESTREAM
     DIM strBuffer AS STRING
     DIM intBuffer AS LONG
     DIM ZBr AS LONG

     BankOpen=0
     ZBank.Count=0

     DECLARE FUNCTION BankIsOpen() AS INTEGER
     DECLARE SUB LoadBank (Filename AS STRING)
     DECLARE FUNCTION DatasCount() AS LONG
     DECLARE FUNCTION GetDataIndex(Name AS STRING) AS LONG
     DECLARE FUNCTION GetDataName (Index AS LONG) AS STRING
     DECLARE FUNCTION GetDataSize (Name AS STRING) AS LONG
     DECLARE FUNCTION GetDataValue (Name AS STRING) AS STRING
     DECLARE SUB ExtractDataToFile (Name AS STRING,FileName AS STRING)
     DECLARE SUB AddData (Name AS STRING,Value AS STRING)
     DECLARE SUB AddDataFromFile (Name AS STRING,FileName AS STRING)
     DECLARE SUB ReplaceData (Name AS INTEGER,Value AS STRING)
     DECLARE SUB ReplaceDataFromFile (Name AS INTEGER,FileName AS STRING)
     DECLARE SUB DeleteData (Name AS STRING)
     DECLARE SUB RenameData(OldName AS STRING,Name AS STRING)
     DECLARE SUB SaveBank (FileName AS STRING)
     DECLARE FUNCTION NameExists (Name AS STRING) AS LONG
     DECLARE SUB CreateBank()

     FUNCTION BankIsOpen() AS INTEGER
	'
	' Return 1 if a bank is open, also 0
	'
      BankIsOpen=BankOpen
     END FUNCTION

     FUNCTION NameExists(Name AS STRING) AS LONG
	'
	' Return 1 if the Name of bloc exists, also 0
	'

      FOR ZBr=1 TO ZBank.Count
       IF RTRIM$(ZBank.DataName(ZBr))=Name THEN
        NameExists=1
        EXIT FUNCTION
       END IF
      NEXT

      NameExists=0
     END FUNCTION

     FUNCTION DatasCount() AS LONG
	'
	' Return the number of blocs in the bank
	'

      IF BankIsOpen=0 THEN
       MESSAGEDLG "No Bank Loaded!",mtWarning,0,0
       EXIT FUNCTION
      END IF

      DatasCount=ZBank.Count
     END FUNCTION

     FUNCTION GetDataIndex(Name AS STRING) AS LONG
	'
	' Return the number of bloc "Name" in the bank
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No Bank Loaded!",mtWarning,0,0
       EXIT FUNCTION
      END IF

      FOR ZBr=1 TO DatasCount
       IF RTRIM$(GetDataName(ZBr))=Name THEN
        GetDataIndex=ZBr
        EXIT FUNCTION
       END IF
      NEXT

	'Non trouvé
      MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0
     END FUNCTION

     FUNCTION GetDataName(Index AS LONG) AS STRING
	'
	' Return the Name of Bloc N°Index
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No Bank Loaded!",mtWarning,0,0
       EXIT FUNCTION
      END IF

      IF Index>ZBank.Count OR Index<1 THEN
       MESSAGEDLG "Invalid Index",mtWarning,0,0
       EXIT FUNCTION
      END IF

      GetDataName=RTRIM$(ZBank.DataName(Index))
     END FUNCTION

     FUNCTION GetDataSize(Name AS STRING) AS LONG
	'
	' Return the bloc "Name"'s size (in bytes)
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No bank Loaded!",mtWarning,0,0
       EXIT FUNCTION
      END IF

      FOR ZBr=1 TO ZBank.Count
       IF GetDataName(ZBr)=Name THEN
        GetDataSize=ZBank.DataSize(ZBr)
        EXIT FUNCTION
       END IF
      NEXT

	'Non trouvé
      MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0

     END FUNCTION

     FUNCTION GetDataValue (Name AS STRING) AS STRING
	'
	' Return datas structure of bloc "Name"
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No bank Loaded!",mtWarning,0,0
       EXIT FUNCTION
      END IF

      FOR ZBr=1 TO ZBank.Count
       IF GetDataName(ZBr)=Name THEN
        GetDataValue=RTRIM$(ZBank.DataValue(ZBr))
        EXIT FUNCTION
       END IF
      NEXT

	'Non trouvé
      MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0
     END FUNCTION

     SUB ExtractDataToFile (Name AS STRING, FileName AS STRING)
	'
	' Extract bloc "Name"'s datas and save them in the file "Filename"
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No Bank Loaded!",mtWarning,0,0
       EXIT SUB
      END IF

      ZBFStream.OPEN(FileName,fmCreate)
      ZBFStream.WriteStr(GetDataValue(Name),GetDataSize(Name))
      ZBFStream.CLOSE
     END SUB

     SUB AddData(Name AS STRING,Value AS STRING)
	'
	'Add bloc
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No Bank Loaded!",mtWarning,0,0
       EXIT SUB
      END IF

      IF NameExists(Name)=1 THEN
       MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0
       EXIT SUB
      END IF

      IF LEN(name)>20 THEN
       MESSAGEDLG "Bloc's name too long. 20 caracters maximum.",mtWarning,0,0
       EXIT SUB
      END IF

      IF LEN(Value)>65535 THEN
       MESSAGEDLG "Bloc'datas too great than 65535 bytes (64kb).",mtWarning,0,0
       EXIT SUB
      END IF

      ZBank.Count=DatasCount+1
      ZBank.DataName(DatasCount)=Name
      ZBank.DataSize(DatasCount)=LEN(Value)
      ZBank.DataValue(DatasCount)=Value
     END SUB

     SUB AddDataFromFile (Name AS STRING,FileName AS STRING)
	'
	'Add bloc from file
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No bank Loaded!",mtWarning,0,0
       EXIT SUB
      END IF

      IF NameExists(Name)=1 THEN
       MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0
       EXIT SUB
      END IF

      IF LEN(name)>20 THEN
       MESSAGEDLG "Bloc's name too long. 20 caracters maximum.",mtWarning,0,0
       EXIT SUB
      END IF

      IF FILEEXISTS(Filename)=False THEN
       MESSAGEDLG filename & " not found.",mtWarning,0,0
       EXIT SUB
      END IF

      ZBFStream.OPEN(FileName,fmOpenRead)

      IF ZBFStream.size>65535 THEN
       MESSAGEDLG "Bloc'datas too great than 65535 bytes (64kb).",mtWarning,0,0
       EXIT SUB
      END IF

      strBuffer=ZBFStream.ReadStr(ZBFStream.Size)

      ZBank.Count=ZBank.Count+1
      ZBank.DataName(ZBank.Count)=Name
      ZBank.DataSize(ZBank.Count)=LEN(strBuffer)
      ZBank.DataValue(ZBank.Count)=strBuffer
      ZBFStream.CLOSE
     END SUB

     SUB ReplaceData (Name AS STRING,Value AS STRING)
	'
	'Replace a bloc
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No bank Loaded",mtWarning,0,0
       EXIT SUB
      END IF

      IF NameExists(Name)=0 THEN
       MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0
       EXIT SUB
      END IF

      IF LEN(Value)>65535 THEN
       MESSAGEDLG "Bloc'datas too great than 65535 bytes (64kb).",mtWarning,0,0
       EXIT SUB
      END IF

      ZBank.DataSize(GetDataIndex(Name))=LEN(Value)
      ZBank.DataValue(GetDataIndex(Name))=Value
     END SUB

     SUB ReplaceDataFromFile (Name AS STRING,FileName AS STRING)
	'
	' replace a bloc from file
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No Bank Loaded!",mtWarning,0,0
       EXIT SUB
      END IF

      IF NameExists(Name)=0 THEN
       MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0
       EXIT SUB
      END IF

      IF FILEEXISTS(Filename)=False THEN
       MESSAGEDLG filename & " not found.",mtWarning,0,0
       EXIT SUB
      END IF

      ZBFStream.OPEN(FileName,fmOpenRead)

      IF ZBFStream.size>65535 THEN
       MESSAGEDLG "Bloc'datas too great than 65535 bytes (64kb).",mtWarning,0,0
       EXIT SUB
      END IF

      strBuffer=ZBFStream.ReadStr(ZBFStream.Size)

      ZBank.DataSize(GetDataIndex(Name))=LEN(strBuffer)
      ZBank.DataValue(GetDataIndex(Name))=strBuffer
      ZBFStream.CLOSE
     END SUB

     SUB DeleteData (Name AS STRING)
	'
	' Delete a bloc
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No Bank Loaded!",mtWarning,0,0
       EXIT SUB
      END IF

      IF NameExists(Name)=0 THEN
       MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0
       EXIT SUB
      END IF

      ZBr=GetDataIndex(Name)
      WHILE ZBr<DatasCount
       ZBank.DataName(ZBr)=ZBank.DataName(ZBr+1)
       ZBank.DataSize(ZBr)=ZBank.DataSize(ZBr+1)
       ZBank.DataValue(ZBr)=ZBank.DataValue(ZBr+1)
       ZBr=ZBr+1
      WEND

      ZBank.Count=DatasCount-1
     END SUB

     SUB RenameData(OldName AS STRING,Name AS STRING)
	'
	' Rename a bloc of datas
	'
      IF BankIsOpen=0 THEN
       MESSAGEDLG "No Bank Loaded!",mtWarning,0,0
       EXIT SUB
      END IF

      IF NameExists(OldName)=0 THEN
       MESSAGEDLG "The bloc of datas " & Name & " not exists in the bank.",mtWarning,0,0
       EXIT SUB
      END IF

      IF LEN(name)>20 THEN
       MESSAGEDLG "Bloc's name too long. 20 caracters maximum.",mtWarning,0,0
       EXIT SUB
      END IF

      IF NameExists(Name)=1 THEN
       MESSAGEDLG "A bloc named " & Name & " already exists int the bank.",mtWarning,0,0
       EXIT SUB
      END IF

      ZBank.DataName(GetDataIndex(OldName))=Name

     END SUB

     SUB LoadBank (FileName AS STRING)
	'
	' Open a bank
	'

      IF FILEEXISTS(Filename)=False THEN
       MESSAGEDLG FileName & " not found.",mtWarning,0,0
       EXIT SUB
      END IF

      ZBFStream.OPEN(FileName,fmOpenRead)

	'File Header
      strBuffer=ZBFStream.ReadStr(26)

      strBuffer=RTRIM$(strBuffer)
      IF strBuffer<>"ZBF1.0 Zecreator Bank File" AND strBuffer<>"ZBF1.c Zecreator Bank File" THEN
       MESSAGEDLG "The file " & FileName & " is not a valid bank file.",mtWarning,0,0
       EXIT SUB
      END IF

	'Load a normal bank
      IF strBuffer="ZBF1.0 Zecreator Bank File" THEN
       ZBank.Count=0
		'Get the blocs of datas
       WHILE ZBFStream.Position<ZBFStream.Size

        ZBank.count=ZBank.Count+1

			'Bloc name
        strBuffer=ZBFSTream.Readstr(20)
        ZBank.DataName(ZBank.Count)=strBuffer

			'Size and datas bloc
        strBuffer=ZBFSTream.Readstr(65535)
        ZBank.DataValue(ZBank.Count)=strBuffer
        ZBank.DataSize(ZBank.Count)=LEN(RTRIM$(strBuffer))
       WEND
      END IF

	' Load a compressed bank
      IF strBuffer="ZBF1.c Zecreator Bank File" THEN
       ZBank.Count=0
		'Get blocs of datas
       WHILE ZBFStream.Position<ZBFStream.Size

        ZBank.count=ZBank.Count+1

			'Name of bloc
        strBuffer=ZBFSTream.Readstr(20)
        ZBank.DataName(ZBank.Count)=strBuffer

			'Size and datas bloc
        strBuffer=ZBFStream.Readstr(5)
        intBuffer=VAL(strBuffer)
        strBuffer=ZBFStream.Readstr(intBuffer)
        ZBank.DataValue(ZBank.Count)=strBuffer
        ZBank.DataSize(ZBank.Count)=intBuffer
       WEND
      END IF

      BankOpen=1
      ZBFStream.CLOSE
     END SUB

     SUB SaveBank (FileName AS STRING)
	'
	' Save blocs of datas in a normal bank
	'
      ZBFStream.OPEN(Filename,fmCreate)

	'File header
      strBuffer="ZBF1.0 Zecreator Bank File"
      ZBFStream.WriteStr(strBuffer,LEN(strBuffer))

	'Record the blocs

      FOR ZBr=1 TO ZBank.Count

		'Name of Bloc
       ZBFStream.WriteStr(ZBank.DataName(ZBr),20)

		'Size and datas Bloc
       ZBFStream.WriteStr(ZBank.DataValue(ZBr),65535)
      NEXT
      ZBFStream.CLOSE
     END SUB

     SUB CompressBank (FileName AS STRING)
	'
	' Save blocs and compress bank
	'
      ZBFStream.OPEN(Filename,fmCreate)

	'File Header
      strBuffer="ZBF1.c Zecreator Bank File"
      ZBFStream.WriteStr(strBuffer,LEN(strBuffer))

	'Record blocs of datas

      FOR ZBr=1 TO ZBank.Count
		'Name of bloc
       ZBFStream.WriteStr(ZBank.DataName(ZBr),20)

		'Size and datas Bloc
       strBuffer=STR$(ZBank.DataSize(ZBr))

       IF LEN(strBuffer)<5 THEN
        strBuffer=STRING$(5-LEN(strBuffer),"0") & strBuffer
       END IF

       ZBFStream.WriteStr(strBuffer,5)
       ZBFStream.WriteStr(ZBank.DataValue(ZBr),ZBank.DataSize(ZBr))
      NEXT
      ZBFStream.CLOSE
     END SUB

     SUB CreateBank()
	'
	' Create a empty bank
	'
      ZBank.Count=0
      BankOpen=1
     END SUB

2003-06-11 13:59