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

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:

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.

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:

Código Delphi [-]
AcceptType := PAnsiChar(PChar('Accept: ' + FTAcceptTypes));

Código Delphi [-]
FTFileSize := StrToInt(String(StrPas(PAnsiChar(Buf))));

Te adjunto el .pas modificado.

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

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:

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

Código Delphi [-]
    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:

Código Delphi [-]
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.