e-mail    Debatní kniha    Mapa stránek    Hlavní  
 perličky 
 

Manipulace se soubory v Turbo Vision

Ing. Petr Čech

Při psaní instalačních programů zabírá hodně času vytvoření "rozumně se tvářících" procedur pro kopírování a mazání souborů nebo adresářů. Já jsem pro tento účel napsal v prostředí Turbo Vision jednotku pro práci se soubory a adresáři.

Jednotka obsahuje objekt TDir, který umožňuje:

  • kopírovat soubory a zobrazovat průběh kopírování
  • přejmenovávat nebo přesouvat soubory
  • vytvářet adresáře nebo mazat prázdné

Parametry procedur jsou jména souborů (adresářů). Každá procedura obsahuje parametr RESULT:boolean, který vrací úspěšnost operace. Procedury jsou psány jako virtuální pro jejich případné překrytí a rozšíření např. o kontrolu vstupních údajů, dotaz před přepsáním existujícího souboru, nebo pro potvrzení před přepsáním souboru.

Každá procedura obsahuje vlastní chybové hlášení, které lze vypustit v případě, že ho obsahuje překrývající procedura. Provedeme to zrušením nasledujících řádků v každé proceduře:

 Dg : PDialog;
  C := MessageBox(^C...);
  Dispose(Dg,Done);

Doufám, že tahle perlička aspoň některým z vás pomůže zbavit se starostí s uvedenými operacemi.

unit Direc;

{*********PRÁCE SE SOUBORY A ADRESÁŘI***************}
{*CopyFile - kopirovani, param:VstF-vstupni soubor,*}
{*                       VysF-vystupni soubor      *}
{*                       Result - uspesnost operace*}
{*DelFile  - mazani souboru,                       *}
{*           param:VstF-mazany soubor,Result       *}
{*RenFile  - prejmenovani(presunuti) souboru,      *}
{*           param:jako CopyFile                   *}
{---------------------------------------------------}
{*MakeDir  - vytvoreni adresare,                   *}
{*           param:Adr-vytv. adresar,Result        *}
{*RemoDir  - zruseni adresare, param:jako MakeDir  *}
{***************************************************}

interface

uses App, Dialogs, Objects, MsgBox;

type PDir = ^TDir;
     TDir = object
       constructor Init;
       procedure CopyFile(VstF,VysF:String;
                          var Result:boolean);virtual;
       procedure DelFile(VstF:string;
                          var Result:boolean);virtual;
       procedure MakeDir(Adr:string;
                          var Result:boolean);virtual;
       procedure RemoDir(Adr:string;
                          var Result:boolean);virtual;
       procedure RenFile(VstF,VysF:String;
                          var Result:boolean);virtual;
       destructor Done;
     end;
var C:word;
implementation

constructor TDir.Init;
begin
end;

procedure TDir.CopyFile(VstF,VysF:String;
                        var Result:boolean);
Var R         : TRect;
    Dg        : PDialog;
    NumRead,
    NumWriten : Word;
    Poz,
    Soubor    :longint;
    FIn,FOut  : file;
    J         : array[1..4096]of Char;
    SBar      : String[40];
    SVel      : String[10];

procedure Teplomer;
var proc  :Real;
    Kam,I :longint;
begin
  Poz:=Poz+NumRead;
  Proc:=(Poz/Soubor)*100;
  Kam :=trunc(0.4*Proc);
  for I:=1 to Kam do
    SBar[I]:='_';
  R.Assign(2,6,48,7);
  Dg^.Insert(New(PStaticText,Init(R,^C+Sbar)));
end;

Begin
  Result:=false;
  Poz:=0;
  SBar:='________________________________________';
  R.Assign(15,8,65,17);
  Dg:=New(PDialog,Init(R,'Kopirovani'));
  R.Assign(2,1,48,7);
  Dg^.Insert(New(PStaticText,
                   Init(R,^C'Soubor'+#13+
                          ^C+VstF+#13+
                          ^C'na soubor'+#13+
                          ^C+VysF+#13+#13+^C+Sbar)));
  Desktop^.Insert(DG);
  Assign(FIn,VstF);
  Assign(FOut,VysF);
{$I-}
  Reset(FIn,1);
{$I+}
  If IOResult<>0 Then
    Begin
      C:=MessageBox(
^C'Chyba pri otevirani vstupniho souboru'#13+
^C+VstF, nil, mfCancelButton + mfError);
      Dispose(Dg,Done);
      Exit;
    End;
{$I-}
  ReWrite(FOut,1);
{$I+}
  If IOResult<>0 Then
    Begin
      C:=MessageBox(
^C'Chyba pri otevirani vystupniho souboru'#13+
^C+VysF, nil, mfCancelButton + mfError);
      Close(FIn);
      Dispose(Dg,Done);
      Exit;
    End;
  Soubor:=FileSize(FIn);
  repeat
      BlockRead(FIn,J,SizeOf(J),NumRead);
      BlockWrite(FOut,J,NumRead,NumWriten);
      Teplomer;
      If (NumWriten <> NumRead) Then
        Begin
          C:=MessageBox(
^C'Chyba pri kopirovani souboru'#13+
^C+VysF, nil, mfCancelButton + mfError);
          Close(FIn);
          Close(FOut);
          Dispose(Dg,Done);
          Exit;
        End;
  until (NumRead = 0) or
      (NumWriten <> NumRead);
  Close(FIn);
  Close(FOut);
  Dispose(Dg,Done);
  Result:=true;
end;

procedure TDir.DelFile(VstF:string;
                       var Result:boolean);
var FIn : file;
    R   : TRect;
    Dg  : PDialog;
    Len,Hp,Dl : Byte;
begin
  Result:=false;
  Len:=Length(VstF);
  if Len<12 then
    Len:=12;
  Hp:=40-round(Len/2)-3;
  Dl:=40+round(Len/2)+3;
  R.Assign(Hp,8,Dl,14);
  Dg:=New(PDialog,Init(R,'Mazání'));
  R.Assign(2,2,Dl-Hp-2,5);
  Dg^.Insert(New(PStaticText,
             Init(R,^C'Mažu soubor'+#13+
                    ^C+VstF)));
  Desktop^.Insert(DG);
  assign(FIn,VstF);
{$I-}
  erase(FIn);
  Dispose(Dg,Done);
{$I+}
  if IOResult<>0 Then
    C:=MessageBox(
^C'Nelze smazat soubor'+#13+#13+
^C+VstF, nil,mfCancelButton + mfError)
  else
    Result:=true;
end;

procedure TDir.MakeDir(Adr:string;
                       var Result:boolean);
var R   : TRect;
    Dg  : PDialog;
    Len,Hp,Dl : Byte;
begin
  Result:=false;
  Len:=Length(Adr);
  if Len<18 then
    Len:=18;
  Hp:=40-round(Len/2)-3;
  Dl:=40+round(Len/2)+3;
  R.Assign(Hp,8,Dl,14);
  Dg:=New(PDialog,Init(R,'Adresář'));
  R.Assign(2,2,Dl-Hp-2,5);
  Dg^.Insert(New(PStaticText,
                 Init(R,^C'Vytvářím adresář'+#13+
                        ^C+Adr)));
  Desktop^.Insert(DG);
{$I-}
  MkDir(Adr);
  Dispose(Dg,Done);
{$I+}
  if IOResult<>0 Then
    C:=MessageBox(
^C'Nelze vytvořit adresář '+#13+#13+
^C+Adr, nil,mfCancelButton + mfError)
  else
    Result:=true;
end;

procedure TDir.RemoDir(Adr:string;
                       var Result:boolean);
var R   : TRect;
    Dg  : PDialog;
    Len,Hp,Dl : Byte;
begin
  Result:=false;
  Len:=Length(Adr);
  if Len<18 then
    Len:=18;
  Hp:=40-round(Len/2)-3;
  Dl:=40+round(Len/2)+3;
  R.Assign(Hp,8,Dl,14);
  Dg:=New(PDialog,Init(R,'Adresář'));
  R.Assign(2,2,Dl-Hp-2,5);
  Dg^.Insert(New(PStaticText,
                 Init(R,^C'Mažu adresář'+#13+
                        ^C+Adr)));
  Desktop^.Insert(DG);
{$I-}
  RmDir(Adr);
  Dispose(Dg,Done);
{$I+}
  if IOResult<>0 Then
    C:=MessageBox(
^C'Nelze zrušit adresář '+#13+#13+
^C+Adr, nil,mfCancelButton + mfError)
  else
    Result:=true;
end;

procedure TDir.RenFile(VstF,VysF:String;
                       var Result:boolean);
var R   : TRect;
    Dg  : PDialog;
    Len,Hp,Dl : Byte;
    FIn : file;
begin
  Result:=false;
  if Length(VstF)>Length(VysF) then
    Len:=Length(VstF)
  else
    Len:=Length(VysF);
  if Len<30 then
    Len:=30;
  Hp:=40-round(Len/2)-3;
  Dl:=40+round(Len/2)+3;
  if VstF[1]=VysF[1] then begin
    R.Assign(Hp,8,Dl,16);
    Dg:=New(PDialog,Init(R,'Přejmenování'));
    R.Assign(2,2,Dl-Hp-2,6);
    Dg^.Insert(New(PStaticText,
        Init(R,^C'Přejmenovávám soubor/adresář'+#13+
               ^C+VstF+#13+
               ^C'na'+#13+
               ^C+VysF)));
    Desktop^.Insert(DG);
    assign(FIn,VstF);
  {$I-}
    Rename(FIn,VysF);
    Dispose(Dg,Done);
  {$I+}
    if IOResult<>0 Then
      C:=MessageBox(
^C'Chyba při přejmenování souboru/adresáře'+#13+
^C+VstF, nil,mfCancelButton + mfError)
    else
      Result:=true;
    end
  else begin
    TDir.CopyFile(VstF,VysF,Result);
    if Result then
      TDir.DelFile(VstF,Result);
  end;
end;

destructor TDir.Done;
begin
end;

begin
end.



Pascal - hlavní
Překladače
Vlastní články
Převzaté články
Věci na stáhnutí
Odkazy k tématu
BP7 buglist
Chyba Run-time 200

BASIC