OK Here we go again LOL.

I've completely revamped this project..

This DLL (Posting entire source) goes out and grabs a web page, nothing more, no links from it, no images, nothing, just the page itself.


But, the hHeader.Header (HTML Header being returned) LEAVES the DLL with the last few characters as text/html but returns to the application as text/htmldc7

WHere's the dc7 coming from?

If you want the entire source in email, email me, but this is all of it here:


Code:
'TEST.BAS FIRST
#Compile Exe
#Include "Win32api.inc"

' Constants FOR HTML ERRORS
%HTML_200 = 200
%HTML_403 = 403
%HTML_404 = 404
%HTML_405 = 405
%HTML_406 = 406
%HTML_407 = 407
%HTML_408 = 408
%HTML_500 = 500
%HTML_501 = 501
%HTML_502 = 502


'HTTP/1.1 200 OK
'Date: Mon, 08 May 2000 15:39:16 GMT
'Server: Apache/1.3.6 (Unix) PHP/3.0.7 mod_perl/1.21 mod_frontpage/3.0.4.3
'Last-Modified: Sun, 23 Apr 2000 03:47:23 GMT
'ETag: "6828-21a0-3902724b"
'Accept-Ranges: bytes
'Content-Length: 8608
'Keep-Alive: timeout=65, Max=200
'Connection: Keep-Alive
'Datatype, html/text
Type HTML_HEADER
   ErrorMsg             As Asciiz * 100
   Current_Date         As Asciiz * 35
   ServerType           As Asciiz * 100
   LastModdate          As Asciiz * 35
   Etag                 As Asciiz * 25
   AcceptRanges         As Asciiz * 10
   ContentLength        As Long
   HeaderLength         As Long  'Thanks to Unix, MS doesn't have this problem
   Keep_Alive_Timeout   As Long
   Keep_Alive_Max       As Long
   Connection           As Asciiz * 25
   DataType             As Asciiz * 12
   Header               As Asciiz * 255
End Type


Declare Function GetWebPage Lib "CCSINET.DLL" (hWnd As Long,_
                          hMsg As Long,_
                                  wwwPort As Long, _
                                  ByVal wwwPage As String, _
                                  AppName As String, _
                                  Referrer As String, _
                                  hHeader As HTML_HEADER,_
                                  Buffer As String) As Long 'The actual Page

Declare Function StripHTTPandGetHostName Lib "CCSINET.DLL" (wwwPage As String, wHostName As String) As String
Declare Function GetHtmlHeader Lib "CCSINET.DLL" (hHeader As HTML_HEADER,Buffer As String) As Long
Declare Function GetTCPBuffer Lib "CCSINET.DLL" ()As String
Declare Function CheckAtomicTime Lib "CCSINET.DLL" (lserv As String,wPort As Long, aTimeout As Long,Delay As Double,st As SYSTEMTIME) As String


Function PbMain() As Long
Local Buffer        As String
Local lResult       As Long
Dim hHeader         As HTML_HEADER

lResult = GetWebPage(0,_
                     0,_
                     80,_
                     "http://www.tngbbs.com/index.html",_
                     "HTML Test",_
                     "HTML Test",_
                     hHeader,_
                     Buffer)

MsgBox hHeader.Header
MsgBox Buffer

End Function

'
'
'
'
'
'
'
'
Now the DLL code:

Change the GetWindowsVersion with "Windows 98", easy enough to do...


#Compile Dll "ccsinet.dll"
#Register None
#Option Version4
#Include "win32api.inc"
#Include "CommCtrl.inc"
#Resource "CCS.PBR"

%BUFFER_SIZE = 256
%HTML_404    = 404
%PROGRAM     = 1024
%PROGRESS    = %WM_USER + 900
%IDT_TIMER1  = %WM_USER + 901

%IDLABEL1    = %WM_USER + 1021
%IDLABEL2    = %WM_USER + 1022
%IDLABEL3    = %WM_USER + 1023
%IDLABEL4    = %WM_USER + 1024
%IDLABEL5    = %WM_USER + 1025
%IDLABEL6    = %WM_USER + 1026

' Constants FOR HTML ERRORS
%HTML_200 = 200
%HTML_403 = 403
%HTML_404 = 404
%HTML_405 = 405
%HTML_406 = 406
%HTML_407 = 407
%HTML_408 = 408
%HTML_500 = 500
%HTML_501 = 501
%HTML_502 = 502


Type HTML_HEADER
   ErrorMsg             As Asciiz * 100
   Current_Date         As Asciiz * 35
   ServerType           As Asciiz * 100
   LastModdate          As Asciiz * 35
   Etag                 As Asciiz * 25
   AcceptRanges         As Asciiz * 10
   ContentLength        As Long
   HeaderLength         As Long  'Thanks to Unix, MS doesn't have this problem
   Keep_Alive_Timeout   As Long
   Keep_Alive_Max       As Long
   Connection           As Asciiz * 25
   DataType             As Asciiz * 12
   Header              As Asciiz * 255
End Type


Declare Function GetWebPage(hWnd As Long,_
                            hMsg As Long,_
                            wwwPort As Long, _
                            ByVal wwwPage As String, _
                            AppName As String, _
                            Referrer As String, _
                            hHeader As HTML_HEADER,_
                            Buffer As String) As Long

Declare Function SendHtmlRequest(wwwPort As Long, _
                                wHostName As String, _
                                ByVal wwwPage As String,_
                                AppName As String, _
                                Referrer As String) As Long


Declare Function GetHtmlHeader(hHeader As HTML_HEADER) As Long
Declare Function StripHTTPandGetHostName(wwwPage As String, wHostName As String, RemoteDir As String) As String

Declare Function GetTCPBuffer()As String
Declare Function ShowHtmlDialog(ThreadId As Long) As Long
Declare CallBack Function HtmlProc() As Long
Declare Function ThreadDialog(ByVal hDlg As Long)As Long
Declare CallBack Function CancelButton() As Long

Declare Function GetWindowsVersion Lib "CCS.DLL" ()As String


Global ghLibTest        As Long
Global gReason          As Long
Global gReserved        As Long
Global gNumOfTimes      As Dword
Global gNumOfCheck      As Dword
Global g_sVer           As String

Global hDlg                     As Long
Global sDlg                     As Long
Global hTcp                     As Dword
Global g_hMsg                   As Long
Global g_Thread_Result          As Long
Global g_lngInitThreadHandle    As Long
Global g_CancelFlag             As Long
Global g_TotalBytes             As Long
Global hHeader                  As HTML_HEADER
Global g_sCCS                   As String
Global g_sMINE                  As String
Global g_WebPage                As String
'------------------------------------------------------------------------------------------------------------------------

Function LibMain(ByVal hInstance As Long, _
                 ByVal Reason    As Long, _
                 ByVal Reserved  As Long) Export As Long

  ghLibTest = hInstance
  gReason   = Reason
  gReserved = Reserved
  g_sCCS = "Computer Creations Software"
  g_sMINE = "HTML Internet DLL"
  g_sVer  = "v1.1"

  Incr gNumOfTimes

  Select Case Reason

    Case %DLL_PROCESS_ATTACH
      gNumOfCheck = 1234
       LibMain = 1   'success!
      Exit Function

    Case %DLL_PROCESS_DETACH

       LibMain = 1   'success!
      Exit Function

    Case %DLL_THREAD_ATTACH
       LibMain = 1   'success!
      Exit Function

    Case %DLL_THREAD_DETACH
       LibMain = 1   'success!
      Exit Function
  End Select
End Function


'------------------------------------------------------------------------------------------------------------------------
Function GetWebPage(hWnd As Long,_
                    hMsg As Long,_   'hStatus or whatever control you wish to send to, if NULL it won't send
                    wwwPort As Long, _ 'Port to open
                    ByVal wwwPage As String, _ 'Entire [url="http://www.tngbbs.com/winlog/index.html"]http://www.tngbbs.com/winlog/index.html[/url] 
                    AppName As String, _       'Application referring For web statistics on some pages
                    Referrer As String, _      'Referrer
                    hHeader As HTML_HEADER,_
                    Buffer As String) Export As Long 'What to save the local file as, entire path.

Local hFile         As Long
Local lCount        As Long
Local lLoop         As Long
Local lResult       As Long
Local ErrType       As Long
Local ThreadID      As Long

Local zText         As Asciiz * 120

Local sInArray      As String
Local HostName      As String
Local TmpFile       As String 'Temp file
Local FileExt       As String 'MUST have, copy from etag filename to .gif etc
Local RemoteFile    As String
Local RemoteDir    As String

'Set Global vars
hDlg = hWnd 'Now it's global
g_hMsg = hMsg
g_WebPage = wwwPage 'For image use

'Set the mouse busy
MousePtr 11
Pc& = SetPriorityClass(GetCurrentProcess(), %HIGH_PRIORITY_CLASS)

'Create a user interface t hread, we will talk to it through our main functions
Thread Create ShowHtmlDialog(ThreadId) To g_lngInitThreadHandle
Thread Close g_lngInitThreadHandle To g_Thread_Result

wwwPage = StripHTTPandGetHostName(wwwPage,HostName,RemoteDir)
RemoteFile = Mid$(wwwPage,Instr(-1, wwwPage,"/") + 1)   'help.html
Control Set Text sDlg, %IDLABEL1, "Contacting "
Control Set Text sDlg, %IDLABEL2, HostName

'Tested good here so far
lResult = SendHtmlRequest(wwwPort, _
                          HostName, _
                          ByVal wwwPage, _
                          AppName, _
                          Referrer)

If lResult <> 200 Then
   Sleep 500
   Dialog End sDlg, 0
   Exit Function
End If

Control Set Text sDlg, %IDLABEL2, HostName + wwwPage
lResult = GetHtmlHeader(hHeader)
If lResult <> 200 Then
   Tcp Close hTcp
   Exit Function
End If

Buffer = hHeader.Header + GetTCPBuffer()

If IsTrue g_CancelFlag Then Exit Function
Function = lResult
MousePtr 0
Dialog End sDlg,1
End Function

'-----------------------------------------------------------------------------------
Function SendHtmlRequest(wwwPort As Long, _
                        wHostName As String, _
                        ByVal wwwPage As String,_
                        AppName As String, _
                        Referrer As String)Export As Long

Local ErrType       As Long
Local wwwRequest    As String

If hTcp = 0 Then    'And it should be, open main port here
    'Safety precaution
    If wwwPort = 0 Then wwwPort = 80
    'Open the port
    hTcp = FreeFile
    Tcp Open Port wwwPort At wHostName As hTcp TimeOut 1' 3000
    ErrType = Err
    Select Case ErrType
        Case 0
           Function = %HTML_200
        Case 52
           Control Set Text sDlg, %IDLABEL1, "Failed"
           Control Set Text sDlg, %IDLABEL2, "Host not found"
        Case Else
           Control Set Text sDlg, %IDLABEL1, "Failed"
           Control Set Text sDlg, %IDLABEL2, Trim$(Str$(ErrType))
           Function = ErrType
    End Select
    If ErrType <> 0 Then Exit Function
End If


'******************************
'We will use the temp directory, not a cache directory
'Build the HTTP header
wwwRequest = "GET " + wwwPage + " HTTP/1.1" + $CRLF
wwwRequest = wwwRequest + "Accept: */*" + $CRLF
wwwRequest = wwwRequest + "Referer: " + Referrer + $CRLF
wwwRequest = wwwRequest + "Accept-Language: en-us" + $CRLF
wwwRequest = wwwRequest + "Accept-Encoding: gzip, deflate" + $CRLF
wwwRequest = wwwRequest + "User-Agent: Mozilla/4.0 (compatable; " + AppName + "; " + GetWindowsVersion + ")" + $CRLF
wwwRequest = wwwRequest + "Host: " + wHostName + $CRLF
wwwRequest = wwwRequest + "Connection: Keep-Alive" + $CRLF
wwwRequest = wwwRequest + "" + $CRLF

If IsTrue g_CancelFlag Then Exit Function

Control Set Text  sDlg, %IDLABEL1, "Requesting"
Control Set Text  sDlg, %IDLABEL2, wwwPage

'Send the request
Tcp Print hTcp, wwwRequest
ErrType = Err
Select Case ErrType
    Case 0
       Function = %HTML_200
       Exit Function
    Case 52
       Control Set Text sDlg, %IDLABEL1, "Failed"
       Control Set Text sDlg, %IDLABEL2, "Host Not Found while sending request"
    Case Else
       Control Set Text sDlg, %IDLABEL1, "Failed"
       Control Set Text sDlg, %IDLABEL2, Trim$(Str$(ErrType))
       Function = ErrType
End Select
Function = ErrType
End Function

'------------------------------------------------------------------------------------------------------------------------
Function StripHTTPandGetHostName(wwwPage As String, wHostName As String,RemoteDir As String) As String 'Returns wwwPage stripped, wwwPage is the entire path
wwwPage= Remove$(wwwPage,"http://")
wHostName = Left$(wwwPage,Instr(wwwPage,"/") - 1)
wwwPage = Remove$(wwwPage,wHostName)
RemoteDir = Mid$(wwwPage,Instr(wwwPage,"/"),Instr(-1, wwwPage,"/"))
Function = wwwPage
End Function
'------------------------------------------------------------------------------------------------------------------------
Function GetTCPBuffer()Export As String
Local buffer As String
Local WebIn  As String
Local bufCount As Long
Local ByteCount As Long
Local ErrType   As Long

Control Set Text sDlg, %IDLABEL1, "Downloading "

TCPBEGIN:
Do
  Tcp Recv #hTcp,%BUFFER_SIZE, buffer
  BufCount = Len(buffer)
  ByteCount = ByteCount + BufCount
  g_TotalBytes = g_TotalBytes + ByteCount
  Control Set Text  sDlg, %IDLABEL4, Trim$(Str$(ByteCount))
  Control Set Text  sDlg, %IDLABEL6, Format$(g_TotalBytes,",000")'  Trim$(Str$(g_TotalBytes))
  WebIn = WebIn + buffer

  If IsTrue g_CancelFlag Then
     Tcp Close hTcp
     Exit Function
  End If
Loop While BufCount
Function = WebIn
Exit Function
TCPERR:
  ErrType = Err
  Select Case ErrType
         Case 0
'              Resume TCPBEGIN
         Case Else
            Control Set Text sDlg, %IDLABEL1, "Error: "
            Control Set Text sDlg, %IDLABEL2, Trim$(Str$(ErrType))
            g_CancelFlag = %TRUE 'Use to close dialog on error etc
            Exit Function
  End Select
End Function
'------------------------------------------------------------------------------------------------------------------------
Function GetHtmlHeader(hHeader As HTML_HEADER)Export As Long
Local lLoop         As Long
Local sInArray      As String
Local lHeaderLine   As String
Local lErMsg        As Long
Local ErrType       As Long

On Error GoTo TCPERR
Control Set Text sDlg, %IDLABEL1, "Downloading"
TCPBEGIN:

'This is an IIS header being returned. it appears to be 8 not 10 loops, vastly different than Unix.
'HTTP/1.1 200 OK
'Server: Microsoft-IIS/5.0
'Date: Mon, 14 Aug 2000 16:19:54 GMT
'Content-Type: Text/html
'Accept-Ranges: bytes
'Last-Modified: Sun, 13 Aug 2000 07:50:38 GMT
'ETag: "0db872bfb4c01:927"
'Content-Length: 2068

'This is an APACHE/Unix Header being returned, it also appears to be 7 now..
'HTTP/1.1 200 OK
'Date: Mon, 14 Aug 2000 20:53:07 GMT
'Server: Apache/1.3.6 (Unix) PHP/3.0.7 mod_perl/1.21 mod_frontpage/3.0.4.3
'Keep-Alive: timeout=35, Max=100
'Connection: Keep-Alive
'Transfer-Encoding: chunked
'Content-Type: Text/htmldc7

For lLoop = 1 To 8
    Tcp Line #hTcp, sInArray
    ErrType = Err
    Select Case ErrType
             Case 0
             Case Else
                Control Set Text sDlg, %IDLABEL1, "Error: "
                Control Set Text sDlg, %IDLABEL2, Trim$(Str$(ErrType))
                Exit Function
    End Select
    hHeader.Header = hHeader.Header + sInArray
    If Parse$(sInArray,"/",1) = "HTTP" Then
           lErMsg = Val(Parse$(sInArray," ",2))
           hHeader.ErrorMsg = sInArray
    End If

    lHeaderLine = Parse$(sInArray," ",1)
    Select Case lHeaderLine
                      'HTTP/X.X XXX ErrorMsg

              Case "Server:"
                 hHeader.ServerType = Parse$(sInArray," ", 2)
              Case "Date:"
                 hHeader.Current_Date  = Parse$(sInArray," ", 2)

              Case  "Content-Type:"
                 hHeader.Datatype = Parse$(sInArray," ", 2)

              Case "Transfer-Encoding:" 'Unix
                 hHeader.Datatype = Parse$(sInArray," ", 2)

              Case "Accept-Ranges:" 'Windows
                 hHeader.AcceptRanges = Trim$(Parse$(sInArray," ", 2))


              Case "Content-Length:"
                 hHeader.ContentLength = Val(Parse$(sInArray," ", -1))

              Case "Last-Modified:"
                 hHeader.LastModdate = Parse$(sInArray," ", 2)

              Case "ETag:"
                 hHeader.Etag = Parse$(sInArray," ", 2)

              Case "Keep-Alive:"
                 'These will still need to be parsed down one more from '='
                 hHeader.Keep_Alive_Timeout = Val(Parse$(Parse$(Parse$(sInArray," ", 2),"=",1),",",1))
                 hHeader.Keep_Alive_Max  = Val(Parse$(Parse$(sInArray," ", 3),"=",1))

              Case "Connection:"
                 hHeader.Connection = Parse$(sInArray," ", -1)

    End Select

Next
hHeader.HeaderLength = SizeOf(hHeader.Header)
Function = lErMsg
Exit Function

TCPERR:
  ErrType = Err
  Select Case ErrType
         Case 0
              Resume TCPBEGIN
         Case Else
            Control Set Text sDlg, %IDLABEL1, "Error: "
            Control Set Text sDlg, %IDLABEL2, Trim$(Str$(ErrType))
            g_CancelFlag = %TRUE 'Use to close dialog on error etc
            Exit Function
  End Select


End Function

'---------------------------------------------------------------------------------------------------------------------------------
Function ShowHtmlDialog(ThreadID As Long) As Long
    Dialog New hDlg, "",,, 180,50, %WS_POPUP Or %WS_DLGFRAME  To sDlg
    Control Add Label, sDlg, %IDLABEL1, "Opening", 5, 1, 43, 10
    Control Add Label, sDlg, %IDLABEL2, g_WebPage, 45, 1, 140, 10
    Control Add "msctls_progress32",sDlg, %PROGRESS,"",5,15,170,10, %WS_CHILD Or %WS_VISIBLE Or %WS_CLIPSIBLINGS Or %CCS_BOTTOM
    Control Add Button, sDlg, %IDCANCEL, "&Cancel",130,30,45,14 Call CancelButton
    Control Add Label, sDlg, %IDLABEL3, "bytes: ",5,30,50,10
    Control Add Label, sDlg, %IDLABEL4, "0",45,30,35,10
    Control Add Label, sDlg, %IDLABEL5, "Total: ", 5,40,40,10
    Control Add Label, sDlg, %IDLABEL6, "0", 45,40,40,10

    Dialog Send sDlg, %WM_SETICON, %ICON_BIG, LoadIcon( ghLibTest, ByVal %PROGRAM)
    Control Send sDlg, %PROGRESS,  %PBM_SETRANGE, 0, MakLng (0,30)
    Control Send sDlg, %PROGRESS,  %PBM_SETSTEP,1, 0
    Dialog Show Modal sDlg Call HtmlProc
End Function

'---------------------------------------------------------------------------------------------------------------------------------

CallBack Function HtmlProc() As Long
Static wCount As Long

    MousePtr 11 'BUSY

    Select Case CbMsg

    Case %WM_INITDIALOG
        SetTimer sDlg, %IDT_TIMER1,  1000, ByVal %NULL '30 second timeout
    Case %WM_DESTROY
         KillTimer sDlg,  %IDT_TIMER1

    Case %WM_TIMER
        Select Case CbWparam
          Case %IDT_TIMER1
             Control Set Focus sDLg, %IDCANCEL
             If IsTrue g_CancelFlag Then Dialog End sDlg, 0
             If wCount = 30 Then
                 MousePtr 0
                 Dialog End sDlg, 1
             Else
                Control Send sDlg, %PROGRESS, %PBM_STEPIT, 0, 0
                Incr wCount
             End If
        End Select

    End Select
 End Function
'---------------------------------------------------------------------------------------------------------------------------------
Function ThreadDialog(ByVal hDlg As Long) Export As Long
Local Rc As Long
Do
    Dialog DoEvents
    Dialog Get Size hDlg To Rc,Rc
Loop While Rc

Function = 1
End Function
'----------------------------------------------------------------------------------------------------------------
CallBack Function CancelButton() As Long
g_CancelFlag = %TRUE
End Function
'----------------------------------------------------------------------------------------------------------------
------------------
Scott
mailto:[email protected][email protected]</A>