home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 August / PCWorld_2000-08_cd.bin / Software / TemaCD / xbasic / xbpro.exe / xb / aprofile.x < prev    next >
Text File  |  1996-01-19  |  4KB  |  158 lines
  1. '
  2. ' ####################
  3. ' #####  PROLOG  #####
  4. ' ####################
  5. '
  6. PROGRAM "aprofile"
  7. VERSION "0.0001"
  8. '
  9. IMPORT "xst"
  10. IMPORT "kernel32"
  11. '
  12. DECLARE FUNCTION  Entry ()
  13. DECLARE FUNCTION  StringsToStringArray (addr, @array$[])
  14. DECLARE FUNCTION  GetString (@addr, @string$)
  15. '
  16. '
  17. ' ######################
  18. ' #####  Entry ()  #####
  19. ' ######################
  20. '
  21. FUNCTION  Entry ()
  22. '
  23.     SetLastError (0)
  24.     temp$ = NULL$ (4095)
  25.     profile$ = NULL$ (4095)
  26.     bytes = GetPrivateProfileStringA (0, 0, 0, &profile$, 4095, &"win.ini")
  27.     IF (bytes < 0) THEN
  28.         errno = GetLastError ()
  29.         XstSystemErrorToError (errno, @error)
  30.         XstSystemErrorNumberToName (errno, @errno$)
  31.         XstErrorNumberToName (error, @error$)
  32.         PRINT bytes, errno, errno$, error$
  33.         RETURN ($$TRUE)
  34.     END IF
  35.     StringsToStringArray (&profile$, @profile$[])
  36.     IFZ profile$[] THEN RETURN
  37. '
  38. ' Print all string values of all keys in all sections
  39. '
  40.     PRINT
  41.     PRINT "*************************************"
  42.     PRINT "*****  Private Profile Strings  *****"
  43.     PRINT "*************************************"
  44.     PRINT
  45.     upper = UBOUND (profile$[])
  46.     FOR s = 0 TO upper
  47.         section$ = profile$[s]
  48.         PRINT "["; section$; "]"
  49.         GetPrivateProfileStringA (§ion$, 0, 0, &profile$, 4095, &"win.ini")
  50.         StringsToStringArray (&profile$, @key$[])
  51.         IF key$[] THEN
  52.             u = UBOUND (key$[])
  53.             FOR i = 0 TO u
  54.                 key$ = key$[i]
  55.                 pad = 32 - LEN (key$)
  56.                 pad = MAX (pad, 2)
  57.                 pad$ = " " + CHR$('.', pad-2) + " "
  58.                 default$ = "0"
  59.                 GetPrivateProfileStringA (§ion$, &key$, 0, &temp$, 4095, &"win.ini")
  60.                 value$ = CSTRING$ (&temp$)
  61.                 PRINT "  "; key$; pad$; "\""; value$; "\""
  62.             NEXT i
  63.         END IF
  64.     NEXT s
  65. '
  66. ' Create new section "Bonkers" with key "Trashburger" equals value "Cholesterol"
  67. '
  68.     WritePrivateProfileStringA (&"Bonkers", &"Trashburger", &"Cholesterol", &"win.ini")
  69. '
  70. ' Make sure "[Bonkers].Trashburger = Cholesterol" was created
  71. '
  72.     GetPrivateProfileStringA (&"Bonkers", &"Trashburger", 0, &temp$, 4095, &"win.ini")
  73.     value$ = CSTRING$ (&temp$)
  74.     PRINT "\n\nBonkers : Trashburger = "; value$
  75. '
  76. ' Delete section "Bonkers", including all keys within it
  77. '
  78.     WritePrivateProfileStringA (&"Bonkers", 0, 0, &"win.ini")
  79. '
  80. ' Confirm that section "Bonkers" no longer exists
  81. '
  82.     temp$ = NULL$ (4095)
  83.     GetPrivateProfileStringA (&"Bonkers", 0, 0, &temp$, 4095, &"win.ini")
  84.     value$ = CSTRING$ (&temp$)
  85.     PRINT "should be empty string ===>> \""; value$; "\""
  86. '
  87.     temp$ = NULL$ (4095)
  88.     GetPrivateProfileStringA (&"Bonkers", &Trashburger, 0, &temp$, 4095, &"win.ini")
  89.     value$ = CSTRING$ (&temp$)
  90.     PRINT "should be empty string ===>> \""; value$; "\""
  91.     PRINT
  92.     PRINT "******************"
  93.     PRINT "*****  DONE  *****"
  94.     PRINT "******************"
  95. END FUNCTION
  96. '
  97. '
  98. ' #####################################
  99. ' #####  StringsToStringArray ()  #####
  100. ' #####################################
  101. '
  102. FUNCTION  StringsToStringArray (addr, array$[])
  103. '
  104.     DIM array$[]
  105.     IFZ addr THEN RETURN        ' null pointer
  106.     byte = UBYTEAT (addr)        ' first byte
  107.     IFZ byte THEN RETURN        ' no array at all
  108. '
  109.     i = 0
  110.     upper = 255
  111.     DIM array$[upper]
  112. '
  113.     DO
  114.         GetString (@addr, @string$)
  115.         IFZ string$ THEN EXIT DO
  116.         IF (i > upper) THEN
  117.             upper = upper + 256
  118.             REDIM array$[upper]
  119.         END IF
  120.         array$[i] = string$
  121.         INC i
  122.     LOOP
  123. '
  124.     DEC i
  125.     REDIM array$[i]
  126. END FUNCTION
  127. '
  128. '
  129. ' ##########################
  130. ' #####  GetString ()  #####
  131. ' ##########################
  132. '
  133. FUNCTION  GetString (addr, string$)
  134. '
  135.     string$ = ""
  136.     IFZ addr THEN RETURN
  137.     byte = UBYTEAT (addr)
  138.     IFZ byte THEN RETURN
  139. '
  140.     a = addr
  141.     i = -1
  142.     DO
  143.         byte = UBYTEAT (a)
  144.         INC a
  145.         INC i
  146.     LOOP WHILE byte
  147. '
  148.     IFZ i THEN INC addr : RETURN        ' move past empty string
  149.     string$ = NULL$ (i)                            ' make destination string
  150. '
  151.     FOR d = 0 TO i-1
  152.         string${d} = UBYTEAT (addr)        ' add next byte to string
  153.         INC addr
  154.     NEXT d
  155.     INC addr                                                ' move past null terminator
  156. END FUNCTION
  157. END PROGRAM
  158.