Delphi - Applicare più processi contemporaneamente

Forum - Delphi - Applicare più processi contemporaneamente - Pagina 2

Pagine: [ 1 2 ]

()
Newbie

Messaggi:
Iscritto:

Postato alle 21:37
Martedì, 20/04/2010

Senti ,io non ho capito cosa tu voglia fare con il multithreading.
Comunque se vuoi un copia file eccotelo (anche se so che sei capace di farne uno)

Ultima modifica effettuata da il 21/04/2010 alle 18:26

()
Newbie

Messaggi:
Iscritto:

Postato alle 21:40
Martedì, 20/04/2010

Scusa ,ecco il codice:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ComCtrls,windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1 : TButton;
    Button2 : TButton;
    Label1 : TLabel;
    Label2 : TLabel;
    OpenDialog1 : TOpenDialog;
    ProgressBar1 : TProgressBar;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

var
filesorg,
filedest : file;
recordletti : integer;
buffer : array[1..1000] of byte;
nome1,
nome2 : string;

//mi scuso se non applico bene le regole di modularita'
//ma e' solo un esempio
procedure copia;
begin
Assign(filesorg,nome1);
{$I-}
reset(filesorg,1);
{$I+}
if ioresult <> 0 then
   showmessage('Errore');
   // o se no :  messagebox(form1.handle,'Errore!','',MB_ICONERROR);
Assign(filedest,nome2);
rewrite(filedest,1);
blockread(filesorg,buffer,sizeof(buffer),recordletti);
form1.ProgressBar1.Min := 0;
form1.ProgressBar1.Max := recordletti;
form1.progressbar1.Position := recordletti;
while recordletti > 0 do
begin
   blockwrite(filedest,buffer,sizeof(buffer));
   blockread(filesorg,buffer,sizeof(buffer),recordletti);
   form1.ProgressBar1.Position := form1.ProgressBar1.position + recordletti;
end;

close(filesorg);
close(filedest);
form1.label2.Visible := true;
form1.label1.Caption := '' ;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//apre la finestra di scelta del file
if opendialog1.Execute then
    begin
      nome1 := form1.OpenDialog1.FileName;
      label1.Caption := nome1;
    end;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  label2.Visible := false;
  form1.progressbar1.Position := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if savedialog1.Execute then
    begin
      nome2 := savedialog1.FileName;
    end;
  copia;
end;

initialization
  {$I unit1.lrs}

end.

Ultima modifica effettuata da il 20/04/2010 alle 21:54

a_butta (Member)
Expert

Messaggi: 578
Iscritto: 16/03/2010

Postato alle 22:20
Martedì, 20/04/2010

si ma così non hai usato un thread separato... in questo modo io avrei lo stesso problema: mentre cerca di sviluppare la procedura COPIA il programma non fa altro... e sono punto a capo...

()
Newbie

Messaggi:
Iscritto:

Postato alle 16:54
Giovedì, 22/04/2010

Prova questo :

a me funziona ..
solamente che dopo la prima copia la memoria occupata sale di colpo..
guarda il task menager

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ComCtrls, ExtDlgs{,windows};

type

ThreadCopia = class(TThread)
   private

   procedure copiafile;

   protected

   Procedure Execute; override;//in execute si mette il codice da eseguire

   public

   constructor Create(CreateSuspended: boolean);

    end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1 : TButton;
    Button2 : TButton;
    Label1 : TLabel;
    Label2 : TLabel;
    OpenDialog1 : TOpenDialog;
    ProgressBar1 : TProgressBar;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

var
filesorg,
filedest : file;
recordletti : int64;
buffer : array[1..1000] of byte;
nome1,
nome2 : string;
//il thread
th :  ThreadCopia;

//mi scuso se non applico bene le regole di modularita'
//ma e' solo un esempio
procedure copia;
begin
Assign(filesorg,nome1);
{$I-}
reset(filesorg,1);
{$I+}
if ioresult <> 0 then
   showmessage('Errore');
   // o se no :  messagebox(form1.handle,'Errore!','',MB_ICONERROR);
Assign(filedest,nome2);
{$I-}
rewrite(filedest,1);
{$I+}
if ioresult <> 0 then
   showmessage('Inserire il nome del file!');
blockread(filesorg,buffer,sizeof(buffer),recordletti);
form1.ProgressBar1.Min := 0;
form1.ProgressBar1.Max := recordletti;
form1.progressbar1.Position := recordletti;
while recordletti > 0 do
begin
   blockwrite(filedest,buffer,sizeof(buffer));
   blockread(filesorg,buffer,sizeof(buffer),recordletti);
   form1.ProgressBar1.Position := form1.ProgressBar1.position + recordletti;
end;

close(filesorg);
close(filedest);
form1.label2.Visible := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//apre la finestra di scelta del file
button1.visible := true;
if opendialog1.Execute then
    begin
      nome1 := form1.OpenDialog1.FileName;
      label1.Caption := nome1;
    end;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  label2.Visible := false;
  form1.progressbar1.Position := 0;
  form1.label1.Caption := 'Nome del file : ' ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  th := threadcopia.Create(true);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

  if savedialog1.Execute then
    begin
      nome2 := savedialog1.FileName;
    end;
  if (nome2 <> '') and (nome1 <> '')   then
    th.Execute;

end;

////////  DEFINIZIONE DELLO THREAD ///////////////////////////////////////////////////

constructor threadcopia.Create(CreateSuspended : boolean);
begin
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
end;

procedure threadcopia.copiafile;
begin
  copia;
end;

procedure threadcopia.Execute;
begin
  Synchronize(@copiafile);
end;

initialization
  {$I unit1.lrs}

end.

a_butta (Member)
Expert

Messaggi: 578
Iscritto: 16/03/2010

Postato alle 17:27
Giovedì, 22/04/2010

ciao ho visto un po' il tuo codice... grazie mille...
Io avevo portato questo codice in Delphi 2010:

Codice sorgente - presumibilmente Delphi

unit MainUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, Grids, StdCtrls, Menus, GIFImg, pngimage, MPlayer;
var Source, Destination : String;
type
  TMainForm = class(TForm)
      (*... Qui ci sono tutte le dichiarazioni della form ...*);
end;
 
  type ThreadCopy = class(TThread)
 
     private
 
     public
     protected
     Procedure Execute; override;
end;
 
Const FilesFolder = 'files\';
var
  MainForm: TMainForm;
  NumCanti: byte;
  i : byte = 0;
implementation
 
{$R *.dfm}
 
procedure ThreadCopy.Execute;
var
    newStatus : string;
    FromF,
    ToF        : file of byte;
    Buffer     : array[0..4096] of char;
    NumRead    : integer;
    FileLength : longint;
    Qualcosa   : real;
begin
 
  AssignFile(FromF,Source);
  reset(FromF);
  AssignFile(ToF,Destination);
  Rewrite(ToF);
  FileLength:=FileSize(FromF);
  MainForm.Progressbar1.Max := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF,Buffer[0],SizeOf(Buffer),NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF,Buffer[0],NumRead);
      MainForm.Progressbar1.Position := MainForm.Progressbar1.Position + NumRead;
      Qualcosa:= (MainForm.ProgressBar1.Position / MainForm.Progressbar1.Max) *100;
      //MainForm.Image1.Width := Trunc((374 * Qualcosa) / 100);
      MainForm.Label2.Caption:= IntToStr(Trunc(Qualcosa)) + ' %';
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  ShowMessage('File Copiato con successo!');
  MainForm.ProgressBar1.Position:=0;
  MainForm.ProgressBar1.Visible := False;
  MainForm.Label2.Visible := False;
  Terminate;
end;
 
procedure TMainForm.OriginaleMP31Click(Sender: TObject);
var i:byte; n,s:string;
    f:textfile;
begin
n:= StringGrid1.Cells[0,StringGrid1.Row];
s:= StringGrid1.Cells[1,StringGrid1.Row];
Source:= GetCurrentDir+'\'+FilesFolder+n+'\'+n+'a.mp3';
With SaveDialog1 do
begin
for i:=1 to length(s) do
   if s[i] = ':' then s[i]:= ',';
  SaveDialog1.Title:= 'Salva sul pc Originale Mp3';
  SaveDialog1.Filter:= 'Originale MP3 (*.mp3) | *.mp3';
  SaveDialog1.FileName:= StringGrid1.Cells[0,StringGrid1.Row] + ' - ' + s+'.mp3';
  SaveDialog1.Execute;
  if not(SaveDialog1.FileName = '') then
     begin
          ProgressBar1.Visible := True;
          Label2.Visible := True;
          Destination:= SaveDialog1.FileName;
          //ShowMessage('Source: '+Source);
          //ShowMessage('Destination: '+Destination);
          ThreadCopy.Create(False);
     end;
end;
end;
 
end.

Di per sè funziona molto bene... Solo che non riesco a far terminare il Thread... Cioè non riesco ad usare un comando dall'esterno, tipo un bottone della form, per bloccare il Thread... Hai dei consigli?
grazie mille comunque di tutto

()
Newbie

Messaggi:
Iscritto:

Postato alle 17:49
Venerdì, 23/04/2010

prova ad impostare la proprieta' terminated a true. O se no usi direttamente la procedura.

Daf (Normal User)
Pro

Messaggi: 78
Iscritto: 27/06/2009

Postato alle 17:34
Domenica, 09/05/2010

Ho trovato l'errore nel codice:
Quando crei il Thread per poi poterlo fermare devi "salvarlo" cioè

Codice sorgente - presumibilmente Delphi

var
  Copia: TNomeOggettoThread;
begin
  Copia := TNomeOggettoThread.Create(False);
end;
 
procedure Bottone1(Sender: TObject);
begin
  Copia.Terminate;
end;

Ultima modifica effettuata da Daf il 09/05/2010 alle 17:35

a_butta (Member)
Expert

Messaggi: 578
Iscritto: 16/03/2010

Postato alle 23:48
Sabato, 15/05/2010

ciao. Ho provato a fare esattamente quello che hai detto... ma la copiatura continua...
Non riesco a capire dov'è l'errore...

Pagine: [ 1 2 ]