uses WinInet;//引入WinInet单元
//网址检测
function CheckUrl(
Url: string): boolean;
var
hSession, hFile, hRequest: hInternet;
dwIndex, dwCodeLen: dword;
dwCode: array [1..20] of char;
res: PChar;
begin
Result:=false;
hSession:=InternetOpen('Mozilla/4.0 (MSIE 6.0; Windows NT 5.1)',
INTERNET_
OPEN_TYPE_PRECONFIG, nil,nil,0);
if Assigned(hSession) then begin
if Copy(LowerCase(Url), 1, 8) = 'https://' then
hFile:=InternetOpenURL(hSession, PChar(Url), nil, 0, INTERNET_FLAG_SECURE, 0)
else
hFile:=InternetOpenURL(hSession, PChar(Url) , nil, 0, INTERNET_FLAG_RELOAD, 0);
dwIndex:=0;
dwCodeLen:=10;
HttpQueryInfo(hFile, HTTP_QUERY_STATUS_CODE, @dwCode, dwCodeLen, dwIndex);
res:=PChar(@dwCode);
Result:=(res='200') or (res='302');
if Assigned(hFile) then
InternetCloseHandle(hFile);
InternetCloseHandle(hSession);
end;
end;
//获取网页代码,测试有效
function HTTPGet(Url: string): string;
var
hSession, hConnect, hRequest: hInternet;
FHost, FScript, SRequest, Uri: string;
Ansi: PAnsiChar;
Buff: array [0..1023] of Char;
BytesRead: Cardinal;
Res, Len: DWORD;
https: boolean;
const
Header='Content-Type: application/x-www-form-urlencoded' + #13#10;
begin
https:=false;
if Copy(LowerCase(Url),1,8) = 'https://' then https:=true;
Result:='';
if Copy(LowerCase(Url), 1, 7) = 'http://' then Delete(Url, 1, 7);
if Copy(LowerCase(Url), 1, 8) = 'https://' then Delete(Url, 1, 8);
Uri:=Url;
Uri:=Copy(Uri, 1, Pos('/', Uri) - 1);
FHost:=Uri;
FScript:=Url;
Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));
hSession:=InternetOpen('Mozilla/4.0 (MSIE 6.0; Windows NT 5.1)', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if not Assigned(hSession) then exit;
try
if https then hConnect:=InternetConnect(hSession, PChar(FHost), INTERNET_DEFAULT_HTTPS_PORT, nil,'HTTP/1.0', INTERNET_SERVICE_HTTP, 0, 0) else
hConnect:=InternetConnect(hSession, PChar(FHost), INTERNET_DEFAULT_HTTP_PORT, nil, 'HTTP/1.0', INTERNET_SERVICE_HTTP, 0, 0);
if not Assigned(hConnect) then exit;
try
Ansi:='text/*';
if https then
hRequest:=HttpOpenRequest(hConnect, 'GET', PChar(FScript), 'HTTP/1.1', nil, @Ansi, INTERNET_FLAG_SECURE, 0)
else
hRequest:=HttpOpenRequest(hConnect, 'GET', PChar(FScript), 'HTTP/1.1', nil, @Ansi, INTERNET_FLAG_RELOAD, 0);
if not Assigned(hConnect) then Exit;
try
if not (HttpAddRequestHeaders(hRequest, Header, Length(Header), HTTP_ADDREQ_FLAG_REPLACE or HTTP_ADDREQ_FLAG_ADD or HTTP_ADDREQ_FLAG_COALESCE_WITH_COMMA)) then
exit;
Len:=0;
Res:=0;
SRequest:=' ';
HttpQueryInfo(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF or HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
if Len > 0 then begin
SetLength(SRequest, Len);
HttpQueryInfo(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF or HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
end;
if not (HttpSendRequest(hRequest, nil, 0, nil, 0)) then // www.delphitop.com
exit;
FillChar(Buff, SizeOf(Buff), 0);
repeat
Application.ProcessMessages;
Result:=Result + Buff;
FillChar(Buff, SizeOf(Buff), 0);
InternetReadFile(hRequest, @Buff, SizeOf(Buff), BytesRead);
until BytesRead = 0;
finally
InternetCloseHandle(hRequest);
end;
finally
InternetCloseHandle(hConnect);
end;
finally
InternetCloseHandle(hSession);
end;
end;
//下边这个函数针对有些网址,只能获取到一部分代码,获取不完全,不知道是什么原因
function GetPageContentAPI(const Url: string): string;
var
Session,
HttpFile:HINTERNET;
szSizeBuffer:Pointer;
dwLengthSizeBuffer:DWord;
dwReserved:DWord;
dwFileSize:DWord;
dwBytesRead:DWord;
Contents:PChar;
begin
Session:=InternetOpen('',0,niL,niL,0);
HttpFile:=InternetOpenUrl(Session,PChar(Url),niL,0,0,0);
dwLengthSizeBuffer:=1024;
HttpQueryInfo(HttpFile,5,szSizeBuffer,dwLengthSizeBuffer,dwReserved);
GetMem(Contents,dwFileSize);
InternetReadFile(HttpFile,Contents,dwFileSize,dwBytesRead);
InternetCloseHandle(HttpFile);
InternetCloseHandle(Session);
Result:=StrPas(Contents);
FreeMem(Contents);
end;