做过HTTP POST 方法的进来帮个忙啊，只有200分，立刻结账(200分)

  • 主题发起人 主题发起人 delphifan222222
  • 开始时间 开始时间
D

delphifan222222

Unregistered / Unconfirmed
GUEST, unregistred user!
一个表单有name 和 password 两个输入框，如何通过程序向服务器提交？
用什么控件？我用的是synapse
 
http://vcl.vclxx.org/DELPHI/D32FREE/HTTPGET.ZIP
源码，封装的wininet.dll，非常简单实用，虽然有一些小bug，不过可以自己动手修改。
 
楼上的大哥，POST内容怎么写？
 
如果你用delphi，你可以新建一个CGI，做法：
1. File->New->Other->WebServerApplication->ISAPI/NSAPI...->OK
2. 加入一个Action
3. 在新的Action事件OnAction中写代码。
procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
strName,strPass:string;
begin
strName:=Request.GetFieldByName('Name');
strPass:=Request.GetFieldByName('Password');
...
...
Response.Content:='<html><body>Your Name:'+strName+'<br>Your Pass:'+strPass+'</body></html>';
end;

4. POST
http://192.168.0.5/cgi_bin/MyCGIXXX.dll/actionXXX?Name=XXX;Pass=XXX

是不是应该把分给我呢？
 
错了，
我是用DELPHI提交一个表单，不用IE，用程序，不是建立一个CGI：）
而是向CGI提交数据用POST方法
不过还是谢谢你
 
PostStr := 'name=' + URLEncode(Name) + '&password=' + URLEncode(Password)
GetUrl(Url, PostStr);

//如下是我用的函数
function GetUrl(url:string; post:string=''):string;
var
mHttpGet:THTTPGet;
begin
mHttpGet:=THTTPGet.Create(application);
mHttpGet.URL:=URL;
mHttpGet.Agent:='';
mHttpGet.PostQuery:=post;
mHttpGet.WaitThread:=true;
mHttpGet.GetString;
result:=mHttpGet.StringResult;
mHttpGet.Free;
end;

function URLEncode(const msg : String) : String;
var
I : Integer;
begin
Result := '';
for I := 1 to Length(msg) do begin
if msg = ' ' then
Result := Result + '+'
else if msg in ['a'..'z', 'A'..'Z', '0'..'9'] then
Result := Result + msg
else
Result := Result + '%' + IntToHex(ord(msg), 2);
end;
end;
 
对了，哪个东东我改过，都贴上来吧

{*************************************************************}
{ HTTPGet component for Delphi 32 }
{ Version: 1.94 }
{ E-Mail: info@utilmind.com }
{ WWW: http://www.utilmind.com }
{ Created: October 19, 1999 }
{ Modified: June 6, 2000 }
{ Legal: Copyright (c) 1999-2000, UtilMind Solutions }
{*************************************************************}
{ PROPERTIES: }
{ Agent: String - User Agent }
{ }
{* BinaryData: Boolean - This setting specifies which type }
{* of data will taken from the web. }
{* If you set this property TRUE then }
{* component will determinee the size }
{* of files *before* getting them from }
{* the web. }
{* If this property is FALSE then as we}
{* do not knows the file size the }
{* OnProgress event will doesn't work. }
{* Also please remember that is you set}
{* this property as TRUE you will not }
{* capable to get from the web ASCII }
{* data and ofter got OnError event. }
{ }
{ FileName: String - Path to local file to store the data }
{ taken from the web }
{ Password, UserName - set this properties if you trying to }
{ get data from password protected }
{ directories. }
{ Referer: String - Additional data about referer document }
{ URL: String - The url to file or document }
{ UseCache: Boolean - Get file from the Internet Explorer's }
{ cache if requested file is cached. }
{*************************************************************}
{ METHODS: }
{ GetFile - Get the file from the web specified in the URL }
{ property and store it to the file specified in }
{ the FileName property }
{ GetString - Get the data from web and return it as usual }
{ String. You can receive this string hooking }
{ the OnDoneString event. }
{ Abort - Stop the current session }
{*************************************************************}
{ EVENTS: }
{ OnDoneFile - Occurs when the file is downloaded }
{ OnDoneString - Occurs when the string is received }
{ OnError - Occurs when error happend }
{ OnProgress - Occurs at the receiving of the BINARY DATA }
{*************************************************************}
{ Please see demo program for more information. }
{*************************************************************}
{ IMPORTANT NOTE: }
{ This software is provided 'as-is', without any express or }
{ implied warranty. In no event will the author be held }
{ liable for any damages arising from the use of this }
{ software. }
{ Permission is granted to anyone to use this software for }
{ any purpose, including commercial applications, and to }
{ alter it and redistribute it freely, subject to the }
{ following restrictions: }
{ 1. The origin of this software must not be misrepresented, }
{ you must not claim that you wrote the original software. }
{ If you use this software in a product, an acknowledgment }
{ in the product documentation would be appreciated but is }
{ not required. }
{ 2. Altered source versions must be plainly marked as such, }
{ and must not be misrepresented as being the original }
{ software. }
{ 3. This notice may not be removed or altered from any }
{ source distribution. }
{*************************************************************}

unit HTTPGet;

interface

uses
Windows, Messages, SysUtils, Classes, WinInet;

type
TOnProgressEvent = procedure(Sender: TObject; FisDown:boolean; TotalSize, Readed: Integer) of object;
TOnDoneFileEvent = procedure(Sender: TObject; FileName: String; FileSize: Integer) of object;
TOnDoneStringEvent = procedure(Sender: TObject; Result: String) of object;

THTTPGetThread = class(TThread)
private
FTAcceptTypes,
FTAgent,
FTURL,
FTFileName,
FTStringResult,
FTUserName,
FTPassword,
FTPostQuery,
FTReferer: String;
FTBinaryData,
FTUseCache: Boolean;

FTResult,FisDown: Boolean;
FTFileSize: Integer;
FTToFile: Boolean;
FTFromFile: Boolean;

BytesToRead, BytesReaded: DWord;

FTProgress: TOnProgressEvent;

procedure UpdateProgress;
protected
procedure Execute; override;
public
constructor Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile, aFromFile: Boolean);
end;

THTTPGet = class(TComponent)
private
FAcceptTypes: String;
FAgent: String;
FBinaryData: Boolean;
FURL: String;
FUseCache: Boolean;
FFromFile: Boolean;
FFileName: String;
FUserName: String;
FPassword: String;
FPostQuery: String;
FReferer: String;
FStringResult: string;
FWaitThread: Boolean;

FThread: THTTPGetThread;
FError: TNotifyEvent;
FResult: integer;

FProgress: TOnProgressEvent;
FDoneFile: TOnDoneFileEvent;
FDoneString: TOnDoneStringEvent;

procedure ThreadDone(Sender: TObject);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;

procedure GetFile;
procedure GetString;
procedure Abort;
published
property AcceptTypes: String read FAcceptTypes write FAcceptTypes;
property Agent: String read FAgent write FAgent;
property BinaryData: Boolean read FBinaryData write FBinaryData;
property URL: String read FURL write FURL;
property UseCache: Boolean read FUseCache write FUseCache;
property FromFile: Boolean read FFromFile write FFromFile;
property FileName: String read FFileName write FFileName;
property UserName: String read FUserName write FUserName;
property Password: String read FPassword write FPassword;
property PostQuery: String read FPostQuery write FPostQuery;
property Referer: String read FReferer write FReferer;
property WaitThread: Boolean read FWaitThread write FWaitThread;
property StringResult: string read FStringResult;
property Result: integer read FResult;

property OnProgress: TOnProgressEvent read FProgress write FProgress;
property OnDoneFile: TOnDoneFileEvent read FDoneFile write FDoneFile;
property OnDoneString: TOnDoneStringEvent read FDoneString write FDoneString;
property OnError: TNotifyEvent read FError write FError;
end;

procedure Register;

implementation

// THTTPGetThread

constructor THTTPGetThread.Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile, aFromFile: Boolean);
begin
FreeOnTerminate := True;
inherited Create(True);

FTAcceptTypes := aAcceptTypes;
FTAgent := aAgent;
FTURL := aURL;
FTFileName := aFileName;
FTUserName := aUserName;
FTPassword := aPassword;
FTPostQuery := aPostQuery;
FTReferer := aReferer;
FTProgress := aProgress;
FTBinaryData := aBinaryData;
FTUseCache := aUseCache;

FTToFile := aToFile;
FTFromFile := aFromFile;
Resume;
end;

procedure THTTPGetThread.UpdateProgress;
begin
FTProgress(Self, FisDown , FTFileSize, BytesReaded);
end;

procedure THTTPGetThread.Execute;
var
hSession, hConnect, hRequest: hInternet;
HostName, FileName: String;
Port: integer;
f: File;
f2: TFileStream;
Buf: Pointer;
BufferIn: INTERNET_BUFFERS;
dwBufLen, dwIndex: DWord;
Data: Array[0..$FFFF] of Char;
TempStr: String;
RequestMethod: PChar;
InternetFlag: DWord;
AcceptType: LPStr;

procedure ParseURL(URL: String; var HostName, FileName: String; var Port:integer);

procedure ReplaceChar(c1, c2: Char; var St: String);
var
p: Integer;
begin
while True do
begin
p := Pos(c1, St);
if p = 0 then Break
else St[p] := c2;
end;
end;

var
i: Integer;
begin
if Pos('http://', LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7);

i := Pos('/', URL);
if i=0 then i:=length(URL)-1;
HostName := Copy(URL, 1, i - 1);
FileName := Copy(URL, i, Length(URL) - i + 1);
i := Pos(':', HostName);
Port:=80;
if i>0 then
begin
Port := StrToIntDef(Copy(HostName, i+1, Length(HostName) - i),80);
HostName := Copy(HostName, 1, i - 1);
end;
if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1);
end;

procedure CloseHandles;
begin
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;

begin
try
ParseURL(FTURL, HostName, FileName, Port);

if Terminated then
begin
FTResult := False;
Exit;
end;

if FTAgent <> '' then
hSession := InternetOpen(PChar(FTAgent),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
else
hSession := InternetOpen(nil,
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

hConnect := InternetConnect(hSession, PChar(HostName),
Port, PChar(FTUserName), PChar(FTPassword), INTERNET_SERVICE_HTTP, 0, 0);

if FTPostQuery = '' then RequestMethod := 'GET'
else RequestMethod := 'POST';

if FTUseCache then InternetFlag := 0
else InternetFlag := INTERNET_FLAG_RELOAD;

AcceptType := PChar('Accept: ' + FTAcceptTypes);
hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',
PChar(FTReferer), @AcceptType, InternetFlag, 0);


if FTPostQuery = '' then
HttpSendRequest(hRequest, nil, 0, nil, 0)
else
begin
if FTFromFile then
begin
FisDown:=False;
BufferIn.Next:=0;
BufferIn.lpcszHeader:=0;
BufferIn.dwHeadersLength:=0;
BufferIn.dwHeadersTotal:=0;
BufferIn.lpvBuffer:=0;
BufferIn.dwBufferLength:=0;
BufferIn.dwOffsetLow:=0;
BufferIn.dwOffsetHigh:=0;
BufferIn.dwStructSize:=sizeof(INTERNET_BUFFERS);
//AssignFile(f2, FTPostQuery);
//Reset(f2,1);
f2:=TFileStream.Create(FTPostQuery,fmOpenRead+fmShareDenyNone);
BufferIn.dwBufferTotal:=f2.Size;
FTFileSize:=BufferIn.dwBufferTotal;
dwIndex:=0;
BytesReaded:=0;
if HttpSendRequestEx(hRequest, @BufferIn, 0, 0, 0) then
repeat
//BlockRead(f2, Data, SizeOf(Data), BytesToRead);
BytesToRead:=f2.Read(Data,SizeOf(Data));
if not InternetWriteFile(hRequest, @Data, BytesToRead, BytesToRead) then Break;
dwIndex:=dwIndex+BytesToRead;
inc(BytesReaded, BytesToRead);
if Assigned(FTProgress) then
Synchronize(UpdateProgress);
until (BytesToRead <> SizeOf(Data)) ;
HttpEndRequest(hRequest, 0, 0, 0);
f2.Destroy;
end
else
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(FTPostQuery), Length(FTPostQuery));
end;
if Terminated then
begin
CloseHandles;
FTResult := False;
Exit;
end;

dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);

FisDown:=True;

FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,
Buf, dwBufLen, dwIndex);

if Terminated then
begin
FreeMem(Buf);
CloseHandles;
FTResult := False;
Exit;
end;

if FTResult or not FTBinaryData then
begin
if FTResult then
FTFileSize := StrToInt(StrPas(Buf));

BytesReaded := 0;

if FTToFile then
begin
AssignFile(f, FTFileName);
Rewrite(f, 1);
end
else FTStringResult := '';

while True do
begin
if Terminated then
begin
if FTToFile then CloseFile(f);
FreeMem(Buf);
CloseHandles;

FTResult := False;
Exit;
end;

if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break
else
if BytesToRead = 0 then Break
else
begin
if FTToFile then
BlockWrite(f, Data, BytesToRead)
else
begin
TempStr := Data;
SetLength(TempStr, BytesToRead);
FTStringResult := FTStringResult + TempStr;
end;

inc(BytesReaded, BytesToRead);
if Assigned(FTProgress) then
Synchronize(UpdateProgress);
end;
end;

if FTToFile then
FTResult := FTFileSize = Integer(BytesReaded)
else
begin
SetLength(FTStringResult, BytesReaded);
FTResult := BytesReaded <> 0;
end;

if FTToFile then CloseFile(f);
end;

FreeMem(Buf);

CloseHandles;
except
end;
end;

// HTTPGet

constructor THTTPGet.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FAcceptTypes := '*/*';
FAgent := 'UtilMind HTTPGet';
end;

destructor THTTPGet.Destroy;
begin
Abort;
inherited Destroy;
end;

procedure THTTPGet.GetFile;
var
Msg: TMsg;
begin
if not Assigned(FThread) then
begin
FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer,
FBinaryData, FUseCache, FProgress, True, FFromFile);
FThread.OnTerminate := ThreadDone;
if FWaitThread then
while Assigned(FThread) do
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
Sleep(20);
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
end;

procedure THTTPGet.GetString;
var
Msg: TMsg;
begin
FStringResult:='';
if not Assigned(FThread) then
begin
FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer,
FBinaryData, FUseCache, FProgress, False, FFromFile);
FThread.OnTerminate := ThreadDone;
if FWaitThread then
while Assigned(FThread) do
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
Sleep(20);
if FThread=nil then break;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
{ if FWaitThread then
WaitForSingleObject(FThread.Handle,6000);
{while WaitForSingleObject(FThread.Handle,20)<> WAIT_ABANDONED do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) or (FThread<>nil) do
begin
if (FThread<>nil) then if FThread.Terminated then break;
Sleep(20);
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end }
end;

procedure THTTPGet.Abort;
begin
if Assigned(FThread) then
begin
FThread.Terminate;
FThread.FTResult := False;
FResult:= -1;
end;
end;

procedure THTTPGet.ThreadDone(Sender: TObject);
begin
if FThread.FTResult then FResult:=1 else FResult:=0;
if FResult=1 then
if FThread.FTToFile then
if Assigned(FDoneFile) then FDoneFile(Self, FThread.FTFileName, FThread.FTFileSize) else
else
begin
FStringResult:=FThread.FTStringResult;
if Assigned(FDoneString) then FDoneString(Self, FThread.FTStringResult) else
end
else
if Assigned(FError) then FError(Self);
FThread := nil;
end;

procedure Register;
begin
RegisterComponents('UtilMind', [THTTPGet]);
end;

end.
 
httpget不能安装？
[Fatal Error] HTTPGet.pas(1): Program or unit 'HTTPGet.pas' recursively uses itself
 
再帮忙看看吧：）谢谢啦
 
procedure TForm1.Button1Click(Sender: TObject);
begin
shellExecute(0,nil,'http://192.168.0.30/abc.asp?name=abc,password=abc',nil,nil,SW_HIDE);
end;

调用前加载shellapi
 
不是啊，我要返回数据，我还要处理一下啦
 
用WebBrowse跟登录奇兵一样，查一下以前的资料吧！
 
不会吧？D5,D6,D7都能装呀。
你先把我后来给你的那个替换了原来的'HTTPGet.pas'
到菜单
1、component-> Install Component..
2、选择HTTPGet.pas
3、OK
是这样吧

其实你放到工程里直接use也可以。
不知道你为什么会出现循环引用的问题
 
我再看看：）
 
我以前用过 ICS,INDY,HTTPGET，以及用 WebBrowser 模拟的。。。
现在用自己做的，最简洁，一个函数，不用装控件~~：
绝对好用

uses
WinInet;
//***********[ THttpRequest.Execute ]于2001-7-16创建***************************
function HttpRequestExecute(const URL, QureyData: string): string;
var
hSession, hConnect, hRequest: hInternet;
RequestMethod, TempStr, HostName, FileName: string;
BytesToRead : cardinal;
DataLength : integer;
AData : array[0..40960] of char;
InternetFlag : LongWord;
AcceptType : PAnsiChar;
Buf : array[0..1023] of char;
dwBufLen, dwIndex: LongWord;
procedure ParseURL(URL: string; var HostName, FileName: string);
var
i : Integer;
begin
if Pos('http://', URL) <> 0 then
System.Delete(URL, 1, 7);

i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL) - i + 1);

if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1);
end;
procedure CloseHandles;
begin
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;

begin
result := '';
ParseURL(URL, HostName, FileName);
hSession := InternetOpen(PChar(''),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
hConnect := InternetConnect(hSession, PChar(HostName),
INTERNET_DEFAULT_HTTP_PORT, '', '', INTERNET_SERVICE_HTTP, 0, 0);

if QureyData = '' then RequestMethod := 'GET'
else RequestMethod := 'POST';

InternetFlag := 0;

AcceptType := PChar('Accept: */*');
hRequest := HttpOpenRequest(hConnect, PChar(RequestMethod), PChar(FileName), 'HTTP/1.0',
'', @AcceptType, InternetFlag, 0);

if QureyData = '' then
HttpSendRequest(hRequest, nil, 0, nil, 0)
else
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(QureyData), Length(QureyData));
BytesToRead := 0;

dwIndex := 0;
dwBufLen := sizeof(Buf);
HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH, @Buf, dwBufLen, dwIndex);
DataLength := StrToIntDef(Buf, 0);
while InternetReadFile(hRequest, @AData, SizeOf(AData), BytesToRead) do
begin
if BytesToRead = 0 then break;
SetString(TempStr, AData, BytesToRead);
Result := Result + TempStr;
end;
CloseHandles;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( HttpRequestExecute('http://www.sina.com.cn/','')); //注意后面必须加'/'
ShowMessage( HttpRequestExecute('http://www.yourserver.com/','name=sa'#13#10'password=123456'#13#10));
end;
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

Ray
[转]终于可以发布Delphi下收点OSGI精髓皮毛而设计的插件框架WisdomPluginFramework
回复
4
查看
4K
chlkuei
C
腾
请问用IDHTTP，发送一个POST的方法，另如何用SOCKET的连接方式使用HTTP方式访问服务器(300分)
回复
7
查看
136
腾龙
腾
G
对SMTP邮件认证有经验的朋友请进来。。(100分)
回复
0
查看
134
ghyghost888
G
一
做过UDP收发的朋友请进来，一个不需要思考的问题！ (100分)
回复
18
查看
270
zhgnet
Z
T
有一个DELPHI访问网址的问题!(100分)
回复
4
查看
108
ttkk
T
后退
顶部