home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD173503202001.psc / GrhDatMaker / General.bas < prev    next >
Encoding:
BASIC Source File  |  1999-07-18  |  2.6 KB  |  80 lines
  1. Attribute VB_Name = "General"
  2. Option Explicit
  3.  
  4. Public IniPath As String
  5.  
  6.  
  7. '********** OUTSIDE FUNCTIONS ***********'
  8. Declare Function writeprivateprofilestring Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpString As String, ByVal lpfilename As String) As Long
  9. Declare Function getprivateprofilestring Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpdefault As String, ByVal lpreturnedstring As String, ByVal nsize As Long, ByVal lpfilename As String) As Long
  10.  
  11. Public Function ReadField(Pos As Integer, Text As String, SepASCII As Integer) As String
  12.  
  13. '*****************************************************************
  14. 'Gets a field from a string
  15. '*****************************************************************
  16.  
  17. Dim i As Integer
  18. Dim LastPos As Integer
  19. Dim CurChar As String * 1
  20. Dim FieldNum As Integer
  21. Dim Seperator As String
  22.  
  23. Seperator = Chr(SepASCII)
  24. LastPos = 0
  25. FieldNum = 0
  26. For i = 1 To Len(Text)
  27.     CurChar = Mid(Text, i, 1)
  28.     If CurChar = Seperator Then
  29.         FieldNum = FieldNum + 1
  30.         If FieldNum = Pos Then
  31.             ReadField = Mid(Text, LastPos + 1, (InStr(LastPos + 1, Text, Seperator, vbTextCompare) - 1) - (LastPos))
  32.             Exit Function
  33.         End If
  34.         LastPos = i
  35.     End If
  36. Next i
  37. FieldNum = FieldNum + 1
  38. If FieldNum = Pos Then
  39.     ReadField = Mid(Text, LastPos + 1)
  40. End If
  41.  
  42.  
  43. End Function
  44.  
  45. Function FileExist(File As String, FileType As VbFileAttribute) As Boolean
  46. '*****************************************************************
  47. 'Checks to see if a file exists
  48. '*****************************************************************
  49.  
  50. If Dir(File, FileType) = "" Then
  51.     FileExist = False
  52. Else
  53.     FileExist = True
  54. End If
  55.  
  56. End Function
  57.  
  58. Function GetVar(File As String, Main As String, Var As String) As String
  59. '*****************************************************************
  60. 'Get a variable from a a text file
  61. '*****************************************************************
  62. Dim l As Integer
  63. Dim Char As String
  64. Dim sSpaces As String ' This will hold the input that the program will retrieve
  65. Dim szReturn As String ' This will be the defaul value if the string is not found
  66.  
  67. szReturn = ""
  68.  
  69. sSpaces = Space(5000) ' This tells the computer how long the longest string can be. If you want, you can change the number 75 to any number you wish
  70.  
  71.  
  72. getprivateprofilestring Main, Var, szReturn, sSpaces, Len(sSpaces), File
  73.  
  74. GetVar = RTrim(sSpaces)
  75. GetVar = Left(GetVar, Len(GetVar) - 1)
  76.  
  77. End Function
  78.  
  79.  
  80.