mainmod.bas

用VB调用SSH控件

Public pt As POINTAPI

Private Type DOCINFO
    pDocName As String
    pOutputFile As String
    pDatatype As String
End Type

'Public Function GetCapsLock() As Boolean
'    GetCapsLock = CBool(GetKeyState(vbKeyCapital) And 1) 'Return or set the Capslock toggle.
'End Function

Public Function GetCtrl() As Boolean
    GetCtrl = CBool(GetAsyncKeyState(vbKeyControl))
End Function

Public Function GetShift() As Boolean
    GetShift = CBool(GetAsyncKeyState(vbKeyShift)) 'Return or set the Capslock toggle.
End Function

Function Ctrl(Control, Char1, Char2)
'This function is similar to below but it
'checks if control key is pressed
    If GetCtrl = True Then
        Control = 1
        Ctrl = Char1
    Else
        Control = 0
        Ctrl = Char2
    End If
End Function
Function Shf(Shift, Char1, Char2)
'This function is exactly like the IIf function
'except without the Shift statement being present
'this relies on when you press the shift key and
'another key pressed at the same time
    If GetShift = True Then
        Shift = 1 'If shift is present
        Shf = Char1 'then the first character is displayed
    Else
        Shift = 0 'if shift isn't present
        Shf = Char2 'then the second character is displayed
    End If
End Function

Public Function GetSystemParameters(Info, Newsetting)
    Dim es
    es = SystemParametersInfo(Info, Newsetting, GetSystemParameters, 0)
End Function

'解密函数
Public Function DeCrypt(texti, salasana) As String

       On Error Resume Next

              For T = 1 To Len(salasana)
                     sana = Asc(Mid(salasana, T, 1))
                     X1 = X1 + sana
              Next

       X1 = Int((X1 * 0.1) / 6)
       salasana = X1
       G = 0

              For TT = 1 To Len(texti)
                     sana = Asc(Mid(texti, TT, 1))
                     G = G + 1

                            If G = 6 Then G = 0
                                   X1 = 0

                                          If G = 0 Then X1 = sana + (salasana - 2)

                                                        If G = 1 Then X1 = sana - (salasana - 5)

                                                                      If G = 2 Then X1 = sana + (salasana - 4)

                                                                                    If G = 3 Then X1 = sana - (salasana - 2)

                                                                                                  If G = 4 Then X1 = sana + (salasana - 3)

                                                                                                                If G = 5 Then X1 = sana - (salasana - 5)
                                                                                                                       X1 = X1 - G
                                                                                                                       DeCrypted = DeCrypted & Chr(X1)
                                                                                                                Next


                                                                                                                DeCrypt = DeCrypted
                                                                                                                End Function

'加密函数
Public Function Crypt(texti, salasana) As String

       On Error Resume Next

              For T = 1 To Len(salasana)
                     sana = Asc(Mid(salasana, T, 1))
                     X1 = X1 + sana
              Next

       X1 = Int((X1 * 0.1) / 6)
       salasana = X1
       G = 0

              For TT = 1 To Len(texti)
                     sana = Asc(Mid(texti, TT, 1))
                     G = G + 1

                            If G = 6 Then G = 0
                                   X1 = 0

                                          If G = 0 Then X1 = sana - (salasana - 2)

                                                        If G = 1 Then X1 = sana + (salasana - 5)

                                                                      If G = 2 Then X1 = sana - (salasana - 4)

                                                                                    If G = 3 Then X1 = sana + (salasana - 2)

                                                                                                  If G = 4 Then X1 = sana - (salasana - 3)

                                                                                                                If G = 5 Then X1 = sana + (salasana - 5)
                                                                                                                       X1 = X1 + G
                                                                                                                       Crypted = Crypted & Chr(X1)
                                                                                                                Next

                                                Crypt = Crypted
                                                                                                                End Function

Public Function KeyboardInfo()
    Dim X
    X = GetKeyboardType(0)
    If X = 1 Then
        KeyboardInfo = "PC or compatible 83-key keyboard"
    ElseIf X = 2 Then
        KeyboardInfo = "Olivetti 102-key keyboard"
    ElseIf X = 3 Then
        KeyboardInfo = "AT or compatible 84-key keyboard"
    ElseIf X = 4 Then
        KeyboardInfo = "Enhanced 101- or 102-key keyboard"
    ElseIf X = 5 Then
        KeyboardInfo = "Nokia 1050 keyboard"
    ElseIf X = 6 Then
        KeyboardInfo = "Nokia 9140 keyboard"
    ElseIf X = 7 Then
        KeyboardInfo = "Japanese keyboard"
    End If
End Function

Public Function GetCaretBlink()
    GetCaretBlink = GetCaretBlinkTime
End Function

Public Function SetCaretBlink(MSec)
    SetCaretBlinkTime MSec
End Function

Public Function GetDoubleClick()
    GetDoubleClick = GetDoubleClickTime
End Function

Public Function SetDoubleClick(MSec)
    SetDoubleClickTime MSec
End Function

Public Function GetSysInfo()
    GetSystemInfo System
End Function

Public Function ShowProperties(FileName As String, OwnerhWnd As Long)
    Dim SEI As SHELLEXECUTEINFO
    Dim r As Long
    With SEI
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
        .hWnd = OwnerhWnd
        .lpVerb = "properties"
        .lpFile = FileName
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
    End With
    r = ShellExecuteEX(SEI)
End Function

Public Function ClearDocuments()
    Call SHAddToRecentDocs(2, vbNullString)
End Function

Public Function AddToDocuments(FileName As String)
    Call SHAddToRecentDocs(2, FileName)
End Function

Public Function PhoneCall(Number As String, Name As String)
    Dim lRetVal As Long
    lRetVal = tapiRequestMakeCall(Trim$(Number), App.Title, Trim$(Name), "")
    If lRetVal <> 0 Then
    End If
End Function

'Public Function IsCapsLockOn()
'    GetKeyboardState kbArray
'    IsCapsLockOn = kbArray.kbByte(VK_CAPITAL)
'End Function

'Public Function IsNumLockOn()
'    GetKeyboardState kbArray
'    IsNumLockOn = kbArray.kbByte(VK_NUMLOCK)
'End Function

Public Function StayOnTop(TheForm As Form)
    SetWinOnTop = SetWindowPos(TheForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
End Function

'Public Function StartScreensaver(FormN As Form)
'    Dim result As Long
'    result = SendMessage(FormN.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
'End Function

Public Function MilliToHMS(Milliseconds)
    Dim Sec, Min0, Min, Hr
    Hr = Fix(Milliseconds / 3600000)
    Min0 = Fix(Milliseconds Mod 3600000)
    Min = Fix(Min0 / 60000)
    Sec = Fix(Min0 Mod 60000)
    Sec = Fix(Sec / 1000)
    If Len(Sec) = 1 Then
        Sec = "0" & Sec
    End If
    If Len(Min) = 1 Then
        Min = "0" & Min
    End If
    If Len(Hr) = 1 Then
        Hr = "0" & Hr
    End If
    MilliToHMS = Hr & ":" & Min & ":" & Sec
End Function

Public Function GetTimeOnWindows()
    GetTimeOnWindows = MilliToHMS(GetTickCount&)
End Function

Public Function Cursor(Enabled As Boolean)
    Dim Retcode
    For i = 1 To 50000
        Retcode = ShowCursor(Enabled)
    Next i
End Function

Public Function IsThereASoundCard()
    Dim i As Integer
    i = auxGetNumDevs()
    If i > 0 Then
        IsThereASoundCard = 1
    Else
        IsThereASoundCard = 0
    End If
End Function

Public Function DriveBytesFree(DriveLetter As Integer)
    XDriveInfo
    DriveBytesFree = (vararyDriveInfo(DriveLetter, 9))
End Function

Public Function DriveTotalBytes(DriveLetter As Integer)
    XDriveInfo
    DriveTotalBytes = (vararyDriveInfo(DriveLetter, 8))
End Function

Public Function DrivePercentFree(DriveLetter As Integer)
    XDriveInfo
    On Error Resume Next
    DrivePercentFree = (DriveBytesFree(DriveLetter) / DriveTotalBytes(DriveLetter)) * 100
End Function

Public Function DriveOtherInfo(DriveLetter As Integer, InfoCode)
    XDriveInfo
    DriveOtherInfo = (vararyDriveInfo(DriveLetter, InfoCode))
End Function

Public Function XDriveInfo()
    '1  = Is there a drive for this letter
    '2  = Drive Letter
    '3  = Drive Type  2: Floppy, 3: Disk Fixed 4: Disk Remote
    '4  = Sectors
    '5  = Bytes / Sector
    '6  = Number of free sectors
    '7  = Total Clusters
    '8  = Total Bytes
    '9  = Free Bytes
    '10 = Percent of Free Bytes
    '11 = Vol Name
    Dim ournum As Long, rv As Long, DriveType As Long, c  As Long, d As Long
    Dim E As Long, F As Long, H As Long, Counter As Integer, CompareTo