exportfavorites.pas

Delphi VCL Component Pack

            MakeBookmark(UrlRec);
         TraverseFavList(Idx + 1, PrevIdx);
      end;
end;

procedure TExportFavorite.MakeDocumentTop;
begin
   BmkList.Add('<!-- Made with ' + Application.Title + ' -->');
   BmkList.Add('');
   BmkList.Add('<TITLE>' + 'Exported Favorites' + '</TITLE>');
   BmkList.Add('<H1>' + 'Exported Favorites' + '</H1>');
   BmkList.Add('');
   BmkList.Add('<DL><P>');
end;

procedure TExportFavorite.MakeDocumentBottom;
begin
   BmkList.Add('');
   BmkList.Add('</DL><P>');
end;

procedure TExportFavorite.MakeHeaderTop(UrlRec: PUrlRec);
var
   I, Idx: Integer;
   S: string;
   A: array[0..255] of Char;
begin
   FillChar(A, SizeOf(A), 0);
   Idx := 1;
   for I := 1 to Length(UrlRec.Rep) do
      if UrlRec.Rep[I] = '\' then
         Idx := I + 1;
   for I := Idx to Length(UrlRec.Rep) do
      A[I - Idx] := UrlRec.Rep[I];
   BmkList.Add('');
   for I := 1 to UrlRec.Level do
      S := S + '    ';
   BmkList.Add(S + '<DT><H3>' + A + '</H3>');
   BmkList.Add(S + '<DL><P>');
end;

procedure TExportFavorite.MakeHeaderBottom(UrlRec: PUrlRec);
var
   I: Integer;
   S: string;
begin
   for I := 1 to UrlRec.Level do
      S := S + '    ';
   BmkList.Add(S + '</DL><P>');
   BmkList.Add('');
end;

procedure TExportFavorite.MakeBookmark(UrlRec: PUrlRec);
var
   I: Integer;
   S: string;
begin
   Delete(UrlRec.UrlName, Length(UrlRec.UrlName), 1);
   for I := 1 to UrlRec.Level do
      S := S + '    ';
   BmkList.Add(S + '<DT><A HREF="' + UrlRec.UrlPath + '">' +
      UrlRec.UrlName + '</A>' + '<BR>');
end;

function SortFunction(Item1, Item2: Pointer): Integer;
var
   Rec1, Rec2: PUrlRec;
begin
   Result := 0;
   Rec1 := Item1;
   Rec2 := Item2;
   if Rec1.Rep < Rec2.Rep then
      Result := -1;
   if Rec1.Rep > Rec2.Rep then
      Result := 1;
   if Rec1.Rep = Rec2.Rep then
      begin
         if Rec1.UrlName < Rec2.UrlName then
            Result := -1;
         if Rec1.UrlName > Rec2.UrlName then
            Result := 1;
         if Rec1.UrlName = Rec2.UrlName then
            Result := 0;
      end;
end;

procedure TExportFavorite.MakeBookmarkFile;
begin
   if fTargetPath = '' then
      begin
         MessageDlg('The target path is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   if fTargetFileName = '' then
      begin
         MessageDlg('The target file name is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   if not (pos('htm', fTargetFileName) > 1) then
      begin
         MessageDlg('The target file name extention is invalid.' + #10 + #13 + 'Please change it to "*.htm".', mtError, [MbOk], 0);
         exit;
      end;
   if fFavoritesPath = '' then
      begin
         MessageDlg('The Location path is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   if fSuccessMessage.Text = '' then
      begin
         MessageDlg('You must enter a message or turn off messages.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   NavigatePath := fTargetPath + '\' + fTargetFileName;
   BmkList := TStringList.Create;
   MakeDocumentTop;
   TraverseFavList(0, -1);
   MakeDocumentBottom;
   try
      BmkList.SaveToFile(NavigatePath);
   except on EFCreateError do
         begin
            MessageDlg('The target file name is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         end;
   end;
   BmkList.Free;
   if ShowSuccessMessage then
      MessageDlg(SuccessMessage.Text + 'The file name is: ' + NavigatePath, mtInformation, [MbOk], 0);
   if assigned(fStatusBar) then
      fStatusBar.SimpleText := SuccessMessage.Text + 'The file name is: ' + NavigatePath;
end;

procedure TExportFavorite.ExportFavorites;
var
   I: Integer;
begin
   if not Enabled then
      Exit;
   FavList := TList.Create;
   if fFavoritesPath = 'Auto' then
      GetFavoritesFolder
   else
      FavFolder := fFavoritesPath;
   if (FavFolder <> '') then
      begin
         SearchURL(FavFolder, 1);
         FavList.Sort(SortFunction);
         MakeBookmarkFile;
         SuccessFlag := true;
         if fExploreFavFileFolder then
            ShellExecute(Forms.Application.Handle, 'explore', Pchar(fTargetPath), nil,
               nil, SW_SHOWNORMAL);
         if fNavigateOnComplete then
            if Assigned(fWebBrowser) then
               fWebBrowser.Navigate(fTargetPath + fTargetFileName)
            else
               MessageDlg(ASS_MESS, mtError, [MbOk], 0);
      end
   else
      begin
         MessageDlg('The favorites file path is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   for I := 0 to FavList.Count - 1 do
      Dispose(PUrlRec(FavList[I]));
   FavList.Free;
end;

procedure TExportFavorite.ExportFavoritesToIni;
var
   I: Integer;
  // ini : TIniFile;
begin
   if not Enabled then
      Exit;
   FavList := TList.Create;
   if fFavoritesPath = 'Auto' then
      GetFavoritesFolder
   else
      FavFolder := fFavoritesPath;
   if (FavFolder <> '') then
      begin
         SearchURL(FavFolder, 1);
         FavList.Sort(SortFunction);
         //--------
    if fTargetPath = '' then
      begin
         MessageDlg('The target path is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   if fTargetFileName = '' then
      begin
         MessageDlg('The target file name is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   if fFavoritesPath = '' then
      begin
         MessageDlg('The Location path is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   if fSuccessMessage.Text = '' then
      begin
         MessageDlg('You must enter a message or turn off messages.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   NavigatePath := fTargetPath + '\' + fTargetFileName;
   BmkList := TStringList.Create;
   //Ini := TIniFile.create(fTargetPath);


   SuccessFlag := true;
         if fExploreFavFileFolder then
            ShellExecute(Forms.Application.Handle, 'explore', Pchar(fTargetPath), nil,
               nil, SW_SHOWNORMAL);
         if fNavigateOnComplete then
            if Assigned(fWebBrowser) then
               fWebBrowser.Navigate(fTargetPath + fTargetFileName)
            else
               MessageDlg(ASS_MESS, mtError, [MbOk], 0);
      end
   else
      begin
         MessageDlg('The favorites file path is invalid.' + #10 + #13 + 'Please change it.', mtError, [MbOk], 0);
         exit;
      end;
   for I := 0 to FavList.Count - 1 do
      Dispose(PUrlRec(FavList[I]));
   FavList.Free;
end;

end.