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>