home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code1 / address / general.bas < prev    next >
BASIC Source File  |  1993-07-05  |  5KB  |  113 lines
  1. 'these are all general routines for any program
  2. Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
  3. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  4. Declare Function GetProfileInt Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Integer) As Integer
  5. Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
  6. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Integer
  7. Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any) As Integer
  8.  
  9. Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  10. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  11.  
  12. Declare Function GetVersion Lib "Kernel" () As Long
  13.  
  14. Function GetPPKeyString$ (AppName$, KeyName$, Default$, FileName$)
  15. Size% = 255
  16. ReturnString$ = Space$(Size%)
  17. ValidLength% = GetPrivateProfileString(AppName$, KeyName$, Default$, ReturnString$, Size%, FileName$)
  18. GetPPKeyString$ = Left$(ReturnString$, ValidLength%)
  19. End Function
  20.  
  21. Function GetSPKeyString$ (AppName$, KeyName$, Default$)
  22. 'get the windows directory
  23. WinDir$ = Space$(144)
  24. Result% = GetWindowsDirectory(WinDir$, 144)
  25. If Result% = 0 Then
  26.     GetSPKeyString$ = Default$
  27.     Exit Function
  28. Else
  29.     i% = InStr(WinDir$, Chr$(0))
  30.     If i% Then
  31.         WinDir$ = Left$(WinDir$, i% - 1)
  32.     End If
  33.     WinDir$ = Trim$(WinDir$)
  34.     If Right$(WinDir$, 1) <> "\" Then
  35.         WinDir$ = WinDir$ & "\"
  36.     End If
  37. End If
  38. 'check system.ini as private profile
  39. FileName$ = WinDir$ & "system.ini"
  40. GetSPKeyString$ = GetPPKeyString$(AppName$, KeyName$, Default$, FileName$)
  41. End Function
  42.  
  43. Function GetWPKeyString$ (AppName$, KeyName$, Default$)
  44. Size% = 255
  45. ReturnString$ = Space$(Size%)
  46. ValidLength% = GetProfileString(AppName$, KeyName$, Default$, ReturnString$, Size%)
  47. GetWPKeyString$ = Left$(ReturnString$, ValidLength%)
  48. End Function
  49.  
  50. Function INISetup% (FileName$)
  51. 'this function checks to see if the ini file exists. if
  52. 'not it attempts to create it. returns false if it can't
  53. INISetup% = False
  54. If Dir$(FileName$) = "" Then    'not there then make
  55.     On Error GoTo INIError
  56.     FileNum% = FreeFile
  57.     Open FileName$ For Output As FileNum%
  58.     Close #FileNum%
  59.     On Error GoTo 0
  60. End If
  61. INISetup% = True
  62. Exit Function
  63. INIError:
  64.     Resume INIExit
  65. INIExit:
  66. End Function
  67.  
  68. Function IsWavePlay% ()
  69. 'this function makes sure the computer can play wave files
  70. 'it may be a little over kill. it just checks some key
  71. 'settings in the system.ini file. returns false if something
  72. 'needed is not there
  73. IsWavePlay% = False     'assume no wave playing
  74. Default$ = "nowave"
  75. s$ = GetSPKeyString$("boot", "sound.drv", Default$)
  76. If s$ = "nowave" Then Exit Function
  77. s$ = GetSPKeyString$("boot", "drivers", Default$)
  78. If s$ = "nowave" Then Exit Function
  79. s$ = GetSPKeyString$("drivers", "wave", Default$)
  80. If s$ = "nowave" Then Exit Function
  81. s$ = GetSPKeyString$("mci", "WaveAudio", Default$)
  82. If s$ = "nowave" Then Exit Function
  83. IsWavePlay% = True
  84. End Function
  85.  
  86. Function WritePPKeyString% (AppName$, KeyName$, SetName$, FileName$)
  87. Dim DeleteIt As Long
  88. DeleteIt = 0&
  89. If SetName$ = "" Then       'Delete KeyName
  90.     Result% = WritePrivateProfileString(AppName$, KeyName$, DeleteIt, FileName$)
  91. ElseIf KeyName$ = "" Then   'delete section
  92.     Result% = WritePrivateProfileString(AppName$, DeleteIt, "", FileName$)
  93. Else
  94.     Result% = WritePrivateProfileString(AppName$, KeyName$, SetName$, FileName$)
  95. End If
  96. WritePPKeyString% = Result%
  97. End Function
  98.  
  99. Function WriteWPKeyString% (AppName$, KeyName$, SetName$)
  100. Dim DeleteIt As Long
  101. DeleteIt = 0&
  102. If SetName$ = "" Then       'Delete KeyName
  103.     Result% = WriteProfileString(AppName$, KeyName$, DeleteIt)
  104. ElseIf KeyName$ = "" Then   'delete section
  105.     Result% = WriteProfileString(AppName$, DeleteIt, "")
  106. Else
  107.     Result% = WriteProfileString(AppName$, KeyName$, SetName$)
  108.  
  109. End If
  110. WriteWPKeyString% = Result%
  111. End Function
  112.  
  113.