home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Epsita_Ant21314110212008.psc / ETC.bas < prev    next >
BASIC Source File  |  2008-04-28  |  5KB  |  161 lines
  1. Attribute VB_Name = "ETC"
  2. Public Const DRIVE_REMOVABLE = 2
  3. Public Const DRIVE_FIXED = 3
  4. Public Const DRIVE_REMOTE = 4
  5. Public Const DRIVE_CDROM = 5
  6. Public Const DRIVE_RAMDISK = 6
  7.  
  8. Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
  9.   "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal _
  10.   lpBuffer As String) As Long
  11. Declare Function GetDriveType Lib "kernel32" Alias _
  12.   "GetDriveTypeA" (ByVal nDrive As String) As Long
  13. Private Declare Function GetSystemDirectoryA Lib "kernel32" _
  14.    (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  15. Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer
  16.  
  17.  
  18. Global Const SW_HIDE = 0
  19. Global Const SW_NORMAL = 1
  20. Global Const SW_MAXIMIZE = 3
  21. Global Const SW_MINIMIZE = 6
  22. Public Const FO_MOVE As Long = &H1
  23. Public Const FO_COPY As Long = &H2
  24. Public Const FO_DELETE As Long = &H3
  25. Public Const FO_RENAME As Long = &H4
  26. Public Const FOF_MULTIDESTFILES As Long = &H1
  27. Public Const FOF_CONFIRMMOUSE As Long = &H2
  28. Public Const FOF_SILENT As Long = &H4
  29. Public Const FOF_RENAMEONCOLLISION As Long = &H8
  30. Public Const FOF_NOCONFIRMATION As Long = &H10
  31. Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
  32. Public Const FOF_CREATEPROGRESSDLG As Long = &H0
  33. Public Const FOF_ALLOWUNDO As Long = &H40
  34. Public Const FOF_FILESONLY As Long = &H80
  35. Public Const FOF_SIMPLEPROGRESS As Long = &H100
  36. Public Const FOF_NOCONFIRMMKDIR As Long = &H200
  37.  
  38. Type SHFILEOPSTRUCT
  39.      hwnd As Long
  40.      wFunc As Long
  41.      pFrom As String
  42.      pTo As String
  43.      fFlags As Long
  44.      fAnyOperationsAborted As Long
  45.      hNameMappings As Long
  46.      lpszProgressTitle As String
  47. End Type
  48.  
  49. Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
  50.  
  51. Enum eFileAttribute
  52.     ATTR_READONLY = &H1
  53.     ATTR_HIDDEN = &H2
  54.     ATTR_SYSTEM = &H4
  55.     ATTR_DIRECTORY = &H10
  56.     ATTR_ARCHIVE = &H20
  57.     ATTR_NORMAL = &H80
  58.     ATTR_TEMPORARY = &H100
  59. End Enum
  60.  
  61.  
  62. Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
  63. Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70. Public Function AddBackslash(s As String) As String
  71.    If Len(s) > 0 Then
  72.       If Right$(s, 1) <> "\" Then
  73.          AddBackslash = s + "\"
  74.       Else
  75.          AddBackslash = s
  76.       End If
  77.    Else
  78.       AddBackslash = "\"
  79.    End If
  80. End Function
  81. '
  82. '  Returns the system directory.
  83. '
  84. Public Function GetSystemDirectory() As String
  85.    Dim s As String
  86.    Dim i As Integer
  87.    i = GetSystemDirectoryA("", 0)
  88.    s = Space(i)
  89.    Call GetSystemDirectoryA(s, i)
  90.    GetSystemDirectory = AddBackslash(Left$(s, i - 1))
  91. End Function
  92. Function ShowDriveType(drvpath) As String
  93.     Dim fs, d, s, t
  94.     Set fs = CreateObject("Scripting.FileSystemObject")
  95.     Set d = fs.GetDrive(drvpath)
  96.     Select Case d.drivetype
  97.         Case 0: t = "Unknown"
  98.         Case 1: t = "Removable"
  99.         Case 2: t = "Fixed"
  100.         Case 3: t = "Network"
  101.         Case 4: t = "CD-ROM"
  102.         Case 5: t = "RAM Disk"
  103.     End Select
  104.     s = t
  105.     ShowDriveType = s
  106. End Function
  107. Sub SaveText(Lst As TextBox, File As String)
  108. 'Call SaveText (Text1,"C:\Windows\System\Saved.txt")
  109. On Error Resume Next
  110. Dim mystr As String
  111. Open File For Output As #1
  112. Print #1, Lst
  113. Close 1
  114. Exit Sub
  115. error:
  116. End Sub
  117. Sub DOShell(sShellString As String, iWinType As Integer)
  118. Dim iInstanceHandle As Integer, X As Integer
  119. On Error Resume Next
  120. iInstanceHandle = Shell(sShellString, iWinType)
  121. On Error Resume Next
  122. End Sub
  123. Public Function FileExists(ByVal strPathName As String) As Integer
  124.     Dim intFileNum As Integer
  125.  
  126.     On Error Resume Next
  127.     If Right$(strPathName, 1) = "\" Then
  128.         strPathName = Left$(strPathName, Len(strPathName) - 1)
  129.     End If
  130.     intFileNum = FreeFile
  131.     Open strPathName For Input As intFileNum
  132.     FileExists = IIf(Err, False, True)
  133.     Close intFileNum
  134.  
  135.     Err = 0
  136. End Function
  137. Sub Get_User_Name()
  138.  
  139.                 ' Dimension variables
  140.                 Dim lpBuff As String * 25
  141.                 Dim ret As Long, UserName As String
  142.  
  143.                 ' Get the user name minus any trailing spaces found in the name.
  144.                 ret = GetUserName(lpBuff, 25)
  145.                 UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
  146.  
  147.                 ' Display the User Name
  148.                 FrmFreg.ur = UserName
  149. End Sub
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.