TIdHTTPのGetでエラー (ID:19551)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 久しぶりの投稿です。本題とは外れますが、HTTPのクライアントざっと作ってみました。一応<!-- 美乳 -->や<!--京-->問題を避けられるデコード関数もつけました。 どうしてもIndyがいいというなら虫してください。 unit HTTPClient; interface uses Classes, Sockets, SysUtils; type TMyHTTP = class(TCustomIpClient) property Active; property BlockMode; property Connected; property RemoteHost; property RemotePort; property OnCreateHandle; property OnDestroyHandle; property OnConnect; property OnDisconnect; property OnReceive; property OnSend; property OnError; protected FHeader: string; function SetHeaderAnswerBody(re: string): string; public property Header: string read FHeader; constructor Create(AOwner: TComponent); override; //function Head(url: string): string; function Get(url: string): string; //function Post(url: string; dat: string): string; end; procedure AnalyzeURL(const url: string; var domain: string; var path: string; var param: string; var port: string); var g_LastURL : string = ''; g_LastDomain: string = ''; g_LastPath: string = ''; g_LastParam: string = ''; g_LastPort: string = ''; function euc2sjis(euc: string): string; implementation function euc2sjis(euc: string): string; var i, len: integer; w: word; h, eucHi, k, l, m, eucLow, eucw: word; begin result := ''; len := Length(euc); if len = 0 then exit; i := 1; while i <= len do begin h := byte(euc[i]); case h of $A1..$FE: begin //-------------------- l := byte(euc[i + 1]); eucw := h shl 8 + l; case h of $F9..$FF: begin case eucw of $F9A0..$F9C3: w := eucw + $BB; $F9C4..$F9FF: w := eucw + $BC; $FAA0..$FAE2: w := eucw + $1A; $FAE3..$FAFE: w := eucw + $5D; $FAFF..$FBA0: w := eucw + $4E; $FBA1..$FBFF: w := eucw - $45; $FCA1..$FCE2: w := eucw - $E6; $FCF1..$FCFA: w := eucw - $2B1; $FCE3..$FCEE: w := eucw - $A3; $FCFC..$FCFF: w := eucw - $2A7; else begin w := $8145; end; end; result := result + char(w shr 8) + char(w and $FF); end; else begin case h of 0..$DE: begin k := h - $A1;//3F eucHi := $81 + k shr 1; end; else begin k := h - $DF; eucHi := $E0 + k shr 1; end; end; l := (eucw and $FF) - $A0; m := l shr 4; case k mod 2 of 0: begin case m of 0: eucLow := $3F + l and $F; 1: eucLow := $4F + l and $F; 2: eucLow := $5F + l and $F; 3: eucLow := $6F + l and $F; 4: eucLow := $80 + l and $F; 5: eucLow := $90 + l and $F; end; end; 1: begin case m of 0: eucLow := $9E + l and $F; 1: eucLow := $AE + l and $F; 2: eucLow := $BE + l and $F; 3: eucLow := $CE + l and $F; 4: eucLow := $DE + l and $F; 5: eucLow := $EE + l and $F; end; end; end; result := result + char(eucHi) + char(eucLow); end; end; //-------------------- inc(i, 2); end; else begin case h of $8E: begin if (i + 1) <= len then begin result := result + euc[i + 1]; end; inc(i, 2); end; else begin result := result + char(h); inc(i); end; end; end; end; end; end; function TMyHTTP.SetHeaderAnswerBody(re: string): string; var idx: integer; begin idx := pos(#$D#$A + #$D#$A, re); FHeader := Copy(re, 1, idx - 1); result := Copy(re, idx + 2, Length(re)); end; procedure AnalyzeURL(const url: string; var domain: string; var path: string; var param: string; var port: string); var aurl: string; idx, idx2: integer; s, t: string; begin idx := pos('://', url); case idx of 2..7: begin s := trim(Copy(url, 1, idx - 1)); if s = 'http' then begin port := '80'; end else begin if s = 'https' then begin port := '443'; end; end; end; end; idx := pos(s+'://', url); case idx of 0: begin aurl := trim(url); end; 1: begin aurl := trim(Copy(url, idx + Length(s) + 3, Length(url))) end; else begin aurl := trim(url); end; end; idx := pos('?', aurl); case idx of 0: begin param := ''; end; else begin param := Copy(aurl, idx + 1, Length(aurl)); aurl := Copy(aurl, 1, idx - 1); end; end; idx := pos('/', aurl); case idx of 0: begin domain := aurl; path := '/'; end; else begin domain := Copy(aurl, 1, idx - 1); path := Copy(aurl, idx, Length(aurl)); end; end; idx := pos(':', domain); case idx of 0:; else begin domain := Copy(domain, 1, idx - 1); end; end; s := Copy(domain, 1, 1); if (s = '') or (s = '.') then begin s := StringReplace(g_LastPath, '/', '\', [rfReplaceAll]); t := ExtractFileName(s); t := Copy(s, 1, Length(s) - Length(t)); path := StringReplace(t, '\', '/', [rfReplaceAll]) + domain + path; domain := g_LastDomain; end; g_LastURL := url; g_LastDomain := domain; g_LastPath := path; g_LastParam := param; g_LastPort := port; end; constructor TMyHTTP.Create(AOwner: TComponent); begin inherited Create(AOwner); RemotePort := '80'; BlockMode := bmBlocking;//bmNonBlocking; end; function TMyHTTP.Get(url: string): string; var domain, path, param: string; rq, re: string; buf: array[0..1023] of char; len: integer; port: string; begin AnalyzeURL(url, domain, path, param, port); if pos(domain + ':8080', url) > 0 then port := '8080'; RemoteHost := domain; RemotePort := port; if param <> '' then begin rq := 'GET ' + path + '?' + param + ' HTTP/1.0' + #$D#$A + #$D#$A; end else begin rq := 'GET ' + path + ' HTTP/1.0' + #$D#$A + #$D#$A; end; re := ''; Active := true; try SendBuf(rq[1], Length(rq)); len := ReceiveBuf(buf, 1024); while len > 0 do begin re := re + Copy(buf, 1, len); len := ReceiveBuf(buf, 1024); end; finally Active := false; end; re := euc2sjis(re); result := SetHeaderAnswerBody(re); end; end.