张无忌,请帮忙!内存泄漏的问题(100分)

  • 主题发起人 主题发起人 study2003
  • 开始时间 开始时间
S

study2003

Unregistered / Unconfirmed
GUEST, unregistred user!
我用ics,indy获取网页源码时,发现内存泄漏。
无忌兄,可否帮忙一下,要多少分都可以。
我也用wininet写过,不过好像不行,
请问可否发个源码给我。感激不尽。

我写的wininet如下:
function GetWebPage(const Url: string):Ansistring;
const BufferSize = 1024;
var
hHttpSession, hReqUrl: HInternet;
Buffer: PChar;
NumRead, Index : DWord ;
Next : Boolean;
Content : Ansistring;
begin
NumRead := 0;
hHttpSession := InternetOpen ('MyHttp',INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
if hHttpSession <> nil then begin
hReqUrl := InternetOpenURL (hHttpSession, PChar(Url), nil, 0,0,0);
try
if hReqUrl <> nil then begin
Next := True ;
Content :='' ;
GetMem(Buffer,BufferSize);
Try
While Next do
begin
ZeroMemory(Buffer,BufferSize);
InternetReadFile (hReqUrl, Buffer, Sizeof(Buffer), NumRead);
if NumRead > 0 then
Content := Content + StrPas(Buffer)
else
Next := False;
end;

finally
FreeMem(Buffer,BufferSize);
end;
end;
finally
InternetCloseHandle(hReqUrl);
end;
end else begin
// Do Nothing
end;
finally
InternetCloseHandle (hHttpSession);
end;

Result:=Content;
end;
 
Memo1.Text := DownloadWithInet('http://www.delphibbs.com');
or
Memo1.Text := DownloadWithSocket('http://www.delphibbs.com');
两者各有利弊,自己选择.

uses WinSock, WinInet;

function 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,
INTERNET_FLAG_RAW_DATA, {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;
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/1.1' + CRLF +
'Pragma: no-cache' + CRLF +
'Cache-Control: no-cache' + CRLF +
SUserAgent + CRLF +
'Host: %s' + CRLF + CRLF;
SRequestDownFile =
'GET %s HTTP/1.1' + CRLF +
'Accept: */*' + CRLF +
SUserAgent + CRLF +
'RANGE: bytes=0-' + CRLF +
'Host: %s' + CRLF + 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;
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 ReceiveLine: 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 := ReceiveLine;
if (Data = '') or (Data = CRLF) then
break else
Add(Result, PChar(Data), Length(Data));
end;
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('主机没找到: %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 := ReceiveLine;
if Data = '' then break;
Add(Result, PChar(Data), Length(Data));
Application.ProcessMessages;
end;
finally
UnInitSocket;
end;
end;


 
谢谢爱元元的哥哥先,
我现在试一下有没有内存泄漏
 
后退
顶部