помогите приделать прогрессбар.

[raxp]

сделайте так

function tform1.SendFile(host, script, filename:string):string;
и в какую-нибудь секцию

или так

tform1.ProgressBar.position

[Mobile™]

сделал так-

procedure TForm1.Button1Click(Sender: TObject);
var
ws : TWSAData;
s : string;
begin
inc(num_packet);
progressbar1.position:= num_packet* 4096;
WSAStartup($101, ws);
s := SendFile(Edit1.Text, '/get.php', opendialog1.FileName);
ShowMessage(s);
end;

скомпилировалась но при передаче файла прогрессбар сразу доходит до 100 и процесс продолжается без его участия

[Mobile™]

Сообщение от raxp

сделайте так

function tform1.SendFile(host, script, filename:string):string;
и в какую-нибудь секцию

или так

tform1.ProgressBar.position

тоже самое

[Mobile™]

вот весь имеющийся код-

unit Unit1;

interface

uses
  Windows, Messages, winsock, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    ListBox1: TListBox;
    Button3: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   var num_packet: integer;
implementation

{$R *.dfm}

function SendFile(host, script, filename:string):string;
var
  sock : dword;
  ca : sockaddr_in;
  HTTPHeader : string;
  boundary : string;
  fs:dword;
  hFile : DWORD;
  buf : array [0..4095] of char;
  p : PHostEnt;
  rb : cardinal;
  len : integer;
  SubHeader1 : string;
  SubHeader2 : string;
begin
  result := '';
  // открываем файл на чтение
  hFile := CreateFile(PChar(filename), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  if hFile <> INVALID_HANDLE_VALUE then // если всё норм
  begin
    fs := GetFileSize(hFile, nil); // получим размер файла
    // создаем сокет
    sock := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
    // если создался сокет
    if sock <> INVALID_SOCKET then // если норм
    begin
      ca.sin_family := AF_INET;
      ca.sin_port := htons(80); // порт 

      p := GetHostByName(PChar(host)); // получим ip по домену
      if p = nil then // если нету
      begin
        // значит это IP
        ca.sin_addr.s_addr := inet_addr(pchar(host));
      end
      else
      begin
        // выдерим ip
        ca.sin_addr := PInAddr(p.h_addr_list^)^;
      end;

      // коннектимся
      if connect(sock, ca, sizeof(ca)) <> -1 then
      begin
        // если всё норм
        // генерим разделитель
        boundary := inttohex(random(65535), 4)+inttohex(random(65535), 4)+inttohex(random(65535), 4);
          // создаем части HTTP заголовка
        SubHeader1 :=  '--'+boundary+#13#10+
                      'Content-Disposition: form-data; name="myfile"; filename="'+filename+'"'#13#10+
                      'Content-Type: application/octet-stream'#13#10#13#10;
        SubHeader2 := #13#10+'--'+boundary+'--'#13#10;
        HTTPHeader := 'POST '+script+' HTTP/1.1'#13#10+
                      'Host: '+host+#13#10+
                      'Connection: close'#13#10+
                      'Content-Type: multipart/form-data; boundary='+boundary+#13#10+
                      'Content-Length: '+inttostr(fs + length(SubHeader1) + length(SubHeader2))+#13#10#13#10+SubHeader1;

         // посылаем заголовок
        send(sock, HTTPHeader[1], length(HTTPHeader), 0);
        while true do
        begin
          rb := 0;
          // читаем 4 кила из файла
          ReadFile(hFile, buf, 4096, rb, nil);
          if rb = 0 then break; // если не считалось то выход из цикла
          send(sock, buf, rb, 0); // пошлем считанные данные

        end;
          // пошел последний разделитель
        send(sock, SubHeader2[1], length(SubHeader2), 0);
        while true do // к цикле ждем ответа от сервера
        begin
          len := recv(sock, buf, 4096, 0); // считали данные
          if len > 0 then // если есть чтото
          begin
            result := result + copy(buf, 0, len);
          end
          else
          begin // если нет больше данных то выходим из цикла
            break;
          end;
        end;
      end;
      closesocket(sock); // закрываем сокет
end;
CloseHandle(hFile); // закрываем файл
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ws : TWSAData;
s : string;
begin
WSAStartup($101, ws);
s := SendFile(Edit1.Text, '/get.php', opendialog1.FileName);
ShowMessage(s);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
FStream : TFileStream;
begin
with OpenDialog1 do
if Execute then
begin
Listbox1.Items.Add(opendialog1.FileName);
FStream:=TFileStream.Create(OPenDialog1.FileName,fmOpenRead);
Edit2.Text:=IntToStr(Round(FStream.Size/1024))+' килобайт.';
FStream.free;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Listbox1.Clear;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SendMessage(ListBox1.Handle,LB_SETHORIZONTALEXTENT,width,0);
end;
end.

куда вставлять это-

inc(num_packet);
progressbar1.position:= num_packet* 4096 div fs;

чтобы работало

[raxp]

procedure TForm1.Button1Click(Sender: TObject);
var
ws : TWSAData;
s : string;
begin
inc(num_packet);
progressbar1.position:= num_packet* 4096;
WSAStartup($101, ws);
s := SendFile(Edit1.Text, '/get.php', opendialog1.FileName);
ShowMessage(s);
end;

- вы мои сообщения не читаете?

Цитата:код вставил сюда
- явно не сюда... речь шла о цикле

- у вас есть функция SendFile, в ней у вас идет отправка пакетов... туды ее в качель

[Mobile™]

Сообщение от raxp

procedure TForm1.Button1Click(Sender: TObject);
var
ws : TWSAData;
s : string;
begin
inc(num_packet);
progressbar1.position:= num_packet* 4096;
WSAStartup($101, ws);
s := SendFile(Edit1.Text, '/get.php', opendialog1.FileName);
ShowMessage(s);
end;

- вы мои сообщения не читаете?


- у вас есть функция SendFile, в ней у вас идет отправка пакетов... туды ее в качель

дык вкорячиваю в сендфайл ошибка выскакивает как будто прогрессбар на форме отсутствует. а если в процедуру буттон1 то нет ошибки

[raxp]

вкорячиваете вы правильно (напоминаю у вас внутри там цикл отправки есть)...

ошибка выскакивает как будто прогрессбар на форме отсутствует. а если в процедуру буттон1 то нет ошибки

только опять не читаем

function tform1.SendFile(host, script, filename:string):string;
и в какую-нибудь секцию
...или так
form1.ProgressBar.position

[Mobile™]

Сообщение от raxp

вкорячиваете вы правильно (напоминаю у вас внутри там цикл отправки есть)...


только опять не читаем

function tform1.SendFile(host, script, filename:string):string;
и в какую-нибудь секцию
...или так
form1.ProgressBar.position

я вот плохо понял что требуется сделать. толи заменить-

function SendFile(host, script, filename:string):string;

на

function tform1.SendFile(host, script, filename:string):string;

толи заменить

progressbar1.position:= num_packet* 4096 div fs;

на

form1.ProgressBar.position:= num_packet* 4096 div fs;

но на всякий случай попробывал так и так но ошибки при компиляции

[Mobile™]

помогите..

[Mobile™]

подскажите как делать