Error al agregar el componente HTTPGet en Delphi 2009, ayuda por favor

[Black_Ocean]

Hola estimados de ClubDelphi,

Tengo un problema al agregar el componente HTTPGet en el nuevo CodeGear Delphi 2009 (trial), al compilarlo en el paquete me genera conflictos de tipos ambiguos. Al parecer, es por la nueva implementación de unicode completo introducido en Delphi 2009, ya que estuve echándole un vistazo a varias funciones existentes en las librerías comunes de Delphi 2009 y han sido modificadas para que soporten unicode (como por ejemplo, el nuevo tipo UnicodeString, ya no se debe ocupar WideString por lo que lei en la ayuda, sólo UnicodeString desde ahora). En versiones anteriores de Delphi no hay ningún problema con este componente.

Estos son los mensajes que me arroja el compilador:

[DCC Error] HTTPGet.pas(273): E2010 Incompatible types: 'Char' and 'AnsiChar'
[DCC Error] HTTPGet.pas(308): E2251 Ambiguous overloaded call to 'StrPas'
SysUtils.pas(8475): Related method: function StrPas(const PAnsiChar): AnsiString;
SysUtils.pas(8480): Related method: function StrPas(const PWideChar): string;
[DCC Warning] HTTPGet.pas(308): W1057 Implicit string cast from 'AnsiString' to 'string'
[DCC Fatal Error] dclusr.dpk(37): F2063 Could not compile used unit '..\..\..\..\Mis componentes de Delphi 2009\HTTPGet\HTTPGet.pas'

Si es que me pueden echar una manito, les agradecería mucho.

Adjunto les dejo el componente original descargado de Torry.NET, lo uso mucho para mis proyectos desde hace años y se trata de una unidad .pas que contiene la clase y funciones, es pequeño.

Saludos cordiales.

[xEsk]

Los errores ya te indican que hay que cambiar... personalmente, me parece un autentico engorro esto del D2009! En proyectos un poco grandes hay que cambiar muchas cosas xD Cierto es, que siempre es el mismo error, es muy molesto!

Los cambios realizados son estos: AcceptType := PAnsiChar(PChar('Accept: ' + FTAcceptTypes));
FTFileSize := StrToInt(String(StrPas(PAnsiChar(Buf))));

Te adjunto el .pas modificado.

No lo he probado, espero que te funcione! :)

[Black_Ocean]

Hola xEsk,

Gracias por ayudarme.

El componente que has modificado compila bien en el paquete, pero al usar el componente en mis proyectos, en tiempo de ejecución me sale este error en Delphi:

Project Project1.exe raised exception class EAccessViolation with message ('Access Violation at address 7C80A260 in module 'kernel.dll'. Read of address 00000008'.

y me dice que en el .pas del componente en esta instrucción está el error o conflicto:

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

Podrías ayudarme a solucionar este problema? o quién desee aportar es bienvenido:

Este es el código completo del componente en el .pas:

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 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);
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 := PAnsiChar(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(String(StrPas(PAnsiChar(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);
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('UtilMind', [THTTPGet]);
end;

end.

Muchas gracias por sus molestias queridos amigos de ClubDelphi ;)

Saludos cordiales.