ActiveX控件下载到客户端后怎么去服务器上下载控件所需的文件呢?(100分)

  • 主题发起人 主题发起人 guofengdelphi
  • 开始时间 开始时间
G

guofengdelphi

Unregistered / Unconfirmed
GUEST, unregistred user!
控件下载到用户浏览器后,怎么在运行中去服务器上下载所需的文件呢?

请高手指教。。。。。
 
怎么没人遇到过这类问题么/
 
用IDHTTP的get函数去取
 
winnet 组件比idhttp 更加简单!这个DEMO文件有3个下载例子,有进程状态条!

unit Unit1;

interface

uses
Windows, SysUtils, Classes, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, HTTPGet;

type
TForm1 = class(TForm)
ProgressBar: TProgressBar;
Panel1: TPanel;
Image: TImage;
HTTPGetPicture: THTTPGet;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label3: TLabel;
Bevel1: TBevel;
GroupBox1: TGroupBox;
URLEdit: TEdit;
Label2: TLabel;
Label4: TLabel;
FileNameEdit: TEdit;
Button3: TButton;
HTTPGetString: THTTPGet;
HTTPGetFile: THTTPGet;
UseCacheBox: TCheckBox;
procedure HTTPGetPictureDoneFile(Sender: TObject;
FileName: String;
FileSize: Integer);
procedure HTTPGetPictureError(Sender: TObject);
procedure HTTPGetPictureProgress(Sender: TObject;
TotalSize, Readed: Integer);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure HTTPGetStringDoneString(Sender: TObject;
Result: String);
procedure Button3Click(Sender: TObject);
procedure HTTPGetFileDoneFile(Sender: TObject;
FileName: String;
FileSize: Integer);
procedure UseCacheBoxClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.HTTPGetPictureDoneFile(Sender: TObject;
FileName: String;
FileSize: Integer);
begin

Image.Picture.LoadFromFile(FileName);
ProgressBar.Position := 0;
end;


procedure TForm1.HTTPGetPictureError(Sender: TObject);
begin

ShowMessage('Error');
end;


procedure TForm1.HTTPGetPictureProgress(Sender: TObject;
TotalSize,
Readed: Integer);
begin

ProgressBar.Max := TotalSize;
ProgressBar.Position := Readed;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin

HTTPGetPicture.GetFile;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin

HTTPGetString.GetString;
end;


procedure TForm1.HTTPGetStringDoneString(Sender: TObject;
Result: String);
begin

ShowMessage(Result);
end;


procedure TForm1.Button3Click(Sender: TObject);
begin

HTTPGetFile.URL := URLEdit.Text;
HTTPGetFile.FileName := FileNameEdit.Text;
HTTPGetFile.GetFile;
end;


procedure TForm1.HTTPGetFileDoneFile(Sender: TObject;
FileName: String;
FileSize: Integer);
begin

ShowMessage('File stored to: ' + FileName + #13#10 +
'File size: ' + IntToStr(FileSize) + ' bytes');
end;


procedure TForm1.UseCacheBoxClick(Sender: TObject);
begin

HTTPGetFile.UseCache := UseCacheBox.Checked;
end;


end.
 
把这个winnet中的HTTP单元送上,请自己安装组件

unit HTTPGet;

interface

uses
Windows, Messages, SysUtils, Classes, WinInet;

type
TOnProgressEvent = procedure(Sender: TObject;
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: Boolean;
FTFileSize: Integer;
FTToFile: 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: Boolean);
end;


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

FThread: THTTPGetThread;
FError: TNotifyEvent;
FResult: Boolean;

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 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 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: 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;
Resume;
end;


procedure THTTPGetThread.UpdateProgress;
begin

FTProgress(Self, FTFileSize, BytesReaded);
end;


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

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

procedure ReplaceChar(c1, c2: Char;
var St: String);
var
p: Integer;
begin

while Truedo

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);
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

try
ParseURL(FTURL, HostName, FileName);

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),
INTERNET_DEFAULT_HTTP_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

HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(FTPostQuery), Length(FTPostQuery));

if Terminated then

begin

CloseHandles;
FTResult := False;
Exit;
end;


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

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 Truedo

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);
FThread.OnTerminate := ThreadDone;
if FWaitThread then

while Assigned(FThread)do

while PeekMessage(Msg, 0, 0, 0, PM_REMOVE)do

begin

TranslateMessage(Msg);
DispatchMessage(Msg);
end;

end
end;


procedure THTTPGet.GetString;
var
Msg: TMsg;
begin

if not Assigned(FThread) then

begin

FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer,
FBinaryData, FUseCache, FProgress, False);
FThread.OnTerminate := ThreadDone;
if FWaitThread then

while PeekMessage(Msg, 0, 0, 0, PM_REMOVE)do

begin

TranslateMessage(Msg);
DispatchMessage(Msg);
end;

end
end;


procedure THTTPGet.Abort;
begin

if Assigned(FThread) then

begin

FThread.Terminate;
FThread.FTResult := False;
end;

end;


procedure THTTPGet.ThreadDone(Sender: TObject);
begin

FResult := FThread.FTResult;
if FResult then

if FThread.FTToFile then

if Assigned(FDoneFile) then
FDoneFile(Self, FThread.FTFileName, FThread.FTFileSize) else

else

if Assigned(FDoneString) then
FDoneString(Self, FThread.FTStringResult) else

else

if Assigned(FError) then
FError(Self);
FThread := nil;
end;


procedure Register;
begin

RegisterComponents('Httpget', [THTTPGet]);
end;


end.
 
[:D][8D][:(][:(!][^][?]
 
在WEB端制作 update.ini 文件,我建议文件名采用 程序名.txt文件,delphi文件格式,下完后,你做过createinstall的软件安装更新吧,学习一下就OK了!
 
答的对,也没有分,以后我再也不回答什么了!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
我说的是像用友cell报表组件那样,cell组件下载到客户端浏览器后,根据程序提供的文件参数,去下载相关的文件。
我现在做了个类似的activex组件,也需要程序提供参数文件,然后下载需要的配置文件,然后再读取配置文件信息,请问高手们怎么解决???


解决好后,高分奉送。
 
后退
顶部