Форум: "Сети";
Текущий архив: 2009.04.19;
Скачать: [xml.tar.bz2];

Вниз

Вопрос про испорченую кодировку при скачивании файла по Http   Найти похожие ветки 

← →
dreamse   (2008-02-06 15:43) [0]

Приветствую.
Появилась проблема с русскими файлами скачаными по Http. Например файлик Readme.txt в котором описание идет по русски, после скачивания кодировка слетает. т.е отображаются крякозябли ( текст на английском при этом не страдает )

Если наименование файла по русски соответствено кодировка опять таки слетает. И становиться невозможным скачивать не TXT не *.chm файлы :( Кто сталкивался подскажите в чем проблема и как исправить ?!

Для скачивания использую компонент : HTTPGet
http://www.utilmind.com

---

← →
dreamse   (2008-02-06 15:44) [1]

Структура файлика


//  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 := 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 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 Assigned(FThread) do
     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;


---

← →
Anatoly Podgoretsky ©   (2008-02-06 16:21) [2]

> dreamse  (06.02.2008 15:43:00)  [0]

Кривой компонент, кривой хостинг.
У TXT нет кодировок!

---

← →
dreamse   (2008-02-06 16:39) [3]

Если при этом сменить расширение с txt на например DLL , потом скачать и переименовать заново в TXT то текст читается нормально. Это же и с *.chm файлами

> Anatoly Podgoretsky ©   (06.02.08 16:21) [2]

На счет хостинга не согласен. Так как проверялось на 3-х разных хостингах

Если открыть скачанный файл Wordom то он показывает окошко в котором предлагает выбрать кодировку KOI8-R для правильного отображения текста.

Куда копать ?

---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2009.04.19;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.075 c