(* @ @ /// deStructor t_finger.destroy; *) deStructor t_finger.destroy; begin f_answer.free; inherited destroy; end; (* @ @ @ @ @ @ @ / // procedure t_fingerd.do_action; *) procedure t_fingerd.do_action; var i: integer; temp_socket: TSocket; finger_info: TFingerInfo; sockinfo: TSockAddr; s: string; begin temp_socket: = f_socket; self.f_socket: = accept_socket_in (f_socket, SockInfo; f_eof: = false; finger_info.address: = longint (sockinfo.sin_addr); s: = self.read_line (f_socket); finger_info.request: = S; Finger_INFO.HOSTNAME: = '; (* nyi !! ! *) If assigned (f_fingerRequest) THEN F_FINGERREQUEST (Self, Finger_INFO); for i: = 0 to f_answer.count-1 do begin self.write_s (f_socket, f_answer.strings [i] # 13 # 10); END; close_socket_linger (f_socket); f_socket: = temp_socket; end; (* @ /// 000000131B *) (* @ /// procedure t_fingerd.SetAnswer (Value: TStringList); *) procedure t_fingerd.SetAnswer (Value: TStringList); begin IF value = nil the f_answer.clear else f_answer.assign (VAL UE); end; (* @ @ @ @ @ @ /// procedure t_fingerd.wndproc (var msg: tMESSAGE); *) Procedure T_fingerd.WndProc (var msg: tMESSAGE); begin if msg.msg < > uwm_socketevent then inherited wndproc (msg) else begin if msg.lparamhi = socket_error then else begin case msg.lparamlo of fd_accept: begin do_action; end; end; end; end; end; (* @ /// 0000000E09 *) (* @ /// procedure t_fingerd.action; *) procedure t_fingerd.action; begin open_socket_in (f_socket, f_Socket_number, my_ip_address); if f_socket = INVALID_SOCKET then raise ESocketError.Create (WSAGetLastError);
Winsock.wsaasyncselect (f_socket, f_handle, uwm_socketevent, fd_accept); end; (* @ @ @ @ @ @ @ @ @ @ @ @ @ t file transfer protocols} (* @ /// class t_http (t_tcpip) *) (* @ /// constructor t_http.Create (Aowner: TComponent); *) constructor t_http.Create (Aowner: TComponent); begin inherited create (AOwner); f_content_post: = 'application / x-www -form-urlencoded '; f_do_author: = TStringlist.Create; end; (* @ /// 0000000503 *) (* @ /// destructor t_http.Destroy; *) destructor t_http.Destroy; begin f_do_author.free; inherited destroy; End; (* @ /// *)
(* @ /// procedure t_http.sendrequest (const method, version: string); *) procedure t_http.sendrequest (const method, version: string); begin SendCommand (method '' f_path 'HTTP /' version); If F_SENDER <> '' Then Sendcommand; if f_reference <> 'TENDCOMMAND (' Referr: ' f_reference); if f_agent <>' Then SendCommand ('user-agent:' f_agent); if f_nocache then SendCommand ( 'Pragma: no-cache'); if method = 'POST' then begin SendCommand ( 'Content-Length:' inttostr (stream.size)); if f_content_post <> '' then SendCommand ('Content-Type:' f_content_post); end; if f_author <> '' Then Begin self.write_s (f_socket, 'authorization:' f_author # 13 # 10); if Assigned (f_tracer) THEN F_Tracer ('Authorization: ***** ', tt_proto_sent); end; self.write_s (f_socket, # 13 # 10); (* finalize the request *) end; (* @ @ @ @ @ @ /// procedure t_http .getanswer; *) procedure t_http.getanswer; var s: string; proto, user, pass, port: string; fi ELD, DATA: STRING; begin f_do_author.clear; f_type: = '; f_size: = 0; repeat s: = self.read_Line (f_socket); if S <>' Then if Assigned (f_tracer) THEN F_Tracer (s, TT_PROTO_GET); if false dam (* @ /// Else if Left (s, 8) = 'http-status-reply *) Else if copy (s, 1, 8) =' http / 1.0 ' THEN Begin f_status_nr: = start (COPY (S, 10, 3)); f_status_txt: = COPY (S, 14, Length (s)); if f_status_nr> = 400 dam
(* Http error returned *) end (* @ ////) (* @ /// else if Pos (':', s)> 0 thrse if pos (':', s) ELSE IF POS (':', S )> 0 THEN BEGIN Field: = LowerCase (COPY (S, 1, POS (':', s) -1)); Data: = COPY (S, POS (':', s) 2, Length (S )); If false {else {else if Field = 'mime-version' Then} {Else If Field = 'pragma' Then} {else if Field = 'allow' Then} (* @ /// Else if Field = 'location' Ten Change The Uri !!! *) Else if Field = 'Location' Then BEGIN IF PROXY <> 'TENF_PATH: = Data (* It Goes Via a Proxy, So Just change the uri *) else begin parse_url (data, proto, user, pass, f_hostname, port, f_path); if port <> '' then f_Socket_number: = strtoint (port); end; end (* @ /// 0000000601 * ) {Else if Field = 'server' TEN} {Else If Field = 'Content-Encoding' TEN} (* @ /// Else If Field = 'Content-length' Then *) Else If Field = 'Content-Length' THEN F_SIZE: = STRTOINT (* @ /// *) (* @ /// Else if Field = 'Content-Type' Then *) Else If Field = 'Content-Type' Then F_ty PE: = data (* @ ////) (* @ /// else if Field = 'www-authenticate' Then *) Else if Field = 'www-automate' Ten f_do_author.add (data) (* @ / {Else if Field = 'expires' TEN} {else if Field = 'last-modified' TEN} end (* @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ e g s om IT *) Else; (* @ /// *) until s = ''; if f_status_nr> =
400 TEN RAISE EPROTOCOLERROR.CREATE ('http', f_status_txt, f_status_nr); end; (* @ @ @ @ @ @) procedure t_http.action; var PROTTP.Action; Var proto, user, Pass, host, port, path: string; begin (* @ @ @ @ @ @ @ @ @ @ @ hosos, f_path and f_socket_number *) if f_proxy <> 'Then Begin Parse_URL (f_url, proto, user, pass, host, port , path); f_path: = f_url; if proto = '' TENF_PATH: = 'http: //' f_path; Parse_URL (f_Proxy, Proto, User, Pass, Host, Port, Path); if port = '' Then Port: = '8080'; endelse begin parse_url (f_url, proto, user, pass, host, port, f_path); if port = '' Then Port: = '80'; END; if proto = '' Then Proto: = 'http'; if f_path = '' TENF_PATH: = '/';
f_hostname: = host; f_Socket_number: = strtoint (port); (* @ /// 0000000601 *) gethead; (* to process an eventually Location: answer *) getbody; end; (* @ /// 0000000501 *) (* @ /// procedure t_http.gethead; *) procedure t_http.gethead; begin login; sendRequest ('head', '1.0'); Getanswer; Logout; End; (* @ @ @ @ @ @ @ @ @ // / procedure t_http.getBody; *) procedure t_http.getbody; var P: Pointer; OK, OK2: Integer; Begin Login; Sendrequest ('get', '1.0'); getanswer; (* @ /// read the data * ) TMemorystream (f_stream) .clear; while not eof (f_socket) do begin read_var (f_socket, f_buffer ^, buf_size, ok); p: = f_buffer; while ok> 0 do begin (* just to be sure everything goes into the stream *) OK2: = f_stream.write (p ^, ok); DEC (OK, OK2); P: = POINTER (longint (p) ok2); end; end; f_stream.seek (0, 0); (* Set the stream back to start *) (* @ //// *) logout; end; (* @ @ @ @ @ @ @) procedure t_http.post; var P: POINTER; OK, OK2: Integer; Proto, User, Pass, Host, Port, Path: String; Begin (* @ //// Parse Url and proxy to f_hostname, f_path and f_socket_number *) if f_proxy <> '' Then Begin Parse_URL (F_Proxy, Proto, User, Pass, Host, Port, Path); f_path: = f_url; if port = '' Then Port: = '8080'; Endelse Begin Parse_URL (f_url, proto, user, pass, host, port, f_path); if port = '' Then Port: = '80'; END; if proto = '' Then Proto: = 'http '; if path =' 'THEN PATH: =' / ';
