F
fdwangchao
Unregistered / Unconfirmed
GUEST, unregistred user!
各位:
现在我仿照TSocketTransport,扩展了TWebConnecting的属性和方法.每次当把ServerName和URL填入数据时,用WebConnecting请示连接服务器时,客户端死掉,没有响应,高手们帮我看看,谢谢...:
[red]Client:[/red]
TWebConnection = class(TStreamedConnection, ITransport)
private
................
//>------------------Expand--------------------------------
FInterceptor : IDataIntercept;
FInterceptGUID: string;
FCreateAttempted: Boolean;
function CheckInterceptor: Boolean;
procedure InterceptIncoming(const Data: IDataBlock);
procedure InterceptOutgoing(const Data: IDataBlock);
//<-------------------------------------------------------
protected
......
function Receive(WaitForInput: Boolean; Context: Integer;TimeOut:Integer=15): IDataBlock; stdcall;
function Send(const Data: IDataBlock): Integer; stdcall;
protected
......
public
......
constructor Create(AOwner: TComponent); override;
published
......
//>------------------Expand--------------------------------
property InterceptGUID: string read FInterceptGUID write FInterceptGUID ;
//<-------------------------------------------------------
end;
constructor TWebConnection.Create(AOwner: TComponent);
begin
......
FInterceptGUID := 'GUID'; //* Intercept Guid
......
end;
function TWebConnection.Send(const Data: IDataBlock): Integer;
var
Request: HINTERNET;
RetVal, Flags: DWord;
P: Pointer;
AcceptTypes: array of PChar;
begin
SetLength(AcceptTypes, 2);
AcceptTypes[0] := PChar('application/octet-stream');
AcceptTypes[1] := nil;
Flags := INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_NO_CACHE_WRITE;
if FURLScheme = INTERNET_SCHEME_HTTPS then
Flags := Flags or INTERNET_FLAG_SECURE;
Request := HttpOpenRequest(FInetConnect, 'POST', PChar(FURLSite), nil,
nil, Pointer(AcceptTypes), Flags, Integer(Self));
Check(not Assigned(Request));
//>------------------Expand--------------------------------
InterceptOutgoing(Data); //* Encrypt DataStream Send To WebServer
//<-------------------------------------------------------
while True do
begin
Check(not HttpSendRequest(Request, nil, 0, Data.Memory, Data.Size + Data.BytesReserved));
RetVal := InternetErrorDlg(GetDesktopWindow(), Request, GetLastError,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);
case RetVal of
ERROR_SUCCESS: break;
ERROR_CANCELLED: SysUtils.Abort;
ERROR_INTERNET_FORCE_RETRY: {Retry the operation};
end;
end;
Result := Integer(Request)
end;
function TWebConnection.Receive(WaitForInput: Boolean; Context: Integer;TimeOut:Integer=15): IDataBlock;
var
Size, Downloaded, Status, Len, Index: DWord;
S: string;
begin
Len := SizeOf(Status);
Index := 0;
if HttpQueryInfo(Pointer(Context), HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
@Status, Len, Index) and (Status >= 300) then
begin
Index := 0;
SetLength(S, Size);
if HttpQueryInfo(Pointer(Context), HTTP_QUERY_STATUS_TEXT, @S[1], Size, Index) then
begin
SetLength(S, Size);
raise Exception.CreateFmt('%s (%d)', [S, Status]);
end;
end;
Len := 0;
repeat
Check(not InternetQueryDataAvailable(Pointer(Context), Size, 0, 0));
if Size > 0 then
begin
SetLength(S, Size);
Check(not InternetReadFile(Pointer(Context), @S[1], Size, Downloaded));
if not Assigned(Result) then
begin
Result := TDataBlock.Create;
Len := Result.InitData(@S[1], Downloaded, False);
end else
Result.Write(S[1], Downloaded);
end;
until Size = 0;
if Assigned(Result) and (Len <> DWord(Result.Size)) then
raise Exception.CreateRes(@SInvalidDataPacket);
//>------------------Expand--------------------------------
InterceptIncoming(Result); //* Decryption DataStream Receive From WebServer
//<-------------------------------------------------------
end;
[red]Server:[/red]
THTTPServer = class(TWebModule, ISendDataBlock)
procedure InterpreterAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
private
FInterpreter: TDataBlockInterpreter;
FData: IDataBlock;
//>------------------Expand--------------------------------
FInterceptor : IDataIntercept;
FInterceptGUID: string;
FCreateAttempted: Boolean;
function CheckInterceptor: Boolean;
procedure InterceptIncoming(const Data: IDataBlock);
procedure InterceptOutgoing(const Data: IDataBlock);
//<-------------------------------------------------------
protected
function Send(const Data: IDataBlock; WaitForResult: Boolean): IDataBlock; stdcall;
end;
procedure THTTPServer.InterpreterAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
DataBlock: IDataBlock;
S: string;
BytesRead, ChunkSize: Integer;
DataPacket: array of Byte;
begin
FData := nil;
if not Assigned(FInterpreter) then
FInterpreter := TPooledDataInterpreter.Create(Self, SWeb);
S := Request.Content;
BytesRead := Length(S);
DataBlock := TDataBlock.Create;
if BytesRead < Request.ContentLength then
begin
SetLength(DataPacket, Request.ContentLength);
Move(S[1], DataPacket[0], BytesRead);
repeat
ChunkSize := TISAPIRequest(Request).ReadClient(Pointer(@Datapacket[BytesRead])^, Request.ContentLength - BytesRead);
if ChunkSize > 0 then
begin
Inc(BytesRead, ChunkSize);
end;
until ChunkSize = -1;
DataBlock.InitData(@DataPacket[0], Request.ContentLength, True);
end else
DataBlock.InitData(@S[1], Request.ContentLength, True);
//>------------------Expand--------------------------------
InterceptIncoming(DataBlock); //* Entryption DataStream Receive From Client
//<-------------------------------------------------------
FInterpreter.InterpretData(DataBlock);
if Assigned(FData) then
begin
//>------------------Expand--------------------------------
InterceptOutgoing(FData); //* Entryption DataStream Send to Client
//<-------------------------------------------------------
Response.ContentStream := FData.Stream;
FData.IgnoreStream;
end;
end;
initialization
HTTPServer.FInterceptor := nil;
HTTPServer.FInterceptGUID := '{582A8699-4517-46D4-B69E-91CEB9568530}';
finalization
HTTPServer.FInterceptor := nil;
现在我仿照TSocketTransport,扩展了TWebConnecting的属性和方法.每次当把ServerName和URL填入数据时,用WebConnecting请示连接服务器时,客户端死掉,没有响应,高手们帮我看看,谢谢...:
[red]Client:[/red]
TWebConnection = class(TStreamedConnection, ITransport)
private
................
//>------------------Expand--------------------------------
FInterceptor : IDataIntercept;
FInterceptGUID: string;
FCreateAttempted: Boolean;
function CheckInterceptor: Boolean;
procedure InterceptIncoming(const Data: IDataBlock);
procedure InterceptOutgoing(const Data: IDataBlock);
//<-------------------------------------------------------
protected
......
function Receive(WaitForInput: Boolean; Context: Integer;TimeOut:Integer=15): IDataBlock; stdcall;
function Send(const Data: IDataBlock): Integer; stdcall;
protected
......
public
......
constructor Create(AOwner: TComponent); override;
published
......
//>------------------Expand--------------------------------
property InterceptGUID: string read FInterceptGUID write FInterceptGUID ;
//<-------------------------------------------------------
end;
constructor TWebConnection.Create(AOwner: TComponent);
begin
......
FInterceptGUID := 'GUID'; //* Intercept Guid
......
end;
function TWebConnection.Send(const Data: IDataBlock): Integer;
var
Request: HINTERNET;
RetVal, Flags: DWord;
P: Pointer;
AcceptTypes: array of PChar;
begin
SetLength(AcceptTypes, 2);
AcceptTypes[0] := PChar('application/octet-stream');
AcceptTypes[1] := nil;
Flags := INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_NO_CACHE_WRITE;
if FURLScheme = INTERNET_SCHEME_HTTPS then
Flags := Flags or INTERNET_FLAG_SECURE;
Request := HttpOpenRequest(FInetConnect, 'POST', PChar(FURLSite), nil,
nil, Pointer(AcceptTypes), Flags, Integer(Self));
Check(not Assigned(Request));
//>------------------Expand--------------------------------
InterceptOutgoing(Data); //* Encrypt DataStream Send To WebServer
//<-------------------------------------------------------
while True do
begin
Check(not HttpSendRequest(Request, nil, 0, Data.Memory, Data.Size + Data.BytesReserved));
RetVal := InternetErrorDlg(GetDesktopWindow(), Request, GetLastError,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);
case RetVal of
ERROR_SUCCESS: break;
ERROR_CANCELLED: SysUtils.Abort;
ERROR_INTERNET_FORCE_RETRY: {Retry the operation};
end;
end;
Result := Integer(Request)
end;
function TWebConnection.Receive(WaitForInput: Boolean; Context: Integer;TimeOut:Integer=15): IDataBlock;
var
Size, Downloaded, Status, Len, Index: DWord;
S: string;
begin
Len := SizeOf(Status);
Index := 0;
if HttpQueryInfo(Pointer(Context), HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
@Status, Len, Index) and (Status >= 300) then
begin
Index := 0;
SetLength(S, Size);
if HttpQueryInfo(Pointer(Context), HTTP_QUERY_STATUS_TEXT, @S[1], Size, Index) then
begin
SetLength(S, Size);
raise Exception.CreateFmt('%s (%d)', [S, Status]);
end;
end;
Len := 0;
repeat
Check(not InternetQueryDataAvailable(Pointer(Context), Size, 0, 0));
if Size > 0 then
begin
SetLength(S, Size);
Check(not InternetReadFile(Pointer(Context), @S[1], Size, Downloaded));
if not Assigned(Result) then
begin
Result := TDataBlock.Create;
Len := Result.InitData(@S[1], Downloaded, False);
end else
Result.Write(S[1], Downloaded);
end;
until Size = 0;
if Assigned(Result) and (Len <> DWord(Result.Size)) then
raise Exception.CreateRes(@SInvalidDataPacket);
//>------------------Expand--------------------------------
InterceptIncoming(Result); //* Decryption DataStream Receive From WebServer
//<-------------------------------------------------------
end;
[red]Server:[/red]
THTTPServer = class(TWebModule, ISendDataBlock)
procedure InterpreterAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
private
FInterpreter: TDataBlockInterpreter;
FData: IDataBlock;
//>------------------Expand--------------------------------
FInterceptor : IDataIntercept;
FInterceptGUID: string;
FCreateAttempted: Boolean;
function CheckInterceptor: Boolean;
procedure InterceptIncoming(const Data: IDataBlock);
procedure InterceptOutgoing(const Data: IDataBlock);
//<-------------------------------------------------------
protected
function Send(const Data: IDataBlock; WaitForResult: Boolean): IDataBlock; stdcall;
end;
procedure THTTPServer.InterpreterAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
DataBlock: IDataBlock;
S: string;
BytesRead, ChunkSize: Integer;
DataPacket: array of Byte;
begin
FData := nil;
if not Assigned(FInterpreter) then
FInterpreter := TPooledDataInterpreter.Create(Self, SWeb);
S := Request.Content;
BytesRead := Length(S);
DataBlock := TDataBlock.Create;
if BytesRead < Request.ContentLength then
begin
SetLength(DataPacket, Request.ContentLength);
Move(S[1], DataPacket[0], BytesRead);
repeat
ChunkSize := TISAPIRequest(Request).ReadClient(Pointer(@Datapacket[BytesRead])^, Request.ContentLength - BytesRead);
if ChunkSize > 0 then
begin
Inc(BytesRead, ChunkSize);
end;
until ChunkSize = -1;
DataBlock.InitData(@DataPacket[0], Request.ContentLength, True);
end else
DataBlock.InitData(@S[1], Request.ContentLength, True);
//>------------------Expand--------------------------------
InterceptIncoming(DataBlock); //* Entryption DataStream Receive From Client
//<-------------------------------------------------------
FInterpreter.InterpretData(DataBlock);
if Assigned(FData) then
begin
//>------------------Expand--------------------------------
InterceptOutgoing(FData); //* Entryption DataStream Send to Client
//<-------------------------------------------------------
Response.ContentStream := FData.Stream;
FData.IgnoreStream;
end;
end;
initialization
HTTPServer.FInterceptor := nil;
HTTPServer.FInterceptGUID := '{582A8699-4517-46D4-B69E-91CEB9568530}';
finalization
HTTPServer.FInterceptor := nil;