rqwork 2009-03-15 10:50

'QIniFile component for Rapidq
'Copyright @ 2009 Nastase Eodor
'mail : rqwork@evonet.ro
'http://rqwork.evonet.ro

     $IFNDEF __RQSYSUTILS
      $INCLUDE "SysUtils.inc"
     $ENDIF

'If you use Windows.inc do uptate with this->
     $IFNDEF __WIN32API
      DECLARE FUNCTION GetWindowsDirectory LIB "kernel32" ALIAS "GetWindowsDirectoryA" (lpBuffer AS LONG, nSize AS LONG) AS LONG
      DECLARE FUNCTION GetPrivateProfileInt LIB "kernel32" ALIAS "GetPrivateProfileIntA" (lpApplicationName AS STRING, lpKeyName AS STRING, nDefault AS LONG, lpFileName AS STRING) AS LONG
      DECLARE FUNCTION GetPrivateProfileString LIB "kernel32" ALIAS "GetPrivateProfileStringA" (lpApplicationName AS LONG, lpKeyName AS LONG, lpDefault AS LONG, lpReturnedString AS LONG, nSize AS LONG, lpFileName AS STRING) AS LONG
      DECLARE FUNCTION WritePrivateProfileString LIB "kernel32" ALIAS "WritePrivateProfileStringA" (lpApplicationName AS LONG, lpKeyName AS LONG, lpString AS LONG, lpFileName AS STRING) AS LONG
      DECLARE FUNCTION GetPrivateProfileSection LIB "kernel32" ALIAS "GetPrivateProfileSectionA" (lpAppName AS STRING, ByRef lpReturnedString AS STRING, nSize AS LONG, lpFileName AS STRING) AS LONG
      DECLARE FUNCTION WritePrivateProfileSection LIB "kernel32" ALIAS "WritePrivateProfileSectionA" (lpAppName AS STRING, lpString AS STRING, lpFileName AS STRING) AS LONG
     $ENDIF

     TYPE QIniFile EXTENDS QOBJECT
Private:
Public:
      File  AS STRING

      WITH This

       SUB CreateFile(File$)
        IF ExtractFilePath(File$) = "" THEN
         DEFSTR lpBuffer = SPACE$(260)
         DEFSHORT Size
         Size = GetWindowsDirectory(VARPTR(lpBuffer),260)
         .File = LEFT$(lpBuffer,Size) & IIF(ExtractFileName(File$) <> "",ExtractFileName(File$),ChangeFileExt(Application.ExeName,".ini"))
        ELSE
         IF ExtractFileName(File$) = "" THEN
          .File = File$ & ChangeFileExt(Application.ExeName,".ini")
         ELSE
          .File = File$
         END IF
        END IF
       END SUB

       SUB WriteString(Section$,Key$,Value$)
        DEFSTR Section = Section$,Key = Key$,Value = Value$
        WritePrivateProfileString(VARPTR(Section),VARPTR(Key),VARPTR(Value),.File)
       END SUB

       SUB WriteInteger(Section$,Key$,Value&)
        DEFSTR Section = Section$,Key = Key$,Value = STR$(Value&)
        WritePrivateProfileString(VARPTR(Section),VARPTR(Key),VARPTR(Value),.File)
       END SUB

       SUB WriteFloat(Section$,Key$,Value#)
        DEFSTR Section = Section$,Key = Key$,Value = STR$(Value#)
        WritePrivateProfileString(VARPTR(Section),VARPTR(Key),VARPTR(Value),.File)
       END SUB

       FUNCTION ReadString(Section$,Key$,Inplace$) AS STRING
        DEFSTR Section = Section$,Key = Key$,Inplace = Inplace$,Buffer = SPACE$(2048)
        DEFINT Size = GetPrivateProfileString(VARPTR(Section),VARPTR(Key),VARPTR(Inplace),VARPTR(Buffer),2048,.File)
        Result = LEFT$(Buffer,Size)
       END FUNCTION

       FUNCTION ReadInteger(Section$,Key$,Inplace&) AS INTEGER
        Result = GetPrivateProfileInt(Section$,Key$,Inplace&,.File)
       END FUNCTION

       FUNCTION ReadFloat(Section$,Key$,Inplace#) AS STRING
        DEFSTR Section = Section$,Key = Key$,Inplace = Inplace$,Buffer = SPACE$(2048)
        DEFINT Size = GetPrivateProfileString(VARPTR(Section),VARPTR(Key),VARPTR(Inplace),VARPTR(Buffer),2048,.File)
        Result = VAL(LEFT$(Buffer,Size))
       END FUNCTION

       SUB ReadSection(Section$,Buff AS QSTRINGLIST)
        DEFSTR Text = Section$,Buffer = SPACE$(16384)
        DEFINT Size = GetPrivateProfileSection(Section$,Buffer,16384,.File)
        Text =  LEFT$(Buffer,Size)
        Buff.Text = REPLACESUBSTR$(Text,CHR$(0),CHR$(10))
       END SUB

       SUB ReadSectionKeys(Section$,Buff AS QSTRINGLIST)
        DEFSTR Text = Section$,Buffer = SPACE$(16384)
        DEFINT Size = GetPrivateProfileString(VARPTR(Text),0,0,VARPTR(Buffer),16384,.File)
        Text =  LEFT$(Buffer,Size)
        Buff.Text = REPLACESUBSTR$(Text,CHR$(0),CHR$(10))
       END SUB

       SUB ReadSections(Buff AS QSTRINGLIST)
        DEFSTR Text,Buffer = SPACE$(16384)
        DEFINT Size = GetPrivateProfileString(0,0,0,VARPTR(Buffer),16384,.File)
        Text =  LEFT$(Buffer,Size)
        Buff.Text = REPLACESUBSTR$(Text,CHR$(0),CHR$(10))
       END SUB

       SUB ReadSectionValues(Section$,Buff AS QSTRINGLIST)
        DEFINT i
        DIM List AS QSTRINGLIST
        List.Clear
        .ReadSectionKeys(Section$,List)
        FOR i = 0 TO List.ItemCount -1
         Buff.AddItems .ReadString(Section$,List.Item(i),"")
        NEXT i
       END SUB

       SUB EraseSection(Section$)
        DEFSTR Section = Section$
        WritePrivateProfileString(VARPTR(Section),0,0,.File)
       END SUB

       SUB DeleteKey(Section$,Key$)
        DEFSTR Section = Section$,Key = Key$
        WritePrivateProfileString(VARPTR(Section),VARPTR(Key),0,.File)
       END SUB

       SUB Update
        WritePrivateProfileString(0,0,0,.File)
       END SUB

      END WITH

      CONSTRUCTOR
      END CONSTRUCTOR
     END TYPE

rqwork 2009-03-15 10:50