?? modulecomm.bas
字號(hào):
Dim sDrive As String
Dim dByteSize As Double
Dim dSpace As Double
DiskName = Left$(DiskName, 3)
If Len(DiskName) < 2 Then DiskName = DiskName + ":\"
If Len(DiskName) < 3 Then DiskName = DiskName + "\"
If Mid$(DiskName, 3, 1) <> "\" Then Mid(DiskName, 3, 1) = "\"
If Mid$(DiskName, 2, 1) <> ":" Then Mid(DiskName, 2, 1) = ":"
lReturn = GetDriveType(DiskName)
Select Case lReturn
Case DRIVE_UNKNOWN
DiskType = "Unknown"
Case DRIVE_NOTEXIST
DiskType = "Not Found"
Case DRIVE_REMOVABLE
DiskType = "Removable"
Case DRIVE_FIXED
DiskType = "Fixed"
Case DRIVE_REMOTE
DiskType = "Remote"
Case DRIVE_RAMDISK
DiskType = "Ram Disk"
Case DRIVE_CDROM
DiskType = "CD-ROM"
End Select
lReturn = GetDiskFreeSpace(DiskName, lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters)
TotalSpace = 0
FreeSpace = 0
If lFreeClusters >= 65526 Then
DiskType = DiskType + "(>2G)"
End If
If lReturn = 1 Then
' Compute and show the total free Mb
' All values are cast to doubles to avoid
' overflow problems for large disks
FreeSpace = CCur(lSectorsPerCluster) * CCur(lBytesPerSector) * CCur(lFreeClusters)
' Compute and show the total drive Mb
' All values are cast to doubles to avoid
' overflow problems for large disks
TotalSpace = CCur(lSectorsPerCluster) * CCur(lBytesPerSector) * CCur(lTotalClusters)
End If
End Sub
Public Sub GetRGBComponent(ColorNo As Long, r As Long, G As Long, b As Long)
r = &HFF And ColorNo
G = (ColorNo \ 256) And &HFF
b = (&HFF0000 And ColorNo) / 65536
End Sub
Public Function GetDirPart(FileName As String) As String
Dim tempStr As String
Dim i As Byte
Dim P As Byte
i = Len(FileName): P = 0
Do
tempStr = Mid$(FileName, i, 1)
If tempStr = ":" Or tempStr = "\" Then
P = i
End If
i = i - 1
Loop Until (P > 0) Or (i <= 0)
If P > 0 Then
tempStr = Mid(FileName, 1, P)
Else
tempStr = ""
End If
GetDirPart = tempStr
End Function
Public Function GetSecondFromStr(ByVal TimeStr As String) As Long
GetSecondFromStr = Val(Mid(TimeStr, 1, 2)) * 3600 + Val(Mid(TimeStr, 4, 2)) * 60 + Val(Mid(TimeStr, 7, 2))
End Function
Public Function LTrimChar(Source As String, CharCode As Byte) As String
Dim i As Integer
Dim L As Integer
L = Len(Source)
Do While Asc(Mid$(Source, 1, 1)) = CharCode
Source = Mid$(Source, 2, Len(Source))
Loop
LTrimChar = Source
End Function
Public Sub GetDigitalStr(Source As String, StartPos As Integer, DigitalStr As String)
Dim P1 As Integer, P2 As Integer
Dim L As Integer
Dim i As Integer
Dim tempS As String
Dim Temp1 As String * 1
Dim CharASC As Byte
P1 = 0: P2 = 0
i = StartPos
L = Len(Source)
Do While (P2 = 0) And (i <= L)
Temp1 = Mid$(Source, i, 1)
CharASC = Asc(Temp1)
If P1 = 0 And CharASC >= 43 And (CharASC <= 58) Then P1 = i
If P1 <> 0 And CharASC < 43 Or P1 <> 0 And (CharASC > 58) Then P2 = i - 1
i = i + 1
Loop
'Debug.Print "p1="; P1, "p2="; P2
If P1 = 0 Then
DigitalStr = ""
StartPos = 0
End If
If P1 > 0 And P2 = 0 Then
P2 = Len(Source)
StartPos = 0
DigitalStr = Mid$(Source, P1, P2 - P1 + 1)
End If
If (P1 > 0) And (P2 >= P1) Then
DigitalStr = Mid$(Source, P1, P2 - P1 + 1)
StartPos = P2 + 1
End If
End Sub
Public Function GetFileExt(FileName As String) As String
Dim temp As String
Dim PointPos As Byte, i As Byte
'PointPos = InStr(FileName, ".")
i = Len(FileName)
PointPos = 0
Do While (i > 0) And (PointPos = 0)
If Mid$(FileName, i, 1) = "." Then PointPos = i
i = i - 1
Loop
If (PointPos > 0) Then
temp = Mid(FileName, PointPos + 1, 3)
Else
temp = ""
End If
GetFileExt = temp
End Function
Public Sub SplitFileName(FileName As String, Drive As String, path As String, MainFileName As String, ExtFileName As String)
'Debug.Print "Catalog FileName", FileName
Drive = GetDriveName(FileName)
path = GetDirPart(FileName)
MainFileName = GetMainFileName(FileName)
ExtFileName = GetFileExt(FileName)
End Sub
Public Function GetMainFileName(FileName As String) As String
Dim temp As String
Dim PointPos As Byte
Dim i As Integer
Dim L As Integer
i = Len(FileName)
PointPos = 0
Do While (i > 0) And (PointPos = 0)
If Mid$(FileName, i, 1) = "." Then PointPos = i
i = i - 1
Loop
'PointPos = InStr(FileName, ".")
If PointPos > 0 Then
temp = Mid$(FileName, 1, PointPos - 1)
Else
temp = FileName
End If
i = Len(temp)
PointPos = 0
Do While (i > 0) And (PointPos) = 0
If Mid$(temp, i, 1) = ":" Or Mid$(temp, i, 1) = "\" Then
PointPos = i
End If
i = i - 1
Loop
If PointPos > 0 Then
temp = Mid$(temp, PointPos + 1, Len(temp) - PointPos)
End If
GetMainFileName = temp
End Function
Public Function GetDriveName(FileName As String) As String
Dim P As Integer
P = InStr(FileName, ":")
If P = 2 Then
GetDriveName = Mid$(FileName, 1, 2)
Else
GetDriveName = ""
End If
End Function
Public Function GetNextTimeStr(SeedTime As String, Step As Integer) As String
Dim tempH As Long
Dim tempM As Long
Dim tempS As Long
Dim tempHs As String
Dim tempMs As String
Dim tempSs As String
tempH = Val(Mid(SeedTime, 1, 2))
tempM = Val(Mid(SeedTime, 4, 2))
tempS = Val(Mid(SeedTime, 7, 2))
tempS = tempS + Step
tempM = tempM + tempS \ 60
tempS = tempS Mod 60
tempH = tempH + tempM \ 60
tempM = tempM Mod 60
tempH = tempH Mod 24
tempHs = Mid(str(tempH), 2, 2)
tempMs = Mid(str(tempM), 2, 2)
tempSs = Mid(str(tempS), 2, 2)
tempHs = GetCharStr("0", 2 - Len(tempHs)) + tempHs
tempMs = GetCharStr("0", 2 - Len(tempMs)) + tempMs
tempSs = GetCharStr("0", 2 - Len(tempSs)) + tempSs
GetNextTimeStr = tempHs + ":" + tempMs + ":" + tempSs
End Function
Public Function GetCharStr(Char As String, Num As Byte) As String
Dim i As Byte
Dim temp As String
temp = ""
If Num >= 1 Then
For i = 1 To Num
temp = temp + Char
Next i
End If
GetCharStr = temp
End Function
Public Sub Swap(a, b)
Dim temp
temp = a
a = b
b = temp
End Sub
Public Function ReplaceFileExt(ByVal FileName As String, Ext As String) As String
Dim i As Integer, L As Integer
Dim quit As Boolean
quit = False
L = Len(FileName)
Do
If Mid$(FileName, L, 1) = "." Then
quit = True
i = L
End If
L = L - 1
Loop Until quit Or L < 1
If quit Then
FileName = Mid$(FileName, 1, i - 1)
End If
ReplaceFileExt = FileName + "." + Ext
End Function
Public Function EraseRightSpace(str As String) As String
Dim i As Integer
i = Len(str)
Do While i > 0 And Asc(Mid$(str, i, 1)) <= 32
i = i - 1
Loop
If i > 0 Then EraseRightSpace = Mid$(str, 1, i)
End Function
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -