Use SOCKET in Delphi to obtain webpage source files

I sorted out a piece of code from the Yangfan blog and kept it for backup.

Original article: http://www.wesoho.com/article/Delphi/2910.htm

Unit udownloadhtml; interfaceuses sysutils, windows, forms, WinSock, wininet; function downloadwithinet (const aurl: string): string; function downloadwithsocket (const aurl: string): string; implementationfunction downloadwithinet (const aurl: string): string; Procedure add (BUF: pchar; count: integer); var Len: integer; begin Len: = length (result ); setlength (result, Len + count); move (BUF ^, result [Len + 1], count); end; function prepareurl: string; begin result: = uppercase (copy (aurl, 1, 7); If result <> 'HTTP: // 'then result: = 'HTTP: // '+ aurl else result: = aurl; end; var bytesread: DWORD; Session, connection: hinternet; Buffer: array [1 .. 1024] of char; begin result: = ''; If aurl ='' then exit; Session: = internetopen (nil, internet_open_type_direct, nil, nil, 0 ); if not assigned (Session) then raise exception. create (syserrormessage (getlasterror); try connection: = internetopenurl (Session, pchar (prepareurl), nil, 0, timeout, {internet_flag_reload,} 0); if not assigned (connection) then raise exception. create (syserrormessage (getlasterror); try repeat fillchar (buffer, sizeof (buffer), 0); internetreadfile (connection, @ buffer, sizeof (buffer), bytesread ); if bytesread> 0 then add (@ buffer, bytesread); application. processmessages; until bytesread = 0; finally internetclosehandle (connection); end; finally internetclosehandle (session); end; function downloadwithsocket (const aurl: string): string; const CRLF = #13 #10; sfilecontentlen = 'content-length: '; suseragent = 'user-AGENT: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1 ;. net CLR 1.0.3705) '; srequestfilehead = 'head % s HTTP/000000' + CRLF + 'pragma: No-cache' + CRLF + 'cache-control: no-Cache '+ CRLF + suseragent + CRLF + 'host: % s' + CRLF; srequestdownfile = 'get % s HTTP/000000' + CRLF + 'Accept: */* '+ CRLF + suseragent + CRLF + 'range: bytes = 0-' + CRLF + 'host: % s' + CRLF; Procedure extracthostandfilename (const aurl: string; var ahost, afilename: string; aport: pstring = nil); const httphead = 'HTTP: // '; httpheadlen = length (httphead); var I: integer; begin ahost: = aurl; I: = pos (httphead, aurl); If I <> 0 then ahost: = copy (ahost, I + httpheadlen, maxint); I: = ansipos ('/', ahost); while I <> 0 do begin ahost: = copy (ahost, 1, I-1); I: = ansipos ('/', ahost); end; I: = pos (ahost, aurl) + Length (ahost); afilename: = copy (aurl, I, maxint); I: = pos (': ', ahost); If I <> 0 then begin if assigned (aport) Then aport ^: = copy (ahost, I + 1, maxint); ahost: = copy (ahost, 1, I-1); end; var socket: tsocket; function waitforsocket (Timeout: integer): Boolean; var fdset: tfdset; timeval: ttimeval; begin timeval. TV _sec: = timeout; timeval. TV _usec: = 0; fd_zero (fdset); fd_set (socket, fdset); Result: = Winsock. select (0, @ fdset, nil, nil, @ timeval)> 0; end; Procedure add (var s: string; Buf: pchar; count: integer); var Len: integer; begin Len: = length (s); setlength (S, Len + count); move (BUF ^, s [Len + 1], count); end; function succeeded Eline: string; var C: Char; retlen: integer; begin result: = ''; while socket <> invalid_socket do begin retlen: = Recv (socket, C, 1, 0 ); if (retlen <= 0) or (retlen = socket_error) Then break; add (result, @ C, 1); If pos (CRLF, result)> 0 Then break; end; end; function sendcommand (const command: string): string; var P: pchar; Data: string; begin result: = ''; P: = pchar (command ); send (socket, P ^, length (command), 0); While waitforsocket (5) do Begin data: = pipeline Eline; If (Data = '') or (Data = CRLF) then break else add (result, pchar (data), length (data); end; Procedure initsocket (const ahost: string); var ADDR: tsockaddrin; Data: twsadata; hostent: phostent; Timeout: integer; begin Winsock. wsastartup ($0101, data); socket: = Winsock. socket (pf_inet, sock_stream, ipproto_ip); If socket = invalid_socket then raise exception. create (syserrormessage (getlasterror); Timeout: = 1000; Winsock. setsockopt (socket, sol_socket, so_rcvtimeo, @ timeout, sizeof (timeout); hostent: = gethostbyname (pchar (ahost); fillchar (ADDR. sin_addr, sizeof (ADDR. sin_addr), 0); ADDR. sin_family: = pf_inet; If hostent <> nil then move (hostent ^. h_addr ^ [0], ADDR. sin_addr.s_addr, hostent ^. h_length) else raise exception. createfmt ('host not found: % s', [ahost]); ADDR. sin_port: = htons (80); If connect (socket, ADDR, sizeof (ADDR) <> 0 then raise exception. create (syserrormessage (getlasterror); end; Procedure uninitsocket; begin if socket <> invalid_socket then closesocket (socket); wsacleanup; end; var data, filename, host: string; begin socket: = invalid_socket; extracthostandfilename (aurl, host, filename); try initsocket (host); If filename = ''then filename: = '/'; data: = sendcommand (format (srequestfilehead, [filename, host]); Data: = sendcommand (format (srequestdownfile, [filename, host]); While true do Begin data: = Eline; if data = ''then break; add (result, pchar (data), length (data); application. processmessages; end; finally uninitsocket; end.