home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1995 November / PCPRO_NOV95.ISO / code / vb / all_code.txt next >
Encoding:
Text File  |  1995-09-08  |  1.9 KB  |  96 lines
  1. Code Section A
  2.  
  3. Sub Main()
  4. æThis is where our initialisation
  5. æcode would go, if we had any
  6. End Sub
  7.  
  8.  
  9. Code Section B
  10.  
  11. Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long   æall one line
  12.  
  13. Global Const gintMAX_SIZE% = 255
  14. Global Const gstrNULL$ = ""
  15.  
  16. Sub AddDirSep(strPathName As String)
  17.     If Right$(RTrim$(strPathName), Len(gstrSEP_DIR)) <> gstrSEP_DIR Then
  18.         strPathName = RTrim$(strPathName) & gstrSEP_DIR
  19.     End If
  20. End Sub
  21.  
  22. Function StripTerminator(ByVal strString As String) As String
  23.     Dim intZeroPos As Integer
  24.  
  25.     intZeroPos = InStr(strString, Chr$(0))
  26.     If intZeroPos > 0 Then
  27.         StripTerminator = Left$(strString, intZeroPos - 1)
  28.     Else
  29.         StripTerminator = strString
  30.     End If
  31. End Function
  32.  
  33. Function UCase16(ByVal str As String)
  34. #If Win16 Then
  35.     UCase16 = UCase$(str)
  36. #Else
  37.     UCase16 = str
  38. #End If
  39. End Function
  40.  
  41.  
  42. Code Section C
  43.  
  44. Public Property Get Created() As Date
  45.     Created = datCreated
  46. End Property
  47.  
  48.  
  49. Code Section D
  50.  
  51. Private datCreated As Date
  52.  
  53.  
  54. Code Section E
  55.  
  56. Public Function GetWindowsDir() As String
  57.     Dim strBuf As String
  58.  
  59.     strBuf = Space$(gintMAX_SIZE)
  60.  
  61.     'Get the windows directory and then trim the buffer to the exact length
  62.     'returned and add a dir sep (backslash) if the API didn't return one
  63.  
  64.     If GetWindowsDirectory(strBuf, gintMAX_SIZE) > 0 Then
  65.         strBuf = StripTerminator$(strBuf)
  66.         AddDirSep strBuf
  67.  
  68.         GetWindowsDir = UCase16(strBuf)
  69.     Else
  70.         GetWindowsDir = gstrNULL
  71.     End If
  72. End Function
  73.  
  74.  
  75. Code Section F
  76.  
  77. Private Sub Command1_Click()
  78. Dim x As GetDir.WindowsLocation
  79.  
  80. Set x = New GetDir.WindowsLocation
  81. MsgBox t.Created
  82. End Sub
  83.  
  84.  
  85. Code Section G
  86.  
  87. Private y As Object
  88.  
  89.  
  90. Code Section H
  91.  
  92. Private Sub Command2_Click()
  93. Set y = CreateObject("GetDir.WindowsLocation")
  94. Text1.TEXT = y.GetWindowsDir
  95. End Sub
  96.