#Include Once "win/wininet.bi"
Type Class_WinInet
Private : 
   m_hWndForm As HWnd '控件句柄
   m_IDC As Long     '控件IDC
   m_InternetStatusProc As Any Ptr  '回调函数，就是 WinInet状态提示 事件
   m_DownloadBeginProc As Any Ptr  '下载开始
   m_DownloadCompleteProc As Any Ptr  '下载完成
   m_FileDownloadProc As Any Ptr  '文件下载中
   m_HeadersProc As Any Ptr  '标头
   m_Version As zString * 30
   m_OfBytes As Long =4096
   Declare Function GetFP() As FormControlsPro_TYPE ptr '返回控件保存数据的指针（一般是类自己用）
   Declare Sub URL_FenLiYuMinLuJing(URL as String, domain as String, path as String, ByRef port as Integer) '分离成域名与路径
   Declare Function wStr2Str(WStrPtr as WString Ptr) as String '把宽字符转换为
Public : 
   Declare Constructor
   Declare Destructor
   Declare Property hWndForm() As.hWnd         '返回/设置控件所在的窗口句柄，主要用于多开同一个窗口后，要使用控件前，必须先指定控件所在的窗口句柄，才能正常使用控件。
   Declare Property hWndForm(ByVal hWndParent As.hWnd) '获取控件所在的窗口句柄（父窗口）
   Declare Property IDC() As Long             '返回/设置控件IDC，控件标识符，1个窗口里每个控件IDC都是唯一的，包括控件数组。（不可随意修改，系统自动处理）
   Declare Property IDC(NewIDC As Long)
   Declare Property Tag() As CWSTR                       '存储程序所需的附加数据。
   Declare Property Tag(ByVal sText As CWSTR)
   Declare Property Version() As CWSTR  '要在请求中使用的HTTP版本。Internet Explorer中的设置将覆盖此参数中指定的值。
   Declare Property Version(ByVal sText As CWSTR)
   Declare Property OfBytes() As Long             '返回/设置读取字节 当接收网络数据时，一次性阻塞方式读取的字节数大小
   Declare Property OfBytes(nBytes As Long)
   Declare Function SetEventProc(EventName As WString Ptr, pProc As Any Ptr) As Any Ptr  '设置WinInet事件函数的指针，返回前一个事件函数的指针（一般由VFB内部设置）
   Declare Function HttpGet(URL as WString Ptr, dwContext As ULONG_PTR = 1, RangeStart As uLong = 0, RangeSize As uLong = 0, ref as WString Ptr = 0, user as WString Ptr = 0, pwd as WString Ptr = 0) as String 'Get 网站同步方式获取，返回的是全部原始数据，保存在String里。
   Declare Function HttpPost(URL as WString Ptr, param as String, dwContext As ULONG_PTR = 1, RangeStart As uLong = 0, RangeSize As uLong = 0, ref as WString Ptr = 0, user as WString Ptr = 0, pwd as WString Ptr = 0) as String 'Post 网站同步方式获取，返回的是全部原始数据，保存在String里。
   Declare Sub HttpGetThread(URL as WString Ptr, dwContext As ULONG_PTR = 1, RangeStart As uLong = 0, RangeSize As uLong = 0, ref as WString Ptr = 0, user as WString Ptr = 0, pwd as WString Ptr = 0)  'Get 网站多线程异步方式获取
   Declare Sub HttpPostThread(URL as WString Ptr, param as String, dwContext As ULONG_PTR = 1, RangeStart As uLong = 0, RangeSize As uLong = 0, ref as WString Ptr = 0, user as WString Ptr = 0, pwd as WString Ptr = 0)  'Post 网站多线程异步方式获取
   
   
End Type
Declare Sub Class_WinInet_Thread_Http_Get(p As Any Ptr)
Declare Sub Class_WinInet_Thread_Http_Post(p As Any Ptr)
'----------------------------------------------------------------------------------------------------------------------------------------------------------------
Constructor Class_WinInet
   '注意：由于窗口类是永久的，全局变量，因此这里从开软件到关软件只执行1次。
End Constructor

Destructor Class_WinInet
    '注意：由于窗口类是永久的，全局变量，因此为了可以完成特殊功能，Destructor 会重复执行
   '1，每次窗口销毁  就执行1次 Destructor  ，多次显示和关窗口就重复操作
   '2，退出软件  执行1次 Destructor    
End Destructor
Function Class_WinInet.GetFP() As FormControlsPro_TYPE ptr '返回自己控件的指针
   Dim fp As FormControlsPro_TYPE ptr = GetPropW(m_hWndForm, "FCP_TYPE_PTR")
   While fp
      if fp->IDC = m_IDC Then Return fp      
      fp = fp->VrControls
   Wend

End Function
Property Class_WinInet.hWndForm() As .hWnd         '返回/设置控件所在的窗口句柄
      Return m_hWndForm
End Property
Property Class_WinInet.hWndForm(ByVal hWndParent As .hWnd)
   m_hWndForm = hWndParent
End Property
Property Class_WinInet.IDC() As Long                  '返回/设置两次调用 Timer 控件的 Timer 事件间隔的毫秒数。
   Return m_IDC
End Property
Property Class_WinInet.IDC(ByVal NewIDC As Long)
   m_IDC  =NewIDC
End Property
Property Class_WinInet.Tag() As CWSTR 
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp then
      Return fp->Tag
   End If
End Property
Property Class_WinInet.Tag(ByVal sText As CWSTR )
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp then
      fp->Tag = sText
   End If
End Property

Property Class_WinInet.OfBytes() As Long
   Return m_OfBytes
End Property
Property Class_WinInet.OfBytes(nBytes As Long)
   m_OfBytes  =nBytes
End Property
Property Class_WinInet.Version() As CWSTR
   Return m_Version
End Property
Property Class_WinInet.Version(ByVal sText As CWSTR)
   m_Version  =sText
End Property
Function Class_WinInet.wStr2Str(WStrPtr as WString Ptr) as String
   If WStrPtr Then
      Dim WStrLen As Long = Len( *WStrPtr)
      If WStrLen = 0 Then
         Return ""
      EndIf
      Dim ZStr as String
      ZStr = String(WStrLen * 2 + 2, 0)
      Dim ZStrLen as Integer = WideCharToMultiByte(CP_ACP, 0, WStrPtr, WStrLen, StrPtr(ZStr), WStrLen * 2 + 2, Null, Null)
      If ZStrLen Then Function = Left(ZStr, ZStrLen)
   EndIf
End Function
Sub Class_WinInet.URL_FenLiYuMinLuJing(URL as String ,domain as String , path as String ,ByRef port as Integer) '分离成域名与路径
   'ByRef 域名 as String ,ByRef 路径 as String ,ByRef 端口
   Dim as String  tob,ltob
   Dim as Long  aa,bb
   tob = Trim(URL)
   ltob = LCase(tob)
   If Left(ltob, 7) = "http://" Then '去除
      tob = Mid(tob, 8)
      port = 80
      bb = 1
   ElseIf Left(ltob, 8) = "https://" Then
      tob = Mid(tob, 9)
      port = 443
      bb = 1
   Else
      If port = 0 Then port = 80
      bb = 0
   End If
   If bb = 1 Or Len(domain) = 0 Then  '带域名或 没有原域名
      '分离域名
      aa = InStr(tob, "/")
      If aa = 0 Then
         domain = Trim(tob)
         path = ""
      Else
         domain = Trim(Left(tob, aa -1))
         path = Trim(Mid(tob, aa + 1))
      End If
   Else   ' "HTTP/1.0 30" '转向 ，就用原域名
      tob = Trim(tob)
      If Left(tob, 1) = "/" Then
         path = Mid(tob, 2)
      Else
         path = tob
      End If
   End If
   
End Sub

Function Class_WinInet.SetEventProc(EventName As WString Ptr, pProc As Any Ptr) As Any Ptr
   Select Case ucase(*EventName)
      Case "INTERNETSTATUS"
         Function = m_InternetStatusProc
         m_InternetStatusProc = pProc
      Case "DOWNLOADBEGIN"
         Function = m_DownloadBeginProc
         m_DownloadBeginProc = pProc
      Case "DOWNLOADCOMPLETE"
         Function = m_DownloadCompleteProc
         m_DownloadCompleteProc = pProc
      Case "FILEDOWNLOAD"
         Function = m_FileDownloadProc
         m_FileDownloadProc = pProc
      Case "HEADERS"
         Function = m_HeadersProc
         m_HeadersProc = pProc
   End Select
End Function
Function Class_WinInet.HttpGet(URL as WString Ptr,dwContext As ULONG_PTR = 1,RangeStart As uLong=0,RangeSize As uLong=0, ref as WString Ptr = 0, user as WString Ptr = 0, pwd as WString Ptr = 0) as String
   Dim G_HTTP_Agent as zString * MAX_PATH = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
   Dim G_HTTP_Head as zString * 4096
   Dim G_HTTP_Accept as zString * MAX_PATH = !"*/*"
   Dim Prot As Integer
   Dim i As Long, Length As ULong
   Dim as String host,path,aUrl =wStr2Str(Url),aRef =wStr2Str(ref),aUser=wStr2Str(user),aPwd=wStr2Str(pwd)
   Dim sout As String
   URL_FenLiYuMinLuJing aurl, host, path, Prot
   i = InStr(host, ":")
   If i > 0 Then  '指定了端口
      Prot = ValInt(Right(host, Len(host) - i))
      host = Left(host, i -1)
   Else
      Prot = 80
   End If
   Dim hInet as HANDLE = InternetOpenA(@G_HTTP_Agent, INTERNET_OPEN_TYPE_DIRECT, Null, Null, 0) ' INTERNET_FLAG_ASYNC)
   If hInet Then
      if m_InternetStatusProc Then InternetSetStatusCallback(hInet, m_InternetStatusProc)
      Dim hConn as HANDLE = InternetConnectA(hInet, StrPtr(host), Prot, StrPtr(aUser), StrPtr(aPwd), INTERNET_SERVICE_HTTP, 0, dwContext)
      If hConn Then
         Dim hRequ as HANDLE = HttpOpenRequestA(hConn, "GET", StrPtr(path), StrPtr(m_Version), StrPtr(aRef), Cast(LPCSTR Ptr, @G_HTTP_Accept), INTERNET_FLAG_RELOAD Or INTERNET_FLAG_KEEP_CONNECTION, dwContext)
         If hRequ Then
            if RangeStart > 0 Then  '为断点续传，从多少开始下载
               G_HTTP_Head = "Range: bytes="
               G_HTTP_Head &= Str(RangeStart -1) & Chr(45) '"-"
               if RangeSize > 0 Then G_HTTP_Head &= Str(RangeStart + RangeSize -1)
               G_HTTP_Head &= vbCrLf
            end if
            Dim bRequ as Integer = HttpSendRequestA(hRequ, @G_HTTP_Head, -1, Null, 0)
            If bRequ Then
               Dim HEADERS As ZString * 4096
               i = 4095
               if HttpQueryInfoA(hRequ, HTTP_QUERY_RAW_HEADERS_CRLF, @HEADERS, @i, 0) Then '获取文件头
                  if m_HeadersProc Then
                     Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, eData As Any Ptr, eLen As Long) = m_HeadersProc
                     pp(hInet, dwContext, @HEADERS, i)
                  End if
               End If
               i = len(Length)
               if HttpQueryInfoA(hRequ, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, @Length, @i, 0) = FALSE Then Length = 0 '获取文件长度
               Dim tstr as String
               Dim bRead as UInteger
               if m_DownloadBeginProc Then
                  Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, fLen As uLong) = m_DownloadBeginProc
                  pp(hInet, dwContext, Length)
               End If
               tstr = String(m_OfBytes, 0)
               While InternetReadFile(hRequ, StrPtr(tstr), m_OfBytes, @bRead) AndAlso (bRead > 0)
                  if m_FileDownloadProc Then
                     Dim pp As Function(hInet As HINTERNET, dwContext As ULONG_PTR, rData As Any Ptr, rLen As Long, fLen As uLong) As hResult = m_FileDownloadProc
                     if pp(hInet, dwContext, StrPtr(tstr), bRead, Length) Then Exit While
                  End If
                  sout &= Left(tstr, bRead)
               Wend
               if m_DownloadCompleteProc Then
                  Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, eData As Any Ptr, eLen As Long) = m_DownloadCompleteProc
                  pp(hInet, dwContext, StrPtr(sout), Len(sout))
               End If
            EndIf
            InternetCloseHandle hRequ
         EndIf
         InternetCloseHandle hConn
      EndIf
      InternetCloseHandle(hInet)
   EndIf
   Return sout
End Function
Function Class_WinInet.HttpPost(URL as WString Ptr, param as String, dwContext As ULONG_PTR = 1,RangeStart As uLong=0,RangeSize As uLong=0, ref as WString Ptr = 0, user as WString Ptr = 0, pwd as WString Ptr = 0) as String
   Dim G_HTTP_Agent as zString * MAX_PATH = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
   Dim G_HTTP_Accept as zString * MAX_PATH = !"*/*"
   Dim G_HTTP_POST_HEAD as zString * 4096 = !"Content-Type: application/x-www-form-urlencoded\r\n"
   Dim Prot As Integer
   Dim i As Long, Length As ULong
   Dim as String host,path,aUrl =wStr2Str(Url),aRef =wStr2Str(ref),aUser=wStr2Str(user),aPwd=wStr2Str(pwd)
   Dim sout As String
   URL_FenLiYuMinLuJing aUrl, host, path, Prot
   i = InStr(host, ":")
   If i > 0 Then  '指定了端口
      Prot = ValInt(Right(host, Len(host) - i))
      host = Left(host, i -1)
   Else
      Prot = 80
   End If
   Dim hInet as HANDLE = InternetOpenA(@G_HTTP_Agent, INTERNET_OPEN_TYPE_DIRECT, Null, Null, 0)
   If hInet Then
      if m_InternetStatusProc Then InternetSetStatusCallback(hInet, m_InternetStatusProc)
      Dim hConn as HANDLE = InternetConnectA(hInet, StrPtr(host), Prot, StrPtr(aUser), StrPtr(aPwd), INTERNET_SERVICE_HTTP, 0, dwContext)
      If hConn Then
         Dim hRequ as HANDLE = HttpOpenRequestA(hConn, "POST", StrPtr(path), m_Version, StrPtr(aRef), Cast(Any Ptr, @G_HTTP_Accept), INTERNET_FLAG_RELOAD Or INTERNET_FLAG_KEEP_CONNECTION, dwContext)
         If hRequ Then
            if RangeStart > 0 Then  '为断点续传，从多少开始下载
               Dim G_HTTP_Head As String = "Range: bytes="
               G_HTTP_Head &= Str(RangeStart -1) & Chr(45) '"-"
               if RangeSize > 0 Then G_HTTP_Head &= Str(RangeStart + RangeSize -1)
               G_HTTP_Head &= vbCrLf
               G_HTTP_POST_HEAD &=G_HTTP_Head
            end if
            Dim bRequ as Integer = HttpSendRequestA(hRequ, @G_HTTP_POST_HEAD, -1, StrPtr(param), Len(param))
            If bRequ Then
               Dim HEADERS As ZString * 4096
               i = 4095
               if HttpQueryInfoA(hRequ, HTTP_QUERY_RAW_HEADERS_CRLF, @HEADERS, @i, 0) Then '获取文件头
                  if m_HeadersProc Then
                     Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, eData As Any Ptr, eLen As Long) = m_HeadersProc
                     pp(hInet, dwContext, @HEADERS, i)
                  End if
               End If
               i = len(Length)
               if HttpQueryInfoA(hRequ, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, @Length, @i, 0) = FALSE Then Length = 0   '获取文件长度
               Dim tstr as String
               Dim bRead as UInteger
               if m_DownloadBeginProc Then
                  Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, fLen As uLong) = m_DownloadBeginProc
                  pp(hInet, dwContext, Length)
               End If
               tstr = String(m_OfBytes, 0)
               While InternetReadFile(hRequ, StrPtr(tstr), m_OfBytes, @bRead) AndAlso (bRead > 0)
                  if m_FileDownloadProc Then
                     Dim pp As Function(hInet As HINTERNET, dwContext As ULONG_PTR, rData As Any Ptr, rLen As Long, fLen As uLong) As hResult = m_FileDownloadProc
                     if pp(hInet, dwContext, StrPtr(tstr), bRead, Length) Then Exit While
                  End If
                  sout &= Left(tstr, bRead)
               Wend
               if m_DownloadCompleteProc Then
                  Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, eData As Any Ptr, eLen As Long) = m_DownloadCompleteProc
                  pp(hInet, dwContext, StrPtr(sout), Len(sout))
               End If
            EndIf
            InternetCloseHandle hRequ
         EndIf
         InternetCloseHandle hConn
      EndIf
      InternetCloseHandle(hInet)
   EndIf
   Return sout
End Function
Sub Class_WinInet.HttpGetThread(URL as WString Ptr, dwContext As ULONG_PTR = 1,RangeStart As uLong=0,RangeSize As uLong=0, ref as WString Ptr = 0, user as WString Ptr = 0, pwd as WString Ptr = 0)
   Dim Prot As Integer
   Dim i As Long
   Dim as String host,path,aUrl =wStr2Str(Url),aRef =wStr2Str(ref),aUser=wStr2Str(user),aPwd=wStr2Str(pwd)
   URL_FenLiYuMinLuJing aUrl, host, path, Prot
   i = InStr(host, ":")
   If i > 0 Then  '指定了端口
      Prot = ValInt(Right(host, Len(host) - i))
      host = Left(host, i -1)
   Else
      Prot = 80
   End If
   '组织参数，传给多线程
   i = Len(aUrl) + Len(aRef) + Len(aUser) + Len(aPwd) + Len(dwContext) + Len(host) + Len(path) + Len(Prot) + Len(m_InternetStatusProc) * 5 + Len(m_Version) + Len(m_OfBytes)
   i += 200
   Dim mm As Any Ptr = CAllocate(i)
   Dim ml As Long Ptr = mm, mt As Long, mi As Long, mk As Long = 100
   mi = 0 : mk = 100 : mt = Len(aUrl)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(aUrl), mt
   mi += 1 : mk += mt : mt = Len(aRef)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(aRef), mt
   mi += 1 : mk += mt : mt = Len(aUser)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(aUser), mt
   mi += 1 : mk += mt : mt = Len(aPwd)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(aPwd), mt
   mi += 1 : mk += mt : mt = Len(dwContext)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @dwContext, mt
   mi += 1 : mk += mt : mt = Len(host)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(host), mt
   mi += 1 : mk += mt : mt = Len(path)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(path), mt
   mi += 1 : mk += mt : mt = Len(Prot)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @Prot, mt
   mi += 1 : mk += mt : mt = Len(m_InternetStatusProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_InternetStatusProc, mt
   mi += 1 : mk += mt : mt = Len(m_DownloadBeginProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_DownloadBeginProc, mt
   mi += 1 : mk += mt : mt = Len(m_DownloadCompleteProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_DownloadCompleteProc, mt
   mi += 1 : mk += mt : mt = Len(m_FileDownloadProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_FileDownloadProc, mt
   mi += 1 : mk += mt : mt = Len(m_HeadersProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_HeadersProc, mt
   mi += 1 : mk += mt : mt = Len(m_Version)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(m_Version), mt
   mi += 1 : mk += mt : mt = Len(m_OfBytes)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_OfBytes, mt
   mi += 1 : mk += mt : mt = Len(RangeStart)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @RangeStart, mt
   mi += 1 : mk += mt : mt = Len(RangeSize)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @RangeSize, mt
   
                            
   Threaddetach ThreadCreate(Cast(Any Ptr, @Class_WinInet_Thread_Http_Get), mm) '经典调用方法
End Sub
Sub Class_WinInet.HttpPostThread(URL as WString Ptr, param as String, dwContext As ULONG_PTR = 1,RangeStart As uLong=0,RangeSize As uLong=0, ref as WString Ptr = 0, user as WString Ptr = 0, pwd as WString Ptr = 0) 
   Dim Prot As Integer
   Dim i As Long
   Dim as String host,path,aUrl =wStr2Str(Url),aRef =wStr2Str(ref),aUser=wStr2Str(user),aPwd=wStr2Str(pwd)
   URL_FenLiYuMinLuJing aUrl, host, path, Prot
   i = InStr(host, ":")
   If i > 0 Then  '指定了端口
      Prot = ValInt(Right(host, Len(host) - i))
      host = Left(host, i -1)
   Else
      Prot = 80
   End If
   '组织参数，传给多线程
   i = Len(aUrl) + Len(aRef) + Len(aUser) + Len(aPwd) + Len(dwContext) + Len(host) + Len(path) + Len(Prot) + Len(m_InternetStatusProc) * 5 + Len(m_Version) + Len(m_OfBytes)
   i += 200
   Dim mm As Any Ptr = CAllocate(i)
   Dim ml As Long Ptr = mm, mt As Long, mi As Long, mk As Long = 100
   mi = 0 : mk = 100 : mt = Len(aUrl)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(aUrl), mt
   mi += 1 : mk += mt : mt = Len(aRef)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(aRef), mt
   mi += 1 : mk += mt : mt = Len(aUser)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(aUser), mt
   mi += 1 : mk += mt : mt = Len(aPwd)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(aPwd), mt
   mi += 1 : mk += mt : mt = Len(dwContext)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @dwContext, mt
   mi += 1 : mk += mt : mt = Len(host)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(host), mt
   mi += 1 : mk += mt : mt = Len(path)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(path), mt
   mi += 1 : mk += mt : mt = Len(Prot)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @Prot, mt
   mi += 1 : mk += mt : mt = Len(m_InternetStatusProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_InternetStatusProc, mt
   mi += 1 : mk += mt : mt = Len(m_DownloadBeginProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_DownloadBeginProc, mt
   mi += 1 : mk += mt : mt = Len(m_DownloadCompleteProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_DownloadCompleteProc, mt
   mi += 1 : mk += mt : mt = Len(m_FileDownloadProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_FileDownloadProc, mt
   mi += 1 : mk += mt : mt = Len(m_HeadersProc)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_HeadersProc, mt
   mi += 1 : mk += mt : mt = Len(m_Version)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(m_Version), mt
   mi += 1 : mk += mt : mt = Len(m_OfBytes)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @m_OfBytes, mt   
   mi += 1 : mk += mt : mt = Len(param)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), StrPtr(param), mt
   mi += 1 : mk += mt : mt = Len(RangeStart)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @RangeStart, mt
   mi += 1 : mk += mt : mt = Len(RangeSize)
   ml[mi] = MAKELONG(mk, mt)
   memcpy Cast(Any Ptr, Cast(UInteger, mm) + mk), @RangeSize, mt
  
      Threaddetach ThreadCreate(Cast(Any Ptr, @Class_WinInet_Thread_Http_Post), mm) '经典调用方法

End Sub
Sub Class_WinInet_Thread_Http_Get(mm As Any Ptr)
   Dim Prot As Integer
   Dim As Any Ptr m_InternetStatusProc,m_DownloadBeginProc,m_DownloadCompleteProc,m_FileDownloadProc,m_HeadersProc
   Dim as String host,path,aUrl ,aRef ,aUser,aPwd ,param ,m_Version
   Dim m_OfBytes As Long, dwContext As ULONG_PTR
   Dim As uLong RangeStart ,RangeSize
   '恢复参数
   Dim ml As Long Ptr = mm, mt As Long, mi As Long, mk As Long
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then aUrl = String(mt, 0) : memcpy StrPtr(aUrl), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then aRef = String(mt, 0) : memcpy StrPtr(aRef), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then aUser = String(mt, 0) : memcpy StrPtr(aUser), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then aPwd = String(mt, 0) : memcpy StrPtr(aPwd), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @dwContext, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then host = String(mt, 0) : memcpy StrPtr(host), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then path = String(mt, 0) : memcpy StrPtr(path), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @Prot, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_InternetStatusProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_DownloadBeginProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_DownloadCompleteProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_FileDownloadProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_HeadersProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then m_Version = String(mt, 0) : memcpy StrPtr(m_Version), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_OfBytes, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @RangeStart, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @RangeSize, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   Deallocate mm
   Dim G_HTTP_Agent as zString * MAX_PATH = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
   Dim G_HTTP_Head as zString * 4096
   Dim G_HTTP_Accept as zString * MAX_PATH = !"*/*"
   
   Dim hInet as HANDLE = InternetOpenA(@G_HTTP_Agent, INTERNET_OPEN_TYPE_DIRECT, Null, Null, 0) ' INTERNET_FLAG_ASYNC)
   If hInet Then
      if m_InternetStatusProc Then InternetSetStatusCallback(hInet, m_InternetStatusProc)
      Dim hConn as HANDLE = InternetConnectA(hInet, StrPtr(host), Prot, StrPtr(aUser), StrPtr(aPwd), INTERNET_SERVICE_HTTP, 0, dwContext)
      If hConn Then
         Dim hRequ as HANDLE = HttpOpenRequestA(hConn, "GET", StrPtr(path), StrPtr(m_Version), StrPtr(aRef), Cast(LPCSTR Ptr, @G_HTTP_Accept), INTERNET_FLAG_RELOAD Or INTERNET_FLAG_KEEP_CONNECTION, dwContext)
         If hRequ Then
            if RangeStart > 0 Then  '为断点续传，从多少开始下载
               G_HTTP_Head = "Range: bytes="
               G_HTTP_Head &= Str(RangeStart -1) & Chr(45) '"-"
               if RangeSize > 0 Then G_HTTP_Head &= Str(RangeStart + RangeSize -1)
               G_HTTP_Head &= vbCrLf
            end if
            Dim bRequ as Integer = HttpSendRequestA(hRequ, @G_HTTP_Head, -1, Null, 0)
            If bRequ Then
               Dim HEADERS As ZString * 4096
               Dim i As Long = 4095, Length As Long
               if HttpQueryInfoA(hRequ, HTTP_QUERY_RAW_HEADERS_CRLF, @HEADERS, @i, 0) Then '获取文件头
                  if m_HeadersProc Then
                     Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, eData As Any Ptr, eLen As Long) = m_HeadersProc
                     pp(hInet, dwContext, @HEADERS, i)
                  End if
               End If
               i = len(Length)
               if HttpQueryInfoA(hRequ, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, @Length, @i, 0) = FALSE Then Length = 0   '获取文件长度
               Dim tstr as String
               Dim bRead as UInteger
               if m_DownloadBeginProc Then
                  Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, fLen As uLong) = m_DownloadBeginProc
                  pp(hInet, dwContext, Length)
               End If
               tstr = String(m_OfBytes, 0)
               While InternetReadFile(hRequ, StrPtr(tstr), m_OfBytes, @bRead) AndAlso (bRead > 0)
                  if m_FileDownloadProc Then
                     Dim pp As Function(hInet As HINTERNET, dwContext As ULONG_PTR, rData As Any Ptr, rLen As Long, fLen As uLong) As hResult = m_FileDownloadProc
                     if pp(hInet, dwContext, StrPtr(tstr), bRead, Length) Then Exit While
                  End If
               Wend
               if m_DownloadCompleteProc Then
                  Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, eData As Any Ptr, eLen As Long) = m_DownloadCompleteProc
                  pp(hInet, dwContext, 0, 0)
               End If
            EndIf
            InternetCloseHandle hRequ
         EndIf
         InternetCloseHandle hConn
      EndIf
      InternetCloseHandle(hInet)
   EndIf
End Sub
Sub Class_WinInet_Thread_Http_Post(mm As Any Ptr)
   Dim Prot As Integer
   Dim As Any Ptr m_InternetStatusProc,m_DownloadBeginProc,m_DownloadCompleteProc,m_FileDownloadProc,m_HeadersProc
   Dim as String host,path,aUrl ,aRef ,aUser,aPwd ,param ,m_Version
   Dim m_OfBytes As Long, dwContext As ULONG_PTR
   Dim As uLong RangeStart ,RangeSize
   '恢复参数
   Dim ml As Long Ptr = mm, mt As Long, mi As Long, mk As Long
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then aUrl = String(mt, 0) : memcpy StrPtr(aUrl), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt

   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then aRef = String(mt, 0) : memcpy StrPtr(aRef), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt

   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then aUser = String(mt, 0) : memcpy StrPtr(aUser), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
 
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then aPwd = String(mt, 0) : memcpy StrPtr(aPwd), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @dwContext, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt

   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then host = String(mt, 0) : memcpy StrPtr(host), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then path = String(mt, 0) : memcpy StrPtr(path), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @Prot, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt

   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_InternetStatusProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_DownloadBeginProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_DownloadCompleteProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt

   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_FileDownloadProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_HeadersProc, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then m_Version = String(mt, 0) : memcpy StrPtr(m_Version), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @m_OfBytes, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt

   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   if mt Then param = String(mt, 0) : memcpy StrPtr(param), Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @RangeStart, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   
   mk = LoWord(ml[mi]) : mt = HiWord(ml[mi]) : mi += 1
   memcpy @RangeSize, Cast(Any Ptr, Cast(UInteger, mm) + mk), mt
   Deallocate mm
   Dim G_HTTP_Agent as zString * MAX_PATH = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
   Dim G_HTTP_Accept as zString * MAX_PATH = !"*/*"
   Dim G_HTTP_POST_HEAD as zString * 4096 = !"Content-Type: application/x-www-form-urlencoded\r\n"
   Dim hInet as HANDLE = InternetOpenA(@G_HTTP_Agent, INTERNET_OPEN_TYPE_DIRECT, Null, Null, 0)
   If hInet Then
      if m_InternetStatusProc Then InternetSetStatusCallback(hInet, m_InternetStatusProc)
      Dim hConn as HANDLE = InternetConnectA(hInet, StrPtr(host), Prot, StrPtr(aUser), StrPtr(aPwd), INTERNET_SERVICE_HTTP, 0, dwContext)
      If hConn Then
         Dim hRequ as HANDLE = HttpOpenRequestA(hConn, "POST", StrPtr(path), m_Version, StrPtr(aRef), Cast(Any Ptr, @G_HTTP_Accept), INTERNET_FLAG_RELOAD Or INTERNET_FLAG_KEEP_CONNECTION, dwContext)
         If hRequ Then
            if RangeStart > 0 Then  '为断点续传，从多少开始下载
               Dim G_HTTP_Head As String = "Range: bytes="
               G_HTTP_Head &= Str(RangeStart -1) & Chr(45) '"-"
               if RangeSize > 0 Then G_HTTP_Head &= Str(RangeStart + RangeSize -1)
               G_HTTP_Head &= vbCrLf
               G_HTTP_POST_HEAD &= G_HTTP_Head
            end if
            Dim bRequ as Integer = HttpSendRequestA(hRequ, @G_HTTP_POST_HEAD, -1, StrPtr(param), Len(param))
            If bRequ Then
               Dim HEADERS As ZString * 4096
               Dim i As Long = 4095, Length As Long
               if HttpQueryInfoA(hRequ, HTTP_QUERY_RAW_HEADERS_CRLF, @HEADERS, @i, 0) Then '获取文件头
                  if m_HeadersProc Then
                     Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, eData As Any Ptr, eLen As Long) = m_HeadersProc
                     pp(hInet, dwContext, @HEADERS, i)
                  End if
               End If
               i = len(Length)
               if HttpQueryInfoA(hRequ, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, @Length, @i, 0) = FALSE Then Length = 0   '获取文件长度
               Dim tstr as String
               Dim bRead as UInteger
               if m_DownloadBeginProc Then
                  Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, fLen As uLong) = m_DownloadBeginProc
                  pp(hInet, dwContext, Length)
               End If
               tstr = String(m_OfBytes, 0)
               While InternetReadFile(hRequ, StrPtr(tstr), m_OfBytes, @bRead) AndAlso (bRead > 0)
                  if m_FileDownloadProc Then
                     Dim pp As Function(hInet As HINTERNET, dwContext As ULONG_PTR, rData As Any Ptr, rLen As Long, fLen As uLong) As hResult = m_FileDownloadProc
                     if pp(hInet, dwContext, StrPtr(tstr), bRead, Length) Then Exit While
                  End If
               Wend
               if m_DownloadCompleteProc Then
                  Dim pp As sub(hInet As HINTERNET, dwContext As ULONG_PTR, eData As Any Ptr, eLen As Long) = m_DownloadCompleteProc
                  pp(hInet, dwContext, 0, 0)
               End If
            EndIf
            InternetCloseHandle hRequ
         EndIf
         InternetCloseHandle hConn
      EndIf
      InternetCloseHandle(hInet)
   EndIf
End Sub















