modapiwindows.bas

高校排课系统.这个小程序使用了皮肤控件

Attribute VB_Name = "ModAPIWindows"
Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public 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
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Public Const SW_Minimize = 6
Public Const SW_Maximize = 3
Public Const SW_Normal = 1

Public TargetList As ListBox

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
  Dim SLength As Long, Buffer As String  ' title bar text length and buffer
  Dim RetVal As Long  ' return value
  Static WinNum As Integer  ' counter keeps track of how many windows have been enumerated

  WinNum = WinNum + 1  ' one more window enumerated....
  SLength = GetWindowTextLength(hWnd) + 1  ' get length of title bar text
  If SLength > 1 Then  ' if return value refers to non-empty string
    Buffer = Space(SLength)  ' make room in the buffer
    RetVal = GetWindowText(hWnd, Buffer, SLength)  ' Get title bar text.
    TargetList.AddItem Left(Buffer, SLength - 1)  '
    TargetList.ItemData(TargetList.NewIndex) = hWnd '
  End If

  EnumWindowsProc = 1  ' return value of 1 means continue enumeration
' --------------------------------------------------------------------------------- '
End Function

'分析并保存Winsock得到服务器响应的数据
'入口变量
'ByteNum：  接收到数据的字节数
'ByteData： 接收数据的Byte类型的数组
'出口变量：
'Flen：     文件长度
'函数返回值：表示一定意思的字符串
Public Function SaveData(ByteNum As Long, ByteData() As Byte, Flen As Long) As String
Dim Tfile As String
Dim Fnum As Integer
Static m3Byte(3) As Byte
'Static bAppend As Boolean
Dim StartPos As Long
Dim i As Long
If bAppend = False Then
    ReceiveData = ReceiveData & StrConv(ByteData(), vbUnicode)
    Clipboard.SetText ReceiveData
    If (InStr(1, ReceiveData, "HTTP/1.0 200 OK") Or InStr(1, ReceiveData, "HTTP/1.1 200 OK")) Then
        '表示请求下载文件成功
        SaveData = "200"
    ElseIf (InStr(1, ReceiveData, "HTTP/1.0 206 ") Or InStr(1, ReceiveData, "HTTP/1.1 206")) Then
        '表示请求断点续传成功
        SaveData = "206"
    ElseIf (InStr(1, ReceiveData, "HTTP/1.0 404 ") Or InStr(1, ReceiveData, "HTTP/1.1 404")) Then
        '表示服务器未找到请求的资源
        SaveData = "404"
    Else
        '请求错误
        SaveData = "error"
        Exit Function
    End If
    '如果服务器响应的字符串有指定文件大小的标题字段，取得文件大小
    If InStr(1, ReceiveData, "Content-Length:") > 0 And mflen = 0 Then
    Dim pos1 As Long, pos2 As Long
    pos1 = InStr(1, ReceiveData, "Content-Length:")
    pos2 = InStr(pos1 + 16, ReceiveData, vbCrLf)
        If pos2 > pos1 Then
            mflen = Mid(ReceiveData, pos1 + 16, pos2 - pos1 - 16)
            Flen = mflen
            filesize = mflen
        End If
    End If
    '从服务器响应返回的数据中查找下载文件的起始位置
    For i = 0 To UBound(ByteData()) - 3
        If ByteData(i) = 13 And ByteData(i + 1) = 10 And ByteData(i + 2) = 13 And ByteData(i + 3) = 10 Then
            StartPos = i + 4
            bAppend = True
            Exit For
        End If
    Next i
End If
'如果取消，则退出该过程，并返回字符串“cancel”
If bAppend = False Then
    If bCancel = True Then
        SaveData = "cancel"
    End If
    Exit Function
End If
'在调用frmDown的Public函数DraoDownPic反映下载情况
'frmDown.DrawDownPic WhichSocket, ByteNum - StartPos, mFlen, ReceiveBytes
'ReceiveBytes = ReceiveBytes + ByteNum - StartPos
Tfile = Filename
Fnum = FreeFile()
'向二进制文件中加入下载文件的数据
Open Tfile For Binary As #Fnum
If LOF(Fnum) > 0 Then
    Seek #Fnum, LOF(Fnum) + 1
End If
If StartPos > 0 Then
    For i = StartPos To UBound(ByteData())
        Put #Fnum, , ByteData(i)
    Next i
Else
    Put #Fnum, , ByteData()
End If
Close #Fnum
If FileLen(Tfile) >= filesize Then
UPboolean = True
End If
'If bCancel = True Then
'    SaveData = "cancel"
'End If
End Function