
http://zmiuko.ru
 
Профиль
Группа: Участник
Сообщений: 297
Регистрация: 8.10.2008
Репутация: нет Всего: 2
|
Доброго всем времени, уважаемые. У меня суть проблемы вот в чем. Накидал несложный код, ниже представленный: Код | unit Unit1;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, WinInet, IdURI, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtCtrls;
const AgentB = 'Opera/9.80 (Windows NT 6.1; U; ru) Presto/2.7.62 Version/11.00';
type TRecivByte = procedure(Progres,MaxSiz :Int64) of object;// закачка-прогресс TDownloadError = (deInternetOpen, deInternetOpenUrl, deDownloadingFile, deConnect, deRequest); TErrorEvent = procedure(Sender: TObject; E: TDownloadError) of object; //на случай ошибки
type TTextThreat = class(TThread) private FText :string; FUserAgent :string; FUrl :string; FMem :TMemoryStream; FPrgPos, FPrgMax :Int64; // позиция, максимум | прогресс закачки FOnProgres :TRecivByte; // прогресс закачки procedure Updateprogres; protected procedure Execute; override; public constructor Create(const ATerminateHandler: TNotifyEvent=nil; PauseThread :Boolean=True); destructor Destroy; // property UserAgent:string read FUserAgent write FUserAgent; property URL:string read FUrl write FUrl; property ResultText:string read FText; // принятый текст property OnProgress:TRecivByte read FOnProgres write FOnProgres; property Terminated; published end;
type TChkURLThreat = class(TThread) private FResult :Boolean; FUserAgent :string; FUrl :string; protected procedure Execute; override; public constructor Create(const ATerminateHandler: TNotifyEvent=nil; PauseThread :Boolean=True); // property UserAgent:string read FUserAgent write FUserAgent; property URL:string read FUrl write FUrl; property ChkResult:Boolean read FResult; // принятый текст property Terminated; published end;
// function THTTPSender.GetQueryInfo(hRequest: Pointer; Flag: integer): string; type TQueryThreat = class(TThread) private FResult :string; FUserAgent :string; FQuery :Integer; // тип запроса FUrl :string; function GetQueryInfo(hRequest :Pointer; Flag :integer):string; protected procedure Execute; override; public constructor Create(const ATerminateHandler: TNotifyEvent=nil; PauseThread :Boolean=True); // property UserAgent:string read FUserAgent write FUserAgent; property URL:string read FUrl write FUrl; property Query:Integer read FQuery write FQuery default HTTP_QUERY_CONTENT_LENGTH; property ResultText:string read FResult; // принятый текст property Terminated; published end;
type TDownloadThread = class(TThread) private fURL: String; FUserAgent :string; FFilePath :string; // полный путь до локально сохраняемого файла FCurPos, FMaxPos :Int64; // текущая позиция, всего FStartFilePos :Int64; // начало файла, для закачки // err: TDownloadError; // ошибка, лучше реализовать работу с константами. а вот стоит ли заморачиваться с исключениями не уверен, решай сам fError: TErrorEvent; fAccepted: TNotifyEvent; fOnProgres: TRecivByte; // прогресс загрузки fBreak: TNotifyEvent; procedure toError; procedure toAccepted; procedure toDownloading; procedure toBreak; function GetQueryInfo(hRequest :Pointer; Flag :integer):string; protected procedure Execute; override; public constructor Create(const ATerminateHandler: TNotifyEvent=nil; CreateSuspennded: Boolean=True); //создание потока. CreateSuspennded в тру - не дает запустится потоку сразу после создания (в таком случае поток запускается методом resume). property URL:string read fURL write fURL; // вдруг понадобится во время скачки property UserAgent:string read FUserAgent write FUserAgent; property StartPositon:Int64 read FStartFilePos write FStartFilePos default 0; // для докачки property FilePath:string read FFilePath write FFilePath; // property OnError:TErrorEvent read fError write fError; // еггог property OnAccepted:TNotifyEvent read fAccepted write fAccepted; // загрузка завершилась удачно, по адресу Stream из конструктора лежит скачанная страничка property OnProgres:TRecivByte read fOnProgres write fOnProgres; // загрузка завершилась удачно, по адресу Stream из конструктора лежит скачанная страничка property OnBreak:TNotifyEvent read fBreak write fBreak; // загрузка завершилась удачно, по адресу Stream из конструктора лежит скачанная страничка property Terminated; end;
type TForm1 = class(TForm) Panel1: TPanel; Image1: TImage; Label1: TLabel; Edit1: TEdit; Label2: TLabel; Edit2: TEdit; Button1: TButton; Button2: TButton; Label3: TLabel; ProgressBar1: TProgressBar; Button3: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } FDwnLoadThread :TDownloadThread; // качалка FUserStop :Boolean; // стоп // function CheckUrl(url: string): boolean; function GetQueryResult(URL, UserAgent :string; Mode :Integer=HTTP_QUERY_CONTENT_LENGTH):string; // размер файла function GetURLFileSize(Url :string):Int64; // дата изменения файла function GetURLLastModify(Url :string):string; // получить HTML текст страницы function GetHTMLPageText(Url :string):string; // procedure thrTerminate(Sender:TObject); procedure thrProgress(Progres,MaxSiz :Int64); // function GetSizTxt(I64: Int64): String; function ExtractUrlFileName(Url: string): string; function GetSelFileSize(Path: string): Int64; { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.dfm}
{ TTextThreat }
constructor TTextThreat.Create(const ATerminateHandler: TNotifyEvent; PauseThread :Boolean); begin inherited Create(PauseThread); FreeOnTerminate := False; Priority := tpNormal; OnTerminate := ATerminateHandler; FPrgPos := 0; FPrgMax := 0; FMem := TMemoryStream.Create; end;
destructor TTextThreat.Destroy; begin FMem.Clear; FreeAndNil(FMem); end;
procedure TTextThreat.Execute; const HTTP_PORT = 80; Header = 'Content-Type: application/x-www-form-urlencoded' + sLineBreak; var FSession, FConnect, FRequest :HINTERNET; FHost, FScript :String; Ansi :PAnsiChar; Buff :array[0..1023]of Char; BytesRead :Cardinal; FileSiz :Cardinal; // размер файла FIdUrI :TIdURI; Lst :TStrings; begin FText := ''; if Trim(URL) = '' then Exit; if Pos('http://', LowerCase(FUrl)) = Length(FUrl) then Exit; // if Pos('http://', LowerCase(FUrl)) = 0 then FUrl := 'http://' + FUrl; Lst := TStringList.Create; FIdUrI := TIdURI.Create(FUrl); try FText := ''; FPrgPos := 0; FPrgMax := 0; // FMem.Clear; FMem.Position := 0; // FHost := FIdUrI.Host; FScript := FUrl; FScript := Copy(FScript, Pos(FIdUrI.Host, FScript) + Length(FIdUrI.Host) + 1, MaxInt); // Инициализируем WinInet FSession := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, // PRE_CONFIG_INTERNET_ACCESS, nil, nil, INTERNET_FLAG_RELOAD); if not Assigned(FSession) then Exit; try // Попытка соединения с сервером FConnect := InternetConnect(FSession, PChar(FHost), HTTP_PORT, nil, 'HTTP/1.1', INTERNET_SERVICE_HTTP, 0, 0); if not Assigned(FConnect) then Exit; try // Подготавливаем запрос страницы Ansi := 'text/*'; FRequest := HttpOpenRequest(FConnect, 'GET', PChar(FScript), 'HTTP/1.1', '', @Ansi, INTERNET_FLAG_RELOAD, 0); if not Assigned(FConnect) then Exit; try // Добавляем заголовки if not (HttpAddRequestHeaders(FRequest, Header, Length(Header), HTTP_ADDREQ_FLAG_REPLACE or HTTP_ADDREQ_FLAG_ADD)) then Exit; // Отправляем запрос if not (HttpSendRequest(FRequest, nil, 0, nil, 0)) then Exit; // размер файла InternetQueryDataAvailable(FRequest, FileSiz, 0, 0); FPrgMax := FileSiz; // Получаем ответ FillChar(Buff, SizeOf(Buff), 0); repeat // FText := FText + Buff; FillChar(Buff, SizeOf(Buff), 0); InternetReadFile(FRequest, @Buff, SizeOf(Buff), BytesRead); FMem.Write(Buff, BytesRead); // сколько скачали FPrgPos := FPrgPos + BytesRead; Synchronize(Updateprogres); until BytesRead = 0; // FMem.Position := 0; Lst.LoadFromStream(FMem); FText := Lst.Text; finally InternetCloseHandle(FRequest); end; finally InternetCloseHandle(FConnect); end; finally InternetCloseHandle(FSession); end; // Sleep(1000); finally try FreeAndNil(FIdUrI); Lst.Clear; FreeAndNil(Lst); finally Terminate; end; end; end;
procedure TTextThreat.Updateprogres; begin // обновит прогресс if Assigned(FOnProgres) then FOnProgres(FPrgPos, FPrgMax); end;
{ TChkURLThreat }
constructor TChkURLThreat.Create(const ATerminateHandler: TNotifyEvent; PauseThread: Boolean); begin inherited Create(PauseThread); FreeOnTerminate := False; Priority := tpNormal; OnTerminate := ATerminateHandler; end;
procedure TChkURLThreat.Execute; var hSession, hfile, hRequest :hInternet; dwindex, dwcodelen :dword; dwcode :array[1..20]of char; res :pchar; begin FResult := False; if Trim(FUrl) = '' then Exit; try if Pos('http://', LowerCase(FUrl)) = 0 then FUrl := 'http://' + FUrl; FResult := False; hSession := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); if assigned(hsession) then begin hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0); dwIndex := 0; dwCodeLen := 10; HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex); res := pchar(@dwcode); FResult := (res = '200') or (res = '302'); if assigned(hfile) then InternetCloseHandle(hfile); InternetCloseHandle(hsession); end; // Sleep(1000); finally Terminate; end; end;
{ TDownloadThread }
constructor TDownloadThread.Create(const ATerminateHandler: TNotifyEvent; CreateSuspennded: Boolean); begin inherited Create(CreateSuspennded); //метод предка FreeOnTerminate := False; //очистка при уничтожении OnTerminate := ATerminateHandler; fURL := URL; //запоминаем урл FCurPos := 0; // позиция в фйале FMaxPos := 0; // размер файла FStartFilePos := -1; // установка позиции. автомат end;
procedure TDownloadThread.Execute; var pInet, pConnect, pUrl, pRequest :Pointer; Buffer :array[0..1024]of Byte; BytesRead :Cardinal; //количество прочитанных байт SumSize :Cardinal; // размер файла на сервере Header :string; i :Integer; Fs :TFileStream; // BufMaxLen :string; // ответ от Query запроса размера файла begin // FCurPos := 0; FMaxPos := 0; // try if not FileExists(FFilePath) then begin try Fs := TFileStream.Create(FFilePath, fmCreate); except Exit; end; end else begin try Fs := TFileStream.Create(FFilePath, fmOpenReadWrite); except Exit; end; // установка позиции в файле | докачка if FStartFilePos >= 0 then // если -1, пропускаем установку begin // вручную указанная позиция начала закачки FCurPos := FStartFilePos; Fs.Position := FStartFilePos; end else if Fs.Size > 0 then // нужно ли докачивать begin // автоопределение места начала закачки | в конец файла - буффер FCurPos := Fs.Size - Length(Buffer); Fs.Position := Fs.Size- Length(Buffer); end else begin // в начало файла FCurPos := 0; Fs.Position := 0; end; end; // ShowMessage(Format('Файл: %s'#13'Fs.Size: %d'#13 + // 'Fs.Position: %d'#13 + // 'FCurPos: %d'#13'FMaxPos: %d', // [FFilePath, Fs.Size, Fs.Position, FCurPos, FMaxPos]) // ); // pInet := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); if pInet = nil then begin //если сессия не открылась err := deInternetOpen; Synchronize(toError); Exit; end; try Header := Format('User-Agent: %s'#13 + 'Accept: */*'#13 + 'Connection: keep-alive'#13 + 'Range: bytes=%d-', [FUserAgent, FCurPos]); pUrl := InternetOpenUrl(pInet, PChar(URL), PChar(Header), Length(Header), INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_RELOAD, 0); if pUrl = nil then //если не достучались до урл begin err := deInternetOpenUrl; Synchronize(toError); Exit; end; // размер файла на сервере | после "Range: bytes=%d-" выдаст, сколько осталось BufMaxLen := GetQueryInfo(pUrl, HTTP_QUERY_CONTENT_LENGTH); SumSize := StrToInt64Def(BufMaxLen, 0); // полный размер файла на сервере if SumSize > 0 then Inc(SumSize, FCurPos) else if (SumSize = 0) then // в конце файла | дадим размер файла SumSize := FCurPos; FMaxPos := SumSize; // // прогресс Synchronize(toDownloading); // Сместимся в файле // v1 // if FCurPos > 0 then // InternetSetFilePointer(pURL, FCurPos, nil, FILE_BEGIN, 0); // v2 // if FCurPos > 0 then // HttpSendRequest(pURL, // PChar(Format('Range: bytes=%d-', [FCurPos])), // Length(Format('Range: bytes=%d-', [FCurPos])), // nil, // 0); // закачка Repeat // остановка загрузки if Terminated then Break; FillChar(Buffer, SizeOf(Buffer), 0); //заполняем буфер нолями if InternetReadFile(pUrl, @Buffer, Length(Buffer), BytesRead) then begin Fs.Write(Buffer, BytesRead); //пишем буфер в поток если прочитали // прогресс // FCurPos := Fs.Size; Inc(FCurPos, BytesRead); Synchronize(toDownloading); end else begin //если прочитать не удалось err := deDownLoadingFile; Synchronize(toError); Exit; end; Until (BytesRead = 0); //прочитано все finally if pUrl <> nil then //открывалось успешно? InternetCloseHandle(pUrl); //закрываем if pRequest <> nil then //открывалось успешно? InternetCloseHandle(pRequest); //закрываем if pConnect <> nil then //открывалось успешно? InternetCloseHandle(pConnect); //закрываем if pInet <> nil then //открывалось успешно? InternetCloseHandle(pInet); //закрываем end; if Terminated then Synchronize(toBreak) else Synchronize(toAccepted); //сообщаем об успешном завершении Sleep(1000); finally FreeAndNil(Fs); Terminate; end; end;
function TDownloadThread.GetQueryInfo(hRequest: Pointer; Flag: integer): string; var code :String; size,index :Cardinal; begin Result := ''; SetLength(code, 8); // достаточная длина для чтения статус-кода size := Length(code); index := 0; if HttpQueryInfo(hRequest, Flag, PChar(code), size, index) then Result := Code else if (GetLastError = ERROR_INSUFFICIENT_BUFFER) then // увеличиваем буффер begin SetLength(code, size); size := Length(code); if HttpQueryInfo(hRequest, Flag, PChar(code), size, index) then Result := code; end else Result := ''; end;
procedure TDownloadThread.toAccepted; begin if Assigned(fAccepted) then fAccepted(Self); end;
procedure TDownloadThread.toBreak; begin if Assigned(fBreak) then fBreak(Self); end;
procedure TDownloadThread.toDownloading; begin if Assigned(fOnProgres) then fOnProgres(FCurPos, FMaxPos); end;
procedure TDownloadThread.toError; begin if Assigned(fError) then OnError(Self, err); end;
{ TQueryThreat }
constructor TQueryThreat.Create(const ATerminateHandler: TNotifyEvent; PauseThread: Boolean); begin inherited Create(PauseThread); FreeOnTerminate := False; Priority := tpNormal; OnTerminate := ATerminateHandler; // длина FQuery := HTTP_QUERY_CONTENT_LENGTH; end;
procedure TQueryThreat.Execute; const BufferSize = 1024; var hSession, hURL :HInternet; Buffer :array[1..BufferSize]of byte; BufferLen :DWORD; begin try if Trim(FUrl) = '' then Exit; // if Pos('http://', LowerCase(FUrl)) = 0 then FUrl := 'http://' + FUrl; // if Pos('http://', LowerCase(FUrl)) = Length(FUrl) then Exit; // hSession := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); if Assigned(hSession) then begin try hURL := InternetOpenURL(hSession, PChar(FUrl), nil, 0, 0, 0); if Assigned(hURL) then begin try FResult := GetQueryInfo(hURL, FQuery); finally InternetCloseHandle(hURL); end; end; finally InternetCloseHandle(hSession); end; end; Sleep(1000); finally Terminate; end; end;
function TQueryThreat.GetQueryInfo(hRequest: Pointer; Flag: integer): string; var code :String; size,index :Cardinal; begin Result := ''; SetLength(code, 8); // достаточная длина для чтения статус-кода size := Length(code); index := 0; if HttpQueryInfo(hRequest, Flag, PChar(code), size, index) then Result := Code else if (GetLastError = ERROR_INSUFFICIENT_BUFFER) then // увеличиваем буффер begin SetLength(code, size); size := Length(code); if HttpQueryInfo(hRequest, Flag, PChar(code), size, index) then Result := code; end else Result := ''; end;
function TForm1.ExtractUrlFileName(Url: string): string; var A :LongInt; begin // извлечь название файла из ссылки Result := ''; A := LastDelimiter('/', Url); if (A > 0) and (Url[A] = '/') then Result := Copy(Url, A + 1, Length(Url) - A); end;
function TForm1.GetSelFileSize(Path: string): Int64; var Fs :TFileStream; begin // размер файла на диске Result := -1; if Not FileExists(Path) then Exit; Fs := TFileStream.Create(Path, fmOpenRead); try Result := Fs.Size; finally FreeAndNil(Fs); end; end;
procedure TForm1.Button1Click(Sender: TObject); var SavFilePath :string; begin Button1.Enabled := False; FDwnLoadThread := TDownloadThread.Create(thrTerminate, True); try if not CheckUrl(Edit1.Text) then begin ShowMessage('файла по ссылке нет'); Exit; end; if not DirectoryExists(Edit2.Text) then begin ShowMessage('Директория не выбрана'); Exit; end; Button2.Enabled := True; SavFilePath := IncludeTrailingBackslash(Edit2.Text) + ExtractUrlFileName(Edit1.Text); // FDwnLoadThread := TDownloadThread.Create(thrTerminate, True); FDwnLoadThread.URL := Edit1.Text; // URL файла FDwnLoadThread.UserAgent := AgentB; FDwnLoadThread.FilePath := SavFilePath; // путь для сохранения файла FDwnLoadThread.StartPositon := -1; // -1 = автоопределение позиции докачки FDwnLoadThread.OnProgres := thrProgress; // отображение процесса закачки FDwnLoadThread.Resume; while not FDwnLoadThread.Terminated do Application.HandleMessage; if FUserStop then begin MessageBox(Handle, 'Закачку прервал пользователь', 'Информация', MB_OK + MB_ICONINFORMATION); end; finally FUserStop := False; FreeAndNil(FDwnLoadThread); Button1.Enabled := True; Button2.Enabled := False; end; end;
procedure TForm1.Button2Click(Sender: TObject); begin FUserStop := True; FDwnLoadThread.Terminate; end;
procedure TForm1.Button3Click(Sender: TObject); begin Label2.Caption := GetSizTxt(GetURLFileSize(Edit1.Text)); end;
function TForm1.CheckUrl(url: string): boolean; var ChkThr :TChkURLThreat; begin Result := False; if Trim(Url) = '' then Exit; // ChkThr := TChkURLThreat.Create(thrTerminate, True); try ChkThr.UserAgent := AgentB; ChkThr.URL := url; // пуск ChkThr.Resume; // ждем while not ChkThr.Terminated do Application.HandleMessage; // результат проверки Result := ChkThr.ChkResult; finally FreeAndNil(ChkThr); end; end;
procedure TForm1.FormCreate(Sender: TObject); begin with Edit1 do begin ShowHint := True; Hint := 'Вставляйте значение протокола в начале адреса!'#13 + 'http:// или https://'; end; Edit2.Text := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))); FUserStop := False; end;
function TForm1.GetHTMLPageText(Url: string): string; var TxtThr :TTextThreat; begin // получить HTML текст страницы Result := ''; if Trim(Url) = '' then Exit; TxtThr := TTextThreat.Create(thrTerminate, True); try TxtThr.OnProgress := thrProgress; // прогресс закачки TxtThr.UserAgent := AgentB; TxtThr.URL := Url; TxtThr.Resume; // while not TxtThr.Terminated do Application.HandleMessage; // Result := TxtThr.ResultText; finally FreeAndNil(TxtThr); end; end;
function TForm1.GetQueryResult(URL, UserAgent: string; Mode: Integer): string; var QThr :TQueryThreat; Text :string; begin Result := ''; if Trim(URL) = '' then Exit; // QThr := TQueryThreat.Create(thrTerminate, True); try QThr.UserAgent := UserAgent; QThr.URL := URL; QThr.Query := Mode; QThr.Resume; while not QThr.Terminated do Application.HandleMessage; // Text := QThr.ResultText; // выведем результат Result := Text; finally FreeAndNil(QThr); end; end;
function TForm1.GetSizTxt(I64: Int64): String; const i64GB = 1024 * 1024 * 1024; i64MB = 1024 * 1024; i64KB = 1024; begin // перевод байт в строку Result := '0 б'; if I64 div i64GB > 0 then Result := Format('%.2f Гб', [I64/i64GB]) else if I64 div i64MB > 0 then Result := Format('%.2f Мб', [I64/i64MB]) else if I64 div i64KB > 0 then Result := Format('%.2f Кб', [I64/i64KB]) else Result := IntToStr(I64) + ' б'; end;
function TForm1.GetURLFileSize(Url: string): Int64; begin // размер файла Result := StrToInt64Def(GetQueryResult(Url, AgentB, HTTP_QUERY_CONTENT_LENGTH), 0); end;
function TForm1.GetURLLastModify(Url: string): string; begin // дата изменения файла Result := GetQueryResult(Url, AgentB, HTTP_QUERY_LAST_MODIFIED); end;
procedure TForm1.thrProgress(Progres, MaxSiz: Int64); begin with ProgressBar1 do begin Max := MaxSiz; Position := Progres; Update; end; Label3.Caption := Format('Выполнено: %s из %s', [GetSizTxt(Progres), GetSizTxt(MaxSiz)]); end;
procedure TForm1.thrTerminate(Sender: TObject); begin SendMessage(Handle, WM_NULL, 0, 0); end;
end.
|
Цель кода скачать с указанного http адреса в интернете файл и сохранить его по указанному локальному пути. Он замечательный, все красиво работает. Проблема: программа идет в отказ при попытке стачивания файла более 3 гигабайт. Конечно она может идет в отказ и при 2,9999 или 2,751 гигабайтам, но я не проверял. Прекрасно скачиваются файлы размером до 2 гигабайт, без зависания формы, хорошо работает поток, но стоит только дать ссылку на файл 3 гигабайта, 4, 5 как программа через секунду после запуска обработки не производя никаких действий выдает что файл скачан, создавая пустышку на локальном диске. То есть задал урл, но скачан файл с размером 0. Грешным делом подумал, что проблема в самом WinInet либо проблема с моей головой и мне надо либо оперативной памяти купить плату дополнительно, либо руки выпрямить, но, накидал маленький код: Код | unit Unit1;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, WinInet, Vcl.StdCtrls;
type TMyThread = class(TThread) //Новый класс private count,sum,answer: Integer; protected procedure ShowResult; procedure Execute; override; end;
type TForm1 = class(TForm) Edit1: TEdit; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TMyThread.Execute; var session,url:HInternet; appName:WideString; BufArr:array[1..1024] of byte; BufLen:DWORD; F:File; begin answer:=0; appName := ExtractFileName(Application.ExeName); session := InternetOpen(Pchar(appName),INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0); url:=InternetOpenUrl(session,PWideChar('http://олололололо/мегафайл'),nil,0,0,0); AssignFile(F,'диск:\мегафайл'); Rewrite(F,1); repeat InternetReadFile(url,@BufArr,SizeOf(BufArr),BufLen); BlockWrite(F,BufArr,BufLen); answer := answer+BufLen; until BufLen=0; CloseFile(F); InternetCloseHandle(session); Synchronize(ShowResult); end;
procedure TMyThread.ShowResult; begin Form1.Edit1.Text := IntToStr(answer); end;
procedure TForm1.Button1Click(Sender: TObject); var MyThread:TMyThread; begin MyThread := TMyThread.Create(False); end;
end.
|
,выполнил и файл был скачан.. и 3 гигабайта и 4... и даже восемь гигабайт. Прошу, ребят, посмотрите и подкиньте идейку слабоумному. Я все перетряс, десять раз перепродумывал. Не доходит где ошибся. Заранее спасибо. Добавлено через 2 минуты и 3 секундыЗабыл уточнить. Дебажить бесполезно, идет в брик по окончанию выполнения, ничего не дает. С ума схожу.
|