home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / HTMLmove / Wizmain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-02-15  |  8.4 KB  |  313 lines
  1. unit Wizmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Sprites, Spritebx, Buttons,
  8.   StdCtrls, ComCtrls, FileCtrl, Convertr, Menus, DirNav,
  9.   NewParse, HtmlTool;
  10.  
  11. type
  12.   TWizardMain = class(TForm)
  13.     Panel1: TPanel;
  14.     Panel2: TPanel;
  15.     SpriteBox1: TSpriteBox;
  16.     Sprite1: TSprite;
  17.     Notebook1: TNotebook;
  18.     Label2: TLabel;
  19.     Label1: TLabel;
  20.     ListBox1: TListBox;
  21.     Label3: TLabel;
  22.     Label12: TLabel;
  23.     DirNavigator1: TDirNavigator;
  24.     Image1: TImage;
  25.     BitBtn4: TBitBtn;
  26.     BitBtn5: TBitBtn;
  27.     BitBtn6: TBitBtn;
  28.     BitBtn7: TBitBtn;
  29.     Edit1: TEdit;
  30.     SpeedButton2: TSpeedButton;
  31.     Label4: TLabel;
  32.     Label11: TLabel;
  33.     SpeedButton3: TSpeedButton;
  34.     Label10: TLabel;
  35.     ListBox3: TListBox;
  36.     Memo1: TMemo;
  37.     Edit2: TEdit;
  38.     Label6: TLabel;
  39.     BitBtn1: TBitBtn;
  40.     SaveDialog1: TSaveDialog;
  41.     procedure Navigator1BtnClick(Sender: TObject);
  42.     procedure Notebook1PageChanged(Sender: TObject);
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure DirNavigator1Recurse(Sender: TObject);
  45.     procedure DirNavigator1BeforeNavigate(Sender: TObject);
  46.     procedure DirNavigator1AfterNavigate(Sender: TObject);
  47.     procedure FormDestroy(Sender: TObject);
  48.     procedure SpeedButton2Click(Sender: TObject);
  49.     procedure SpeedButton3Click(Sender: TObject);
  50.     procedure BitBtn1Click(Sender: TObject);
  51.   private
  52.     { Private declarations }
  53.     LogList: TStringList;
  54.     procedure MoveFiles;
  55.     procedure FixExternalLinks;
  56.   public
  57.     { Public declarations }
  58.     procedure DoMoveFile(FromName, ToName: TFileName);
  59.     procedure DoConvertFiles(FromName, ToName: TFileName; FromPath, ToPath: string);
  60.   end;
  61.  
  62. var
  63.   WizardMain: TWizardMain;
  64.  
  65. implementation
  66.  
  67. {$R *.DFM}
  68.  
  69. procedure TWizardMain.Navigator1BtnClick(Sender: TObject);
  70. begin
  71.   case (Sender as TBitBtn).Tag of
  72.     0: NoteBook1.PageIndex := NoteBook1.PageIndex-1;
  73.     1: NoteBook1.PageIndex := NoteBook1.PageIndex+1;
  74.     2: ModalResult := mrOK;
  75.     3: ModalResult := mrCancel;
  76.   end;
  77. end;
  78.  
  79. procedure TWizardMain.Notebook1PageChanged(Sender: TObject);
  80. begin
  81.   Sprite1.Enabled := false;
  82.   Image1.Visible := true;
  83.   case Notebook1.PageIndex of
  84.     2: begin
  85.          Screen.Cursor := crHourGlass;
  86.          try
  87.            ListBox3.Clear;
  88.            DirNavigator1.Navigate;
  89.          finally
  90.            Screen.Cursor := crDefault;
  91.          end;
  92.        end;
  93.     3: begin
  94.          Screen.Cursor := crHourGlass;
  95.          try
  96.            MoveFiles;
  97.            FixExternalLinks;
  98.            Memo1.Lines.Clear;
  99.            Memo1.Lines.Assign(LogList);
  100.            BitBtn4.Enabled := false;
  101.            BitBtn7.Enabled := false;
  102.          finally
  103.            Screen.Cursor := crDefault;
  104.          end;
  105.        end;
  106.     4: begin
  107.          Sprite1.Enabled := true;
  108.          Image1.Visible := false;
  109.          BitBtn5.Enabled := false;
  110.          BitBtn6.Enabled := true;
  111.        end;
  112.   end;
  113. end;
  114.       
  115. procedure TWizardMain.FormCreate(Sender: TObject);
  116. begin
  117.   BitBtn6.Enabled := false;
  118.   Edit1.Text := GetCurrentDir;
  119.   Edit2.Text := GetCurrentDir;
  120.   LogList := TStringList.Create;
  121. end;
  122.  
  123. procedure TWizardMain.FormDestroy(Sender: TObject);
  124. begin
  125.   LogList.Free;
  126. end;
  127.  
  128. procedure TWizardMain.FixExternalLinks;
  129. var
  130.   i: integer;
  131.   F: TextFile;
  132. begin
  133.   for i := 0 to ListBox3.Items.Count-1 do
  134.   begin
  135.     SysUtils.DeleteFile(ChangeFileExt(ListBox3.Items[i], '.bak'));
  136.     AssignFile(F, ListBox3.Items[i]);
  137.     Rename(F, ChangeFileExt(ListBox3.Items[i], '.bak'));
  138.     LogList.Add(Format('Created backup file %s',
  139.       [ChangeFileExt(ListBox3.Items[i], '.bak')]));
  140.     // source is the backup, dest is the original file
  141.     // path to convert to abs is DirectoryListBox1.Directory
  142.     // reference path is ListBox3.Items[i]
  143.     DoConvertFiles(ChangeFileExt(ListBox3.Items[i], '.bak'),
  144.       ListBox3.Items[i], Edit1.Text, ListBox3.Items[i]);
  145.   end;
  146.   MessageBeep(MB_OK);
  147. end;
  148.  
  149. procedure TWizardMain.DoConvertFiles(FromName, ToName: TFileName; FromPath, ToPath: string);
  150. var
  151.   Source, Dest: TFileStream;
  152.   Corrector: THtmlFileCorrector;
  153. begin
  154.   ChDir(ExtractFilePath(FromName));
  155.   Source := TFileStream.Create(FromName, fmOpenRead);
  156.   Dest := TFileStream.Create(ToName, fmCreate or fmOpenWrite);
  157.   try
  158.     Corrector := THtmlFileCorrector.CreateNew(Source, Dest);
  159.     Corrector.OldLinks.Assign(Listbox1.Items);
  160.     Corrector.SrcPath := FromPath;
  161.     Corrector.DestPath := ToPath;
  162.     try
  163.       Corrector.Convert;
  164.       LogList.Add(Format('Converted %s to %s', [FromName, ToName]));
  165.     finally
  166.       Corrector.Free;
  167.     end;
  168.   finally
  169.     Source.Free;
  170.     Dest.Free;
  171.   end;
  172. end;
  173.  
  174. procedure TWizardMain.DoMoveFile(FromName, ToName: TFileName);
  175. var
  176.   Source, Dest: TFileStream;
  177.   Mover: THtmlFileMover;
  178. begin
  179.   ChDir(ExtractFilePath(FromName));
  180.   Source := TFileStream.Create(FromName, fmOpenRead);
  181.   Dest := TFileStream.Create(ToName, fmCreate or fmOpenWrite);
  182.   try
  183.     Mover := THtmlFileMover.CreateNew(Source, Dest);
  184.     Mover.SrcPath := ExtractFilePath(FromName);
  185.     Mover.DestPath := ExtractFilePath(ToName);
  186.     Mover.NoChangeList.Assign(Listbox1.Items);
  187.     try
  188.       Mover.Convert;
  189.       LogList.Add(Format('Moved %s to %s', [FromName, ToName]));
  190.     finally
  191.       Mover.Free;
  192.     end;
  193.   finally
  194.     Source.Free;
  195.     Dest.Free;
  196.   end;
  197.   SysUtils.DeleteFile(FromName);
  198. end;
  199.  
  200. procedure TWizardMain.MoveFiles;
  201. var
  202.   i: integer;
  203. begin
  204.   for i := 0 to Listbox1.Items.Count-1 do
  205.   begin
  206.     if Edit1.Text[Length(Edit1.Text)] <> '\' then
  207.       DoMoveFile(ListBox1.Items.Strings[i],
  208.         Edit1.Text+'\'+ExtractFileName(ListBox1.Items.Strings[i]))
  209.     else
  210.       DoMoveFile(ListBox1.Items.Strings[i],
  211.         Edit1.Text+ExtractFileName(ListBox1.Items.Strings[i]));
  212.   end;
  213.   BitBtn4.Enabled := false;
  214.   BitBtn6.Enabled := true;
  215.   MessageBeep(MB_OK);
  216. end;
  217.  
  218. procedure TWizardMain.DirNavigator1Recurse(Sender: TObject);
  219. var
  220.   LocalDir: String;
  221.   Sr: TSearchRec;
  222.   DosError: integer;
  223.   AStream: TFileStream;
  224.   Parser: THtmlParser;
  225.  
  226.   function InList(AName: string): boolean;
  227.   var
  228.     i: integer;
  229.   begin
  230.     Result := false;
  231.     for i := 0 to ListBox1.Items.Count-1 do
  232.       if Pos(uppercase(ExtractFileName(Listbox1.Items[i])), uppercase(AName)) <> 0 then
  233.       begin
  234.         Result := true;
  235.         Exit;
  236.       end;
  237.   end;
  238.  
  239. begin
  240.   LocalDir := ExpandFileName('.');
  241.   if LocalDir[Length(LocalDir)] <> '\' then
  242.     LocalDir := LocalDir + '\';
  243.   DosError := FindFirst('*.htm', faArchive, Sr);
  244.   while DosError = 0 do with Sr do
  245.   begin
  246.     if not InList(Name) then // if not one of the files being moved then ...
  247.     begin
  248.       AStream := TFileStream.Create(LocalDir+Name, fmOpenRead);
  249.       try
  250.         Parser := THtmlParser.Create(AStream);
  251.         try
  252.           while (Parser.Token <> toEof) do
  253.           begin
  254.             if (((Pos('A HREF="', UpperCase(Parser.TokenString)) > 0)) and
  255.               (not ((Pos('MAILTO', UpperCase(Parser.TokenString)) > 0) or
  256.                   (Pos('HTTP', UpperCase(Parser.TokenString)) > 0) or
  257.                     (Pos('NEWS', UpperCase(Parser.TokenString)) > 0)))) then
  258.             begin
  259.               if InList(Parser.TokenString) then // if reference is to one of the files being moved then...
  260.               begin
  261.                 ListBox3.Items.Add(LocalDir+Name);
  262.                 Break;
  263.               end;
  264.             end;
  265.             Parser.NextToken;
  266.             Application.ProcessMessages;
  267.           end;
  268.         finally
  269.           Parser.Free;
  270.         end;
  271.       finally
  272.         AStream.Free;
  273.       end;
  274.     end;
  275.     DosError := FindNext(Sr);
  276.   end;
  277.   SysUtils.FindClose(Sr);
  278. end;
  279.  
  280. procedure TWizardMain.DirNavigator1BeforeNavigate(Sender: TObject);
  281. begin
  282.   ChDir(Edit2.Text);
  283. end;
  284.  
  285. procedure TWizardMain.DirNavigator1AfterNavigate(Sender: TObject);
  286. begin
  287.   MessageBeep(MB_OK);
  288. end;
  289.  
  290. procedure TWizardMain.SpeedButton2Click(Sender: TObject);
  291. var
  292.   Dir: string;
  293. begin
  294.   if SelectDirectory('Select Destination', '', Dir) then
  295.     Edit1.Text := Dir;
  296. end;
  297.  
  298. procedure TWizardMain.SpeedButton3Click(Sender: TObject);
  299. var
  300.   Dir: string;
  301. begin
  302.   if SelectDirectory('Select Destination', '', Dir) then
  303.     Edit2.Text := Dir;
  304. end;
  305.  
  306. procedure TWizardMain.BitBtn1Click(Sender: TObject);
  307. begin
  308.   if SaveDialog1.Execute then
  309.     Memo1.Lines.SaveToFile(SaveDialog1.FileName);
  310. end;
  311.  
  312. end.
  313.