Tweet
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:
------------------
Scott
mailto:[email protected][email protected]</A>
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>