GFDataFile/Form1.frm

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3185
   ClientLeft      =   65
   ClientTop       =   351
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3185
   ScaleWidth      =   4680
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.TextBox Text4
      Height          =   285
      Left            =   2160
      TabIndex        =   9
      Top             =   1380
      Width           =   1695
   End
   Begin VB.TextBox Text3
      Height          =   285
      Left            =   2160
      TabIndex        =   8
      Top             =   1080
      Width           =   1695
   End
   Begin VB.TextBox Text2
      Height          =   285
      Left            =   2160
      TabIndex        =   7
      Top             =   480
      Width           =   1695
   End
   Begin VB.TextBox Text1
      Height          =   285
      Left            =   2160
      TabIndex        =   6
      Top             =   180
      Width           =   1695
   End
   Begin VB.CommandButton Command2
      Caption         =   "Write"
      Height          =   315
      Left            =   2520
      TabIndex        =   1
      Top             =   2640
      Width           =   1935
   End
   Begin VB.CommandButton Command1
      Caption         =   "Read"
      Height          =   315
      Left            =   180
      TabIndex        =   0
      Top             =   2640
      Width           =   1935
   End
   Begin VB.Label Label4
      Caption         =   "BackColor"
      Height          =   195
      Left            =   120
      TabIndex        =   5
      Top             =   1440
      Width           =   1935
   End
   Begin VB.Label Label3
      Caption         =   "AutoRedraw"
      Height          =   195
      Left            =   120
      TabIndex        =   4
      Top             =   1140
      Width           =   1935
   End
   Begin VB.Label Label2
      Caption         =   "AutoSize"
      Height          =   195
      Left            =   120
      TabIndex        =   3
      Top             =   540
      Width           =   1935
   End
   Begin VB.Label Label1
      Caption         =   "AutoRedraw"
      Height          =   195
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   1935
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis.
'GFDataFile
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (pDest As Any, pSource As AnyByVal dwLength As Long)
'
'NOTE: GFDataFile is used to read/write a DataFile with the following
'format (example file content):
'
'[Colors] <‑GFDFHeadLine
'TextForeGround=200349 <‑GFDFCommandLine (consisting of command and value)
'TextBackGround=132443
'
'Every line in the DataFile has one of the GFDataFileLineTypes
'(listed below). The meaning of the GFDataFileLine[w/lParam]
'depends on this line type (type/meaning):
'
'HEADLINE: wParam: headline text, lParam: "" (ignored)
'COMMANDLINE: wParam: command, lParam: value
'
'NOTE: creating a DataFile works as follows (to do when inserting
'GFDataFile into the target project):
'
'‑define what will be written into DataFile by calling GFDataFileStruct_AddLine()
'‑set default values using GFDataFileStruct_SetValue()
'‑write/read DataFile using GFDataFile_[Write/Read]()
'‑get read values using GFDataFileStruct_GetValue()
'
'View sample code at bottom of this form for further information.
'
'NOTE: this code does not support multiple instances, either create an addition
'GFDataFileStructArray() or copy this code to multiple forms of the target project.
'
'GFDataFile
Private Const GFDATAFILE_LINETYPE_HEADLINE As Integer = 1
Private Const GFDATAFILE_LINETYPE_COMMANDLINE As Integer = 2
'GFDataFile
Private Type GFDataFileStruct
    DataFileLineType As Integer
    DataFileLinewParam As String
    DataFileLinelParam As String
End Type
Dim GFDataFileStructNumber As Integer 'one structure 'copy' per DataFile line
Dim GFDataFileStructArray() As GFDataFileStruct

Dim DEBUG_DataFile As String 'NOT TO BE COPIED

'**************************************GFDATAFILE***************************************
'NOTE: use the GFDataFile code to quickly write/read DataFiles.
'Search general function source project for further information.

Private Sub GFDataFileStruct_Reset(ByRef GFDataFileStructArray() As GFDataFileStruct, ByRef GFDataFileStructNumber As Integer)
    'on error resume next 'call before adding DataFile line to struct
    GFDataFileStructNumber = 0
    ReDim GFDataFileStructArray(1 To 1) As GFDataFileStruct
End Sub

Private Function GFDataFileStruct_AddLine(ByVal DataFileLineType As IntegerByVal DataFileLinewParam As StringByRef GFDataFileStructArray() As GFDataFileStruct, ByRef GFDataFileStructNumber As Integer) As Boolean
    On Error GoTo Error: 'function returns True for success or False in case of any error (memory low)
    If Not (GFDataFileStructNumber = 32767) Then 'verify (line number limited to 32767)
        GFDataFileStructNumber = GFDataFileStructNumber + 1
    Else
        MsgBox "internal error in GFDataFileStruct_AddLine(): overflow !", vbOKOnly + vbExclamation
        GFDataFileStruct_AddLine = False 'error
        Exit Function 'error
    End If
    ReDim Preserve GFDataFileStructArray(1 To GFDataFileStructNumber) As GFDataFileStruct
    GFDataFileStructArray(GFDataFileStructNumber).DataFileLineType = DataFileLineType
    GFDataFileStructArray(GFDataFileStructNumber).DataFileLinewParam = DataFileLinewParam
    GFDataFileStruct_AddLine = True 'ok
    Exit Function
Error: 'i.e. memory low
    'do not jump to error (error description displayed)
    MsgBox "internal error in GFDataFileStruct_AddLine(): " + Left$(Err.Description, 512) + " !", vbOKOnly + vbExclamation
    GFDataFileStruct_AddLine = False 'error
    Exit Function
End Function

Private Function GFDataFileStruct_SetValue(ByVal DataFileCommand As StringByVal DataFIleValue As StringByRef GFDataFileStructArray() As GFDataFileStruct, ByVal GFDataFileStructNumber As Integer) As Boolean
    'on error resume next 'function returns True for success or False in case of error (DataFileCommand not found within struct)
    Dim Temp As Long
    For Temp = 1 To GFDataFileStructNumber
        'compare to GFDataFile_AllocateDataFileLine()
        If GFDataFileStructArray(Temp).DataFileLinewParam = DataFileCommand Then
            If GFDataFileStructArray(Temp).DataFileLineType = GFDATAFILE_LINETYPE_COMMANDLINE Then 'command mustn't be exchanged with head line
                GFDataFileStructArray(Temp).DataFileLinelParam = DataFIleValue
                GFDataFileStruct_SetValue = True 'ok
                Exit Function 'ok
            End If
        End If
    Next Temp
    GFDataFileStruct_SetValue = False 'error (DataFileCommand not found within struct)
    Exit Function 'error
End Function

Private Function GFDataFileStruct_GetValue(ByVal DataFileCommand As StringByRef GFDataFileStructArray() As GFDataFileStruct, ByVal GFDataFileStructNumber As Integer) As String
    'on error resume next 'sub will set DataFileValue
    Dim Temp As Long
    For Temp = 1 To GFDataFileStructNumber
        'compare to GFDataFile_AllocateDataFileLine()
        If GFDataFileStructArray(Temp).DataFileLinewParam = DataFileCommand Then
            If GFDataFileStructArray(Temp).DataFileLineType = GFDATAFILE_LINETYPE_COMMANDLINE Then 'command mustn't be exchanged with head line
                GFDataFileStruct_GetValue = GFDataFileStructArray(Temp).DataFileLinelParam
                Exit Function 'ok
            End If
        End If
    Next Temp
    GFDataFileStruct_GetValue = "" 'reset (error)
    Exit Function 'error
End Function

Private Function GFDataFile_Write(ByVal DataFile As StringByRef GFDataFileStructArray() As GFDataFileStruct, ByRef GFDataFileStructNumber As Integer) As Boolean
    On Error GoTo Error: 'returns True if DataFile has been completely written, False if not
    Dim DataFileFileNumber As Integer
    Dim DataFileLine As String
    Dim DataFileLineType As Integer
    Dim DataFileLineTypeOld As Integer
    Dim Temp As Long
    'preset
    DataFileLineTypeOld = GFDATAFILE_LINETYPE_HEADLINE
    DataFileFileNumber = FreeFile(0)
    If DataFileFileNumber = 0 Then
        MsgBox "internal error in GFDataFile_Write() !", vbOKOnly + vbExclamation
        GFDataFile_Write = False 'error
        Exit Function 'important
    End If
    'begin
    If Not ((Right$(DataFile, 1) = "\") Or (DataFile = "")) Then 'verify
        Open DataFile For Output As #DataFileFileNumber
            For Temp = 1 To GFDataFileStructNumber
                DataFileLineType = GFDataFileStructArray(Temp).DataFileLineType
                DataFileLine = GFDataFile_GetDataFileLineFromDataFileStruct(GFDataFileStructArray(), Temp)
                If (DataFileLineType = GFDATAFILE_LINETYPE_HEADLINE) And _
                    (Not (DataFileLineTypeOld = GFDATAFILE_LINETYPE_HEADLINE)) Then
                    Print #DataFileFileNumber, "" 'empty line before head line (of not at file start)
                End If
                Print #DataFileFileNumber, DataFileLine
                DataFileLineTypeOld = DataFileLineType
            Next Temp
        Close #DataFileFileNumber
    Else
        MsgBox "internal error in GFDataFile_Write(): file '" + Left$(DataFile, 512) + "' not found !", vbOKOnly + vbExclamation
        GFDataFile_Write = False 'error
        Exit Function 'important
    End If
    GFDataFile_Write = True 'ok
    Exit Function
Error: 'if disk space insufficient
    Close #DataFileFileNumber 'make sure file is closed
    'NOTE: do not jump to Error:
    MsgBox "internal error in GFDataFile_Write(): " + Left$(Err.Description, 512) + " !", vbOKOnly + vbExclamation
    GFDataFile_Write = False 'error
    Exit Function
End Function

Private Function GFDataFile_GetDataFileLineFromDataFileStruct(ByRef GFDataFileStructArray() As GFDataFileStruct, ByVal GFDataFileStructNumberPointer As Integer) As String
    'on error resume next
    Dim Tempstr$
    'verify
    If (GFDataFileStructNumberPointer < 1) Or (GFDataFileStructNumberPointer > GFDataFileStructNumber) Then 'verify
        GFDataFile_GetDataFileLineFromDataFileStruct = "" 'reset (error)
        MsgBox "internal error in GFDataFile_GetDataFileLineFromDataFileStruct(): passed value invalid !", vbOKOnly + vbExclamation
        Exit Function 'error
    End If
    'begin
    Select Case GFDataFileStructArray(GFDataFileStructNumberPointer).DataFileLineType
    Case GFDATAFILE_LINETYPE_HEADLINE
        With GFDataFileStructArray(GFDataFileStructNumberPointer)
            Tempstr$ = "[" + .DataFileLinewParam + "]" 'use short temporary var to increase speed
            GFDataFile_GetDataFileLineFromDataFileStruct = Tempstr$
        End With
    Case GFDATAFILE_LINETYPE_COMMANDLINE
        With GFDataFileStructArray(GFDataFileStructNumberPointer)
            Tempstr$ = .DataFileLinewParam + "=" + .DataFileLinelParam
            GFDataFile_GetDataFileLineFromDataFileStruct = Tempstr$
        End With
    Case Else
        MsgBox "internal error in GFDataFile_GetDataFileLineFromDataFileStruct() !", vbOKOnly + vbExclamation
        GFDataFile_GetDataFileLineFromDataFileStruct = "" 'reset (error)
    End Select
End Function

Private Function GFDataFile_Read(ByVal DataFile As StringByRef GFDataFileStructArray() As GFDataFileStruct, ByVal GFDataFileStructNumber As Integer) As Boolean
    'on error resume next 'function returns True for success or False for error
    Dim DataFileFileNumber As Integer
    Dim DataFileLine As String
    'preset
    DataFileFileNumber = FreeFile(0)
    If DataFileFileNumber = 0 Then 'verify
        MsgBox "internal error in GFDataFile_Read() !", vbOKOnly + vbExclamation
        GFDataFile_Read = False 'error
        Exit Function 'error
    End If
    'begin
    If Not ((Dir(DataFile) = "") Or (Right$(DataFile, 1) = "\") Or (DataFile = "")) Then 'verify
        Open DataFile For Input As #DataFileFileNumber
            Do While Not ((EOF(DataFileFileNumber)) Or (Seek(DataFileFileNumber) = LOF(DataFileFileNumber)))
                Line Input #DataFileFileNumber, DataFileLine
                Call GFDataFile_AllocateDataFileLine(DataFileLine, GFDataFileStructArray(), GFDataFileStructNumber)
            Loop
        Close #DataFileFileNumber
        GFDataFile_Read = True 'ok
        Exit Function 'ok
    Else
        MsgBox "internal error in GFDataFile_Read(): file '" + Left$(DataFile, 512) + "' not found !", vbOKOnly + vbExclamation
        GFDataFile_Read = False 'error
        Exit Function 'error
    End If
End Function

Private Sub GFDataFile_AllocateDataFileLine(ByVal DataFileLine As StringByRef GFDataFileStructArray() As GFDataFileStruct, ByVal GFDataFileStructNumber As Integer)
    'on error resume next 'allocates a DataFile value for related command
    Dim DataFileCommand As String
    Dim DataFIleValue As String
    Dim Temp As Long
    Dim Temp2 As Long
    'begin
    Temp = InStr(1, DataFileLine, "=", vbBinaryCompare)
    Select Case Temp
    Case 0
        Exit Sub 'nothing to allocate
    Case Else
        DataFileCommand = Left$(DataFileLine, Temp ‑ 1)
        DataFIleValue = Right$(DataFileLine, Len(DataFileLine) ‑ Temp)
        Select Case Len(DataFileCommand)
        Case 0
            Exit Sub 'nothing to allocate
        Case Else
            For Temp2 = 1 To GFDataFileStructNumber
                'compare to GFDataFile_GetLine()
                If DataFileCommand = GFDataFileStructArray(Temp2).DataFileLinewParam Then
                    If GFDataFileStructArray(Temp2).DataFileLineType = GFDATAFILE_LINETYPE_COMMANDLINE Then 'command mustn't be exchanged with head line
                        GFDataFileStructArray(Temp2).DataFileLinelParam = DataFIleValue
                        Exit For 'important
                    End If
                End If
            Next Temp2
        End Select
    End Select
End Sub

'***********************************END OF GFDATAFILE***********************************
'***SAMPLE CODE (DO NOT COPY WITHOUT MANIPULATION)***

Private Sub Form_Load()
    'on error resume next
    Call DefineVars
    Call DefineDataFile
End Sub

Private Sub Command1_Click()
    'on error resume next 'read
    Call DataFile_Read
End Sub

Private Sub Command2_Click()
    'on error resume next 'write
    Call DataFile_Write
End Sub

Private Sub DefineVars()
    'on error resume next
    DEBUG_DataFile = App.Path + "\" + "sample.txt" 'sample DataFile
End Sub

Private Sub DefineDataFile()
    'on error resume next
    Call GFDataFileStruct_Reset(GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_AddLine(GFDATAFILE_LINETYPE_HEADLINE, "Options", GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_AddLine(GFDATAFILE_LINETYPE_COMMANDLINE, "AutoRedraw", GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_AddLine(GFDATAFILE_LINETYPE_COMMANDLINE, "AutoSize", GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_AddLine(GFDATAFILE_LINETYPE_HEADLINE, "Colors", GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_AddLine(GFDATAFILE_LINETYPE_COMMANDLINE, "ForeColor", GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_AddLine(GFDATAFILE_LINETYPE_COMMANDLINE, "BackColor", GFDataFileStructArray(), GFDataFileStructNumber)
End Sub

Private Sub DataFile_Write()
    'on error resume next
    Call GFDataFileStruct_SetValue("AutoRedraw", Text1.Text, GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_SetValue("AutoSize", Text2.Text, GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_SetValue("ForeColor", Text3.Text, GFDataFileStructArray(), GFDataFileStructNumber)
    Call GFDataFileStruct_SetValue("BackColor", Text4.Text, GFDataFileStructArray(), GFDataFileStructNumber)
    Debug.Print GFDataFile_Write(DEBUG_DataFile, GFDataFileStructArray(), GFDataFileStructNumber)
End Sub

Private Sub DataFile_Read()
    'on error resume next
    Debug.Print GFDataFile_Read(DEBUG_DataFile, GFDataFileStructArray(), GFDataFileStructNumber)
    Text1.Text = GFDataFileStruct_GetValue("AutoRedraw", GFDataFileStructArray(), GFDataFileStructNumber)
    Text2.Text = GFDataFileStruct_GetValue("AutoSize", GFDataFileStructArray(), GFDataFileStructNumber)
    Text3.Text = GFDataFileStruct_GetValue("ForeColor", GFDataFileStructArray(), GFDataFileStructNumber)
    Text4.Text = GFDataFileStruct_GetValue("BackColor", GFDataFileStructArray(), GFDataFileStructNumber)
End Sub


[END OF FILE]