大家能不能给分析一下这段代码，为什么我上传文件流到某一页面地址，那个页面收不到呀！急！在线等待，非常感谢！ 大家给帮帮忙，谢谢了！！ ( 积分: 200 )

各位大侠帮忙分析分析，在此多谢了，我在线等待！
再有这种方式对网络条件要求高不高，比如对NTLM 身份认证、SSL的支持等
function HttpPutFile(url, fn: string): Boolean;
var
buf: array[0..32768 - 1] of char;
bufsize: dword;
lf: file;
FUrl, fsrvr: string;
fsize, totsize: int64;
NetHandle: hinternet;

hconnect: hinternet;
hintfile: hinternet;
lpdword: Dword;
bufferin: INTERNET_BUFFERS;
// ErrCode: Integer;
wsize: int64;
NowP, i: integer;

function ExtractServer(url: string): string;
begin
if Pos('://', UpperCase(url)) > 0 then
Delete(url, 1, Pos('://', url) + 2);
if Pos('@', UpperCase(url)) > 0 then
Delete(url, 1, Pos('@', url) + 1);
if Pos('/', url) > 0 then
url := Copy(url, 1, Pos('/', url) - 1);

Result := url;
end;

function RemoveServer(url: string): string;
begin
if Pos('://', UpperCase(url)) > 0 then
Delete(url, 1, Pos('://', url) + 2);
if Pos('@', UpperCase(url)) > 0 then
Delete(url, 1, Pos('@', url) + 1);
if Pos('/', url) > 0 then
Delete(url, 1, Pos('/', url) - 1);

Result := url;
end;
begin
Result := False;
FUrl := url;

if not FileExists(fn) then
Exit;

fsrvr := ExtractServer(url);
url := RemoveServer(url);

NetHandle := InternetOpen('htmlcopy for hfg', INTERNET_OPEN_TYPE_PRECONFIG {or INTERNET_FLAG_ASYNC}, nil, nil, 0);
if assigned(NetHandle) then
begin
hconnect := InternetConnect(NetHandle, PChar(fsrvr), INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);

hintfile := HttpOpenRequest(HConnect, 'POST', PChar(url), nil, nil, nil, INTERNET_FLAG_NO_CACHE_WRITE, 0);

if hintfile = nil then
begin
Exit;
end;

if hintfile <> nil then
begin
AssignFile(lf, fn);
Reset(lf, 1);
TotSize := FileSize(lf);

bufsize := 32768;
FSize := 0;
FillChar(bufferin, SizeOf(bufferin), 0);
bufferin.dwStructSize := SizeOf(INTERNET_BUFFERS);
bufferin.dwBufferTotal := TotSize;

if HttpSendRequestEx(hintfile, @bufferin, nil, HSR_INITIATE, 0) then
begin
while (bufsize = 32768) do
begin
BlockRead(lf, buf, 32768, bufsize);

if not InternetWriteFile(hintfile, @buf, bufsize, lpdword) then
begin
CloseFile(lf);

InternetCloseHandle(hintfile);
InternetCloseHandle(hconnect);
InternetCloseHandle(NetHandle);
//hintProgress('', 0);
exit;
end;

wsize := wsize + lpdword;
FSize := FSize + bufsize;

if lpdword > 0 then
begin
NowP := Round(100 * FSize / totsize);
if NowP <> i then
begin
showmessage('上传文件成功');
i := NowP;
Application.ProcessMessages;
end;
end;
end;
HttpEndRequest(hintfile, nil, 0, 0);
end;

CloseFile(lf);

InternetCloseHandle(hintfile);
InternetCloseHandle(hconnect);
Result := FSize = TotSize;
end;

InternetCloseHandle(NetHandle);
//hintProgress('', 0);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
HttpPutFile('http://localhost/e.txt', Edit3.Text);
end;

各位大侠帮忙分析分析，在此多谢了，我在线等待！
再有这种方式对网络条件要求高不高，比如对NTLM 身份认证、SSL的支持等
function HttpPutFile(url, fn: string): Boolean;
var
buf: array[0..32768 - 1] of char;
bufsize: dword;
lf: file;
FUrl, fsrvr: string;
fsize, totsize: int64;
NetHandle: hinternet;

hconnect: hinternet;
hintfile: hinternet;
lpdword: Dword;
bufferin: INTERNET_BUFFERS;
// ErrCode: Integer;
wsize: int64;
NowP, i: integer;

function ExtractServer(url: string): string;
begin
if Pos('://', UpperCase(url)) > 0 then
Delete(url, 1, Pos('://', url) + 2);
if Pos('@', UpperCase(url)) > 0 then
Delete(url, 1, Pos('@', url) + 1);
if Pos('/', url) > 0 then
url := Copy(url, 1, Pos('/', url) - 1);

Result := url;
end;

function RemoveServer(url: string): string;
begin
if Pos('://', UpperCase(url)) > 0 then
Delete(url, 1, Pos('://', url) + 2);
if Pos('@', UpperCase(url)) > 0 then
Delete(url, 1, Pos('@', url) + 1);
if Pos('/', url) > 0 then
Delete(url, 1, Pos('/', url) - 1);

Result := url;
end;
begin
Result := False;
FUrl := url;

if not FileExists(fn) then
Exit;

fsrvr := ExtractServer(url);
url := RemoveServer(url);

NetHandle := InternetOpen('htmlcopy for hfg', INTERNET_OPEN_TYPE_PRECONFIG {or INTERNET_FLAG_ASYNC}, nil, nil, 0);
if assigned(NetHandle) then
begin
hconnect := InternetConnect(NetHandle, PChar(fsrvr), INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);

hintfile := HttpOpenRequest(HConnect, 'POST', PChar(url), nil, nil, nil, INTERNET_FLAG_NO_CACHE_WRITE, 0);

if hintfile = nil then
begin
Exit;
end;

if hintfile <> nil then
begin
AssignFile(lf, fn);
Reset(lf, 1);
TotSize := FileSize(lf);

bufsize := 32768;
FSize := 0;
FillChar(bufferin, SizeOf(bufferin), 0);
bufferin.dwStructSize := SizeOf(INTERNET_BUFFERS);
bufferin.dwBufferTotal := TotSize;

if HttpSendRequestEx(hintfile, @bufferin, nil, HSR_INITIATE, 0) then
begin
while (bufsize = 32768) do
begin
BlockRead(lf, buf, 32768, bufsize);

if not InternetWriteFile(hintfile, @buf, bufsize, lpdword) then
begin
CloseFile(lf);

InternetCloseHandle(hintfile);
InternetCloseHandle(hconnect);
InternetCloseHandle(NetHandle);
//hintProgress('', 0);
exit;
end;

wsize := wsize + lpdword;
FSize := FSize + bufsize;

if lpdword > 0 then
begin
NowP := Round(100 * FSize / totsize);
if NowP <> i then
begin
showmessage('上传文件成功');
i := NowP;
Application.ProcessMessages;
end;
end;
end;
HttpEndRequest(hintfile, nil, 0, 0);
end;

CloseFile(lf);

InternetCloseHandle(hintfile);
InternetCloseHandle(hconnect);
Result := FSize = TotSize;
end;

InternetCloseHandle(NetHandle);
//hintProgress('', 0);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
HttpPutFile('http://localhost/e.txt', Edit3.Text);
end;

好,帮顶



--------签名档---------------------------

比肩国内顶尖源码下载站点 -> 源码我爱你

http://www.source520.com
http://www.source520.net

80G源码电子书免费免注册下载,大量精辟技术文档库随时更新
******************************************************************
附:为了站点持续发展,现有本站近年来收藏的大量大型商业源码低价出售,
详情请进入以下链接查看:
http://www.source520.com/building_delphi.htm

浏览商业代码请从如下URL进入查看实物:
1.商业源码库1: ftp://source520see3:browse@61.152.199.245/
2.商业源码库2: ftp://source520see2:browse@61.152.199.245/

做客户端接收程序试一下

谢谢！