home *** CD-ROM | disk | FTP | other *** search
/ Windoware / WINDOWARE_1_6.iso / winutil / om37a / filecopy.pas < prev    next >
Pascal/Delphi Source File  |  1992-06-14  |  13KB  |  467 lines
  1. {****  FileCopy Copyright 1992 Doug Overmyer ********}
  2. unit filecopy;
  3. {$R filecopy.RES}
  4. {$I+}
  5. interface
  6. uses WinTypes, WinProcs, WObjects,Strings,windos,commdlg,win31,
  7.     sclptext,Meter;
  8. const
  9.   FC_Name =  'FileCopy';
  10.   id_StH       = 101;
  11.   id_STJ       = 102;
  12.   id_Copy      = 201;
  13.   id_Move      = 202;
  14.   id_About     = 501;
  15.   id_CMFrom =    601;
  16.   id_CMTo =      602;
  17.   id_CMCopy =    603;
  18.   id_CMMove =    604;
  19.   id_CMDel  =    605;
  20.   id_CMExit =    610;
  21. {**********************  TYPES      ******************************}
  22. type
  23. PFCWindow = ^TFCWindow;
  24. TFCWindow = object(TWindow)
  25.     Files:PStrCollection;
  26.      StH,StJ:PSText;
  27.      SourceBuf:PChar;
  28.      SourceDir,TargetDir:PChar;
  29.   IsActive:Boolean;
  30.   constructor Init(AParent:PWindowsObject;ATitle: PChar);
  31.   function GetClassName:PChar;virtual;
  32.   destructor Done; virtual;
  33.   procedure SetupWindow;virtual;
  34.   procedure CMFrom(Var Msg:TMessage);virtual cm_First+id_CMFrom;
  35.   procedure CMTo(var Msg:TMessage);virtual cm_First+id_CMTo;
  36.   procedure CMCopy(Var Msg:TMessage);virtual cm_First+id_CMCopy;
  37.   procedure CMMove(Var Msg:TMessage);virtual cm_First+id_CMMove;
  38.   procedure CMDel(var Msg:TMessage);virtual cm_First+id_CMDel;
  39.   procedure CMExxit(Var Msg:TMessage);virtual cm_First+id_CMExit;
  40.   procedure CopyMove(ActionType:Integer);
  41.   procedure SetHeader(Msg:Pchar);
  42.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  43.   function CanClose:Boolean;virtual;
  44.   procedure CleanUp;virtual;
  45. end;
  46. {*****************************************************************}
  47. implementation
  48. {*********************  Functions  *******************************}
  49. function StrTok(P:PChar;C:Char):PChar;
  50. const
  51.     Next:Pchar = nil;
  52. begin
  53.     if P = NIL then P := Next;
  54.   if P <> NIL then
  55.       begin
  56.       Next := StrScan(P,C);
  57.       If Next <> NIL then
  58.           begin
  59.         Next^ := #0;
  60.         Next := Next+1;
  61.           end;
  62.       end;
  63.   StrTok := P;
  64. end;
  65. procedure Take5;
  66. var MsgP:TMsg;
  67. begin
  68.     while PeekMessage(MsgP,0,0,0,PM_REMOVE) do
  69.       begin
  70.     if MsgP.Message = WM_QUIT then
  71.         begin
  72.       Application^.Done;
  73.       Halt;
  74.       end;
  75.     TranslateMessage(MsgP);
  76.     DispatchMessage(MsgP);
  77.     end
  78. end;
  79. {**********************  METHODS    ******************************}
  80. {**********************  TFCWindow  *******************************}
  81. constructor TFCWindow.Init(AParent:PWindowsObject;ATitle: PChar);
  82. var
  83.   Indx:Integer;
  84. begin
  85.   TWindow.Init(nil, ATitle);
  86.   with Attr do
  87.     begin
  88.     X := 50; Y := 50; W := 340; H := 100;
  89.     DisableAutoCreate;
  90.          Attr.Style := ws_Popup or ws_Visible or ws_Border or ws_Caption
  91.              or ws_MinimizeBox or ws_SysMenu;
  92.     Menu := LoadMenu(hInstance,'FC_Menu');
  93.     end;
  94.   StJ := New(PSText,Init(@Self,id_StH,'',30,30,275,20,sr_Recessed,
  95.               dt_Left or dt_VCenter or dt_SingleLine));
  96.   StH := New(PSText,Init(@Self,id_StJ,'',30,5,275,20,sr_Recessed,
  97.               dt_Left or dt_VCenter or dt_SingleLine));
  98.   GetMem(SourceBuf,4096);
  99.   GetMem(SourceDir,fsDirectory+1);
  100.   GetMem(TargetDir,fsDirectory+1);
  101.   StrCopy(SourceBuf,'');
  102.   StrCopy(SourceDir,'');
  103.   Strcopy(TargetDir,'');
  104.     Files := New(PStrCollection,Init(10,10));
  105.   IsActive := False;
  106. end;
  107.  
  108. function TFCWindow.GetClassName:PChar;
  109. begin
  110.     GetClassName := 'FCWindow';
  111. end;
  112.  
  113. destructor TFCWindow.Done;
  114. begin
  115.     FreeMem(SourceBuf,4096);
  116.   FreeMem(SourceDir,fsDirectory+1);
  117.   FreeMem(TargetDir,fsDirectory+1);
  118.   Dispose(Files,Done);
  119.   TWindow.Done;
  120. end;
  121.  
  122. procedure TFCWindow.SetupWindow;
  123. var
  124.   SysMenu:HMenu;
  125. begin
  126.   TWindow.SetupWindow;
  127.   SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'FC_Icon'));
  128.   SetClassWord(HWindow,GCW_HBrBackground,GetStockObject(ltGray_Brush));
  129.   Sysmenu := GetSystemMenu(hWindow,false);
  130.   AppendMenu(SysMenu,MF_Separator,0,nil);
  131.   AppendMenu(Sysmenu,0,id_About,'About...');
  132.   SetHeader('');
  133. end;
  134.  
  135. procedure TFCWindow.SetHeader(Msg:PChar);
  136. var
  137.  Buf:Array[0..200] of Char;
  138.  M:Record
  139.      SC:PChar;
  140.   cFiles:Integer;
  141.  end;
  142. begin
  143.     M.SC := SourceDir;
  144.   M.cFiles := Files^.Count;
  145.   wvsprintf(Buf,'Source:%s    Count:%i',M);
  146.   StH^.SetText(Buf);
  147.   wvsprintf(Buf,'Target:%s',TargetDir);
  148.   StJ^.SetText(Buf);
  149. end;
  150.  
  151. procedure TFCWindow.CMFrom(var Msg:TMessage);
  152. const
  153.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  154. var
  155.     szDirName:Array[0..256] of Char;
  156.   szFile,szFileTitle:Array[0..512] of Char;
  157.   OFN:TOpenFileName;
  158.   P:PChar;
  159.   OldDir:Array[0..fsDirectory] of char;
  160.  Path,PathName:Array[0..69] of Char;
  161.  FName:Array[0..18] of Char;
  162.  pResult:PChar;
  163. begin
  164.     Files^.FreeAll;
  165.     GetCurDir(OldDir,0);
  166.     StrCopy(SourceBuf,'');
  167.   StrCopy(SourceDir,'');
  168.   OFN.lStructSize := sizeof(TOpenFileName);
  169.   OFN.hWndOwner := HWindow;
  170.   OFN.lpStrFilter := @szFilter;
  171.   OFN.lpStrCustomFilter := nil;
  172.   OFN.nMaxCustFilter := 0;
  173.   OFN.nFilterIndex := LongInt(1);
  174.   OFN.lpStrFile := SourceBuf;
  175.   OFN.nMaxFile := 4096;
  176.   OFN.lpstrfileTitle := szFileTitle;
  177.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  178.   OFN.lpstrInitialDir := NIL;
  179.   OFN.lpStrTitle := 'Source Files';
  180.   OFN.flags := OFN_ALLOWMULTISELECT;
  181.   OFN.nFileOffset := 0;
  182.   OFN.nFileExtension := 0;
  183.   OFN.lpstrDefext := nil;
  184.     if GetOpenFileName(OFN)  then
  185.     GetCurDir(SourceDir,0);
  186.  
  187.     if StrLen(SourceBuf) > 0 then
  188.       begin
  189.         pResult := StrScan(SourceBuf,' ');
  190.       if pResult = NIL then                       {1 file only}
  191.           Files^.Insert(StrNew(SourceBuf))
  192.       else                                        {2 or more  }
  193.           begin
  194.         pResult := StrTok(SourceBuf,' ');          {get the path}
  195.         StrCopy(Path,pResult);
  196.         SetCurDir(Path);                          {chdir there}
  197.         pResult := StrTok(NIL,' ');               {get the 1st filename}
  198.         while pResult <> NIL do
  199.             begin
  200.           FileExpand(PathName,pResult);           {expand file name}
  201.             Files^.Insert(StrNew(PathName));        {store it in collection}
  202.             pResult := StrTok(NIL,' ');             {get next file name}
  203.             end;
  204.         end;
  205.     end;
  206.   SetHeader('');
  207. {  SetCurDir(OldDir);}
  208. end;
  209.  
  210. procedure TFCWindow.CMTo(var Msg:TMessage);
  211. const
  212.   szFilter:Array[0..8] of Char ='ALL'#0'*.*'#0#0;
  213. var
  214.     szDirName,TargetBuf:Array[0..256] of Char;
  215.   szFile,szFileTitle:Array[0..512] of Char;
  216.   OFN:TOpenFileName;
  217.   P:PChar;
  218.   OldDir:Array[0..fsDirectory] of char;
  219. begin
  220.     GetCurDir(OldDir,0);
  221.     StrCopy(TargetBuf,'');
  222.   StrCopy(TargetDir,'');
  223.   OFN.lStructSize := sizeof(TOpenFileName);
  224.   OFN.hWndOwner := HWindow;
  225.   OFN.lpStrFilter := @szFilter;
  226.   OFN.lpStrCustomFilter := nil;
  227.   OFN.nMaxCustFilter := 0;
  228.   OFN.nFilterIndex := LongInt(1);
  229.   OFN.lpStrFile := TargetBuf;
  230.   OFN.nMaxFile := sizeOf(TargetBuf);
  231.   OFN.lpstrfileTitle := szFileTitle;
  232.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  233.   OFN.lpstrInitialDir := NIL;
  234.   OFN.lpStrTitle := 'Target Directory';
  235.   OFN.flags := OFN_PATHMUSTEXIST OR OFN_NOVALIDATE;
  236.   OFN.nFileOffset := 0;
  237.   OFN.nFileExtension := 0;
  238.   OFN.lpstrDefext := nil;
  239.     if GetOpenFileName(OFN)  then
  240.     GetCurDir(TargetDir,0);
  241.   SetHeader('');
  242.   SetCurDir(OldDir);
  243. end;
  244.  
  245. procedure TFCWindow.CMCopy(var Msg:TMessage);
  246. begin
  247.     if Files^.Count = 0 then
  248.     MessageBox(HWindow,'Please select files first','Now get this...',MB_ICONSTOP)
  249.     else if StrLen(TargetDir) = 0 then
  250.     MessageBox(HWindow,'Please select target first','Now get this...',MB_ICONSTOP)
  251.   else if StrIComp(SourceDir,TargetDir) = 0 then
  252.       MessageBox(HWindow,'Source & target directories must differ!','Now get this...',MB_ICONSTOP)
  253.   else CopyMove(id_Copy);
  254. end;
  255.  
  256. procedure TFCWindow.CMMove(var Msg:TMessage);
  257. begin
  258.     if Files^.Count = 0 then
  259.     MessageBox(HWindow,'Please select files first','Now get this...',MB_ICONSTOP)
  260.     else if StrLen(TargetDir) = 0 then
  261.     MessageBox(HWindow,'Please select target first','Now get this...',MB_ICONSTOP)
  262.   else if StrIComp(SourceDir,TargetDir) = 0 then
  263.       MessageBox(HWindow,'Source & target directories must differ!','Now get this...',MB_ICONSTOP)
  264.   else CopyMove(id_Move);
  265. end;
  266.  
  267. procedure TFCWindow.CopyMove(ActionType:Integer);
  268. const
  269.     BufLen:Integer = 16384;
  270. var
  271.  Path,Dir,Name,Ext,TPathName:Array[0..69] of Char;
  272.  FName:Array[0..18] of Char;
  273.  pResult:PChar;
  274.  Indx,Error,Dr,MoveCount:Integer;
  275.  F1,F2:File;
  276.  MsgX:Array[0..50] of Char;
  277.  Buffer:PChar;
  278.  Count,BytesRead,FileBytes:LongInt;
  279.  MsgXRec : Record
  280.      CopyCount:Integer;
  281.   Action:PChar;
  282.   TotBytes:LongInt;
  283.  end;
  284.  MsgD:TMsg;
  285.  Meter:PMeterWindow;
  286.  Pct:Integer;
  287.  OutBuf:Array[0..80] of Char;
  288. begin
  289.     Meter:=New(PMeterWindow,Init(@Self,'Copying Files...'));
  290.   Application^.MakeWindow(Meter);
  291.   Meter^.Draw(0); Pct := 0;
  292.     IsActive := True;
  293.   Buffer :=MemAlloc(BufLen);
  294.   MsgXRec.CopyCount := 0;
  295.   MsgXRec.TotBytes := 0;
  296.   Dr := Ord(UpCase(TargetDir[0]));
  297.   for Indx := 0 to (Files^.Count -1) do       {copy the selected files}
  298.       begin
  299.     If (Pct < ((Indx * 100) div Files^.Count)) then
  300.         begin
  301.       Meter^.Draw(Pct);
  302.       Inc(Pct,5);
  303.       end;
  304.     pResult := Files^.At(Indx);
  305.     Assign(F1,PResult);
  306.     FileMode := 0;
  307.     {$I-}
  308.     Reset(F1,1);
  309.     {$I+}
  310.     if IOResult <> 0 then
  311.         begin
  312.       Meter^.CloseWindow;
  313.       wvsprintf(OutBuf,'Error openining file:%s',pResult);
  314.       MessageBox(HWindow,OutBuf,'Copy/Move Aborted',MB_ICONSTOP);
  315.       CleanUp;
  316.            FreeMem(Buffer,Buflen);
  317.       IsActive := False;
  318.         Exit;
  319.       end;
  320.     FileBytes := FileSize(F1);
  321.     if DiskFree(Dr-64) < FileBytes then
  322.         begin
  323.       Meter^.CloseWindow;
  324.       MessageBox(HWindow,'Insufficient Disk Space!','Copy/Move Aborted',MB_ICONSTOP);
  325.             CleanUp;
  326.           FreeMem(Buffer,Buflen);
  327.       IsActive := False;
  328.         Exit;
  329.       end;
  330.     Count := FileBytes;
  331.     BytesRead := 0;
  332.     FileSplit(PResult,Dir,Name,Ext);
  333.     StrCopy(TPathName,TargetDir);
  334.     if TPathName[StrLen(TPathName)-1] = '\' then
  335.         TPathName[StrLen(TPathName)-1] := #0;
  336.     StrCat(StrCat(Strcat(TPathName,'\'),Name),Ext);
  337.     Assign(F2,TPathName);
  338.         {$I-}
  339.     Rewrite(F2,1);
  340.     {$I+}
  341.     if IOResult <> 0 then
  342.         begin
  343.       Meter^.CloseWindow;
  344.       wvsprintf(OutBuf,'Error creating file:%s',TPathName);
  345.       MessageBox(HWindow,OutBuf,'Copy/Move Aborted',MB_ICONSTOP);
  346.       CleanUp;
  347.           FreeMem(Buffer,Buflen);
  348.       IsActive := False;
  349.         Exit;
  350.       end;
  351.     while Count > 0 do
  352.         begin
  353.         if Count > BufLen then Count := BufLen;
  354.         BlockRead(F1,Buffer^,Count);
  355.         BlockWrite(F2,Buffer^,Count);
  356.         BytesRead := BytesRead + Count;
  357.         Count:= FileBytes - BytesRead;
  358.         end    ;
  359.     Close(F1);
  360.     Close(F2);
  361.     Inc(MsgXRec.CopyCount);
  362.     MsgXRec.TotBytes := FileBytes + MsgXRec.TotBytes;
  363.     Take5;
  364.     end;
  365.   MsgXRec.Action := 'copied';
  366.   if ActionType = id_Move then
  367.       begin
  368.       for Indx := 0 to (Files^.Count -1) do       {delete the selected files}
  369.           begin
  370.         pResult := Files^.At(Indx);
  371.         Assign(F1,pResult);
  372.         {$I-}
  373.         Erase(F1);
  374.         {$I+}
  375.         if IOResult <> 0 then
  376.             begin
  377.           Meter^.CloseWindow;
  378.           wvsprintf(OutBuf,'Error erasing file:%s',pResult);
  379.           MessageBox(HWindow,OutBuf,'Copy/Move Aborted',MB_ICONSTOP);
  380.         Cleanup;
  381.               FreeMem(Buffer,Buflen);
  382.           IsActive := False;
  383.             Exit;
  384.           end;
  385.         Inc(MoveCount);
  386.         end;
  387.     MsgXRec.Action := 'moved'
  388.     end;
  389.   Meter^.CloseWindow;
  390.   MsgXRec.TotBytes := MsgXRec.TotBytes div 1024;
  391.   wvsprintf(MsgX,'%i Files %s / %li KB',MsgXRec);
  392.   MessageBox(HWindow,MsgX,'OM File',0);
  393.   FreeMem(Buffer,Buflen);
  394.   CleanUp;
  395.     IsActive := False;
  396. end;
  397.  
  398. procedure TFCWindow.CMDel(var Msg:TMessage);
  399. var
  400.  pResult:PChar;
  401.  Indx,Error,DelCount:Integer;
  402.  F1:File;
  403.  MsgX:Array[0..50] of Char;
  404.  OutBuf:Array[0..80] of Char;
  405. begin
  406.     DelCount := 0;
  407.     if Files^.Count = 0 then
  408.       begin
  409.     MessageBox(HWindow,'Please select files first','Now get this...',MB_ICONSTOP);
  410.     Exit;
  411.     end;
  412.   for Indx := 0 to (Files^.Count -1) do       {process the selected files}
  413.       begin
  414.     pResult := Files^.At(Indx);
  415.     Assign(F1,pResult);
  416.         Assign(F1,pResult);
  417.         {$I-}
  418.         Erase(F1);
  419.         {$I+}
  420.         if IOResult <> 0 then
  421.             begin
  422.           wvsprintf(OutBuf,'Error erasing file:%s',pResult);
  423.           MessageBox(HWindow,OutBuf,'Erase Aborted',MB_ICONSTOP);
  424.         CleanUp;
  425.           IsActive := False;
  426.             Exit;
  427.           end;
  428.     Inc(DelCount);
  429.     end;
  430.   wvsprintf(MsgX,'%i Files deleted',DelCount);
  431.   MessageBox(HWindow,MsgX,'File Delete',0);
  432.   CleanUp;
  433. end;
  434.  
  435. procedure TFCWindow.CMExxit(var Msg:TMessage);
  436. begin
  437.     CloseWindow;
  438. end;
  439.  
  440. procedure    TFCWindow.WMSysCommand(var Msg:TMessage);
  441. begin
  442.     case Msg.Wparam of
  443.         id_About:
  444.              application^.ExecDialog(New(PDialog,Init(@Self,'FC_About')));
  445.        else
  446.            DefWndProc(Msg);
  447.        end;
  448. end;
  449.  
  450. function TFCWindow.CanClose:Boolean;
  451. begin
  452.     if IsActive = True then
  453.       CanClose := False
  454.   else
  455.       CanClose := TWindow.CanClose;
  456. end;
  457.  
  458. procedure TFCWindow.CleanUp;
  459. begin
  460.   Files^.FreeAll;
  461.   StrCopy(SourceDir,'');
  462.   StrCopy(TargetDir,'');
  463.   SetHeader('');
  464. end;
  465.  
  466. end.
  467.