VPF::Doc2Txt - Форум программистов

MastaSlash

Дата 15.6.2006, 23:10 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 26.5.2006

Репутация: нет
Всего: нет

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj, ShlObj;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var Form1: TForm1;

implementation

{$R *.dfm}

function Select_Dir(Form: TForm): string;
var
  TitleName, s: string;
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  BrowseInfo.hwndOwner := Form.Handle;
  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := 'Выберите папку :';
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId<>nil then
  begin
    SHGetPathFromIDList(lpItemID, TempPath);
    s:=TempPath ;
    if s[length(s)]<>'\' then Result:=s+'\'
      else Result:=s;
    GlobalFreePtr(lpItemID);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     if not(DirectoryExists(ExtractFilePath(Application.ExeName)+'TXT'))then
       CreateDir(ExtractFilePath(Application.ExeName)+'TXT');
end;

procedure TForm1.Button1Click(Sender: TObject);
var Docs_Dir,Text_Dir,new_name: string;
    WordApp: Variant;
    sr: TSearchRec;
begin
     Docs_Dir:=Select_Dir(Form1);
     Text_Dir:=ExtractFilePath(Application.ExeName)+'TXT';
     if Docs_Dir='' then Exit;
     FindFirst(Docs_Dir+'*.doc',faArchive,sr);
     WordApp:=CreateOleObject('Word.Basic');
     repeat
           new_name:=ChangeFileExt(sr.Name,'.txt');
           WordApp.FileOpen(Docs_Dir+sr.Name);
           WordApp.FileSaveAs(Name:=Text_Dir+'\'+new_name, Format := 2);
     until FindNext(sr)<>0;
     WordApp.AppClose;
     WordApp:= Unassigned;
     FindClose(sr);
end;

end.

Поимогите избавится от мигания при конвертировании.
Если кто знает как можно сделать другим путем, пишите ...

Добавлено @ 23:11
Есть еще у меня такая функция:

Код


function ConvertDoc2Rtf(var FileName: string) : Boolean;
var
  oWord: OleVariant; 
  oDoc: OleVariant; 
begin 
  Result := False;
  try
    oWord := GetActiveOleObject('Word.Application');
  except 
    oWord := CreateOleObject('Word.Application'); 
  end; 
  oWord.Documents.Open(FileName);
  oDoc  := oWord.ActiveDocument; 
  FileName := ChangeFileExt(FileName, '.rtf'); 
  oDoc.SaveAs(FileName);
  oWord.ActiveDocument.Close(EmptyParam, EmptyParam);
  oWord.Quit(EmptyParam, EmptyParam, EmptyParam);
  oDoc := VarNull; 
  oWord := VarNull;
  Result := True; 
end;

тоже не работает по какой-то причине .... может кому удастся исправить???

MastaSlash

Дата 15.6.2006, 23:27 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 26.5.2006

Репутация: нет
Всего: нет

чтоб посмотреть как программа работает нужно указать папку с несколькими файлами (*.doc)

Dynamic

Дата 16.6.2006, 11:44 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 372
Регистрация: 5.7.2004
Где: Салехард

Репутация: 12
Всего: 15

Цитата(MastaSlash @ 15.6.2006, 23:10

)

Поимогите избавится от мигания при конвертировании.

не понял - что мигает?

Цитата(MastaSlash @ 15.6.2006, 23:10

)

     repeat
           new_name:=ChangeFileExt(sr.Name,'.txt');
           WordApp.FileOpen(Docs_Dir+sr.Name);
           WordApp.FileSaveAs(Name:=Text_Dir+'\'+new_name, Format := 2);
     until FindNext(sr)<>0;

1. документ открывается, пересохраняется и НЕ закрывается.
2. Application.ProcessMessages добавь, что ли...

--------------------

Было бы о чем молчать, а уж что сказать – всегда найдется...

MastaSlash

Дата 16.6.2006, 12:28 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 26.5.2006

Репутация: нет
Всего: нет

Цитата(Dynamic @ 16.6.2006, 11:44

)

2. Application.ProcessMessages добавь, что ли...

уже добавлял ... не помогло ( ...

Добавлено @ 12:31

Цитата(Dynamic @ 16.6.2006, 11:44

)

1. документ открывается, пересохраняется и НЕ закрывается.

70: WordApp.AppClose; а это тогда что ???

Albinos_x

Дата 16.6.2006, 18:51 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 26
Всего: 108

Код

...
WordApp.visible:=false;
...

пробовал?

Добавлено @ 19:02

Цитата(MastaSlash @ 15.6.2006, 23:10

)

Есть еще у меня такая функция:

Цитата

begin
  Result := False;
  try
    oWord := GetActiveOleObject('Word.Application');
  except
    oWord := CreateOleObject('Word.Application');
  end;

ну судя по содержанию... тут присоединение к запущенному серверу идёт... а если не запущен, то запускает, но вот дальше никаких действий не предвидится... т.к. последнее происходит при возникновении ошибки и соответственно просто после запуска сразу выход из функции...

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Albinos_x

Дата 16.6.2006, 19:33 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 26
Всего: 108

если хочешь проверить на запущенность Ворда, то лучше использовать отдельные функции... к примеру:

Код


function WordRunning:Boolean;    
var    
 temp: Variant;    
begin    
  try    
    temp := GetActiveOleObject('Word.Application');    
    Result := true;    
  except    
   Result := false;    
 end;    
end;

или

Код


procedure TForm1.Button1Click(Sender: TObject);    
var    
  Unknown: IUnknown;    
  Result: HResult;    
begin    
  Result := GetActiveObject(ProgIDToClassID('Word.Application'), nil, Unknown);    
  if Result = MK_E_UNAVAILABLE then    
    ShowMessage('Закрыт')    
  else    
    ShowMessage('Открыт')    
end;

и т.д. и т.п...

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

tripsin

Дата 16.6.2006, 21:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 38
Регистрация: 10.4.2005
Где: Талица

Репутация: нет
Всего: 3

Про мигание:
WordApp.ScreenUpdating = False - отключить обновление экрана
WordApp.ScreenUpdating = True - включить обратно

Dynamic

Дата 19.6.2006, 06:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 372
Регистрация: 5.7.2004
Где: Салехард

Репутация: 12
Всего: 15

Цитата(MastaSlash @ 16.6.2006, 12:28

)

70: WordApp.AppClose; а это тогда что ???

А это ты ПОСЛЕ всех конвертаций закрываешь сам ворд, а не отдельные документы. Хотя, если обрабатывается 5-10 файлов, то это, в принципе, не страшно.

--------------------

Было бы о чем молчать, а уж что сказать – всегда найдется...

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »