Emitir Carta, Executando Win-Word em Run Time pelo Delphi
Olá, boa tarde!
Tenho o seguinte problema.
Tenho uma rotina q emite carta usando o Winword em modo oculto, até ai tudo bem, funciona normalmente.
O problema é q quando fecho a aplicacao o WinWord continua ainda na memoria e seu eu executar novamente um novo processar é gerado e consecutivamente.
Alguem saberia como fechar a aplicacao Word q esta na memoria?
a quem puder responder, desde ja meus agradecimentos.
100+
ANT.CARLOS/SP
===============================================
procedure TFdlg_Carta_anivers.Imprimir();
var MSWord : Variant;
Dtextenso : String;
Ano : Word;
Anox : Word;
mes : Word;
Dia : Word; // Usadas para calculo da idade
Dtanivers : String; begin Try
Try
MsWord := CreateOleObject('Word.Basic');
Except on E: Exception do Begin
ShowMessage('Houve o seguinte erro ao tentar inicializar o Microsoft Word : '+#13+E.message);
abort;
Exit;
End;
End; Sql_Dados.First;
While Not Sql_Dados.eof do Begin
try
MSWord.FileNew(Diretorio+'\Carta_aniversario.DOC');
except
on E: Exception do begin
ShowMessage('Não foi possível criar um novo documento a partir do modelo devido ao seguinte erro: #13+e.message);
abort;
end;
end; try
{O primeiro parâmetro é a palavra que deverá ser encontrada no
documento original e que será substituida pelo segundo parâmetro}
MsWord.EditReplace('<Nome>',Sql_Dados.FieldByName('Nome').AsString,,,,,,,,1);
MsWord.EditReplace('<Cep>',Sql_Dados.FieldByname('Cep').asString,,,,,,,,1); DecodeDate(Date,Ano,Mes,Dia);
Anox := Ano;
DecodeDate(Sql_Dados.FieldByname('Dtnasc').asDateTime,Ano,Mes,Dia);
Dtanivers := FormatFloat('00',Dia)+'/'+FormatFloat('00',Mes)+'/'+FormatFloat('00',Anox);
Dtextenso := Trim(DMEMP.Sql_PesqEmpCidade.value)+'/'+DMEMP.Sql_PesqEmpUf.value+', '+DataExtenso (Date);
MsWord.EditReplace('<Dtextenso>',Dtextenso,,,,,,,,1);
MsWord.EditReplace('<Dtanivers>',Dtanivers,,,,,,,,1);
MsWord.EditReplace('<Empresa>',DMEMP.Sql_PesqEmpadraoFantasia.value,,,,,,,,1); MSWord.FilePrintDefault; {Imprime utilizando a impressora default} MSWord.FileClose(2); {Finaliza o word sem salvar o documento criado}
except
on E: Exception do begin
Screen.Cursor := crDefault;
ShowMessage(E.Message);
end;
end;
Sql_Dados.Next;
End;
Finally
MSWord.FileClose(2); {Finaliza o word se houver algum erro}
Sql_Dados.close;
End;
End;
===============================================
var MSWord : Variant;
Dtextenso : String;
Ano : Word;
Anox : Word;
mes : Word;
Dia : Word; // Usadas para calculo da idade
Dtanivers : String; begin Try
Try
MsWord := CreateOleObject('Word.Basic');
Except on E: Exception do Begin
ShowMessage('Houve o seguinte erro ao tentar inicializar o Microsoft Word : '+#13+E.message);
abort;
Exit;
End;
End; Sql_Dados.First;
While Not Sql_Dados.eof do Begin
try
MSWord.FileNew(Diretorio+'\Carta_aniversario.DOC');
except
on E: Exception do begin
ShowMessage('Não foi possível criar um novo documento a partir do modelo devido ao seguinte erro: #13+e.message);
abort;
end;
end; try
{O primeiro parâmetro é a palavra que deverá ser encontrada no
documento original e que será substituida pelo segundo parâmetro}
MsWord.EditReplace('<Nome>',Sql_Dados.FieldByName('Nome').AsString,,,,,,,,1);
MsWord.EditReplace('<Cep>',Sql_Dados.FieldByname('Cep').asString,,,,,,,,1); DecodeDate(Date,Ano,Mes,Dia);
Anox := Ano;
DecodeDate(Sql_Dados.FieldByname('Dtnasc').asDateTime,Ano,Mes,Dia);
Dtanivers := FormatFloat('00',Dia)+'/'+FormatFloat('00',Mes)+'/'+FormatFloat('00',Anox);
Dtextenso := Trim(DMEMP.Sql_PesqEmpCidade.value)+'/'+DMEMP.Sql_PesqEmpUf.value+', '+DataExtenso (Date);
MsWord.EditReplace('<Dtextenso>',Dtextenso,,,,,,,,1);
MsWord.EditReplace('<Dtanivers>',Dtanivers,,,,,,,,1);
MsWord.EditReplace('<Empresa>',DMEMP.Sql_PesqEmpadraoFantasia.value,,,,,,,,1); MSWord.FilePrintDefault; {Imprime utilizando a impressora default} MSWord.FileClose(2); {Finaliza o word sem salvar o documento criado}
except
on E: Exception do begin
Screen.Cursor := crDefault;
ShowMessage(E.Message);
end;
end;
Sql_Dados.Next;
End;
Finally
MSWord.FileClose(2); {Finaliza o word se houver algum erro}
Sql_Dados.close;
End;
End;
===============================================
Antonio Jesus
Curtidas 0
Respostas
Leandro
18/05/2011
MSWord.Quit;
se nao me ingano é isso.
se nao me ingano é isso.
GOSTEI 0
Antonio Jesus
18/05/2011
Olá,
Não funcionou, apresentou a msg:
veja na imagem em anexo.
já tentei com MSWord.close, quit, .Free, FreeAndNil(x) e nada, sempe causa um erro.
obrigado!
ANT.CARLOS/SP
GOSTEI 0
Wilson Junior
18/05/2011
De uma olhada neste link http://delphi.about.com/cs/adptips2003/a/bltip0303_5.htm
Espero ter colaborado.
Espero ter colaborado.
GOSTEI 0
Antonio Jesus
18/05/2011
Olá, obrigado pela atenção de todos, mas decobri um meio pratico.
100+
ANT.CARTLOS/SP
-------------------------------------------------------------
interface
uses
ShellAPI, TLHelp32, PsAPI, ShellAPI, TLHelp32, PsAPI;
function TerminateProcesso(sFile: string): Bool;
var
verSystem: TOSVersionInfo;
hdlSnap,hdlProcess: THandle;
bPath,bLoop: Bool;
peEntry: TProcessEntry32;
arrPid: array [0..1023] of DWord;
iC: DWord;
k,iCount: Integer;
arrModul: array [0..299] of Char;
hdlModul: HMODULE;
begin
// sFile := "WINWORD.EXE";
result:=false;
if ExtractFileName(sFile)=sFile then
bPath:=false
else
bPath:=true;
verSystem.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
GetVersionEx(verSystem);
if verSystem.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS then
begin
hdlSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
peEntry.dwSize:=Sizeof(peEntry);
bLoop:=Process32First(hdlSnap,peEntry);
while integer(bLoop)0 do
begin
if bPath then
begin
if CompareText(peEntry.szExeFile,sFile)=0 then
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID) ,0);
result:=true;
end;
end
else
begin
if CompareText(ExtractFileName(peEntry.szExeFile),sFile)=0 then
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID) ,0);
result:=true;
end;
end;
bLoop:=Process32Next(hdlSnap,peEntry);
end;
CloseHandle(hdlSnap);
end
else
if verSystem.dwPlatformId=VER_PLATFORM_WIN32_NT then
begin
EnumProcesses(@arrPid,SizeOf(arrPid),iC);
iCount:=iC div SizeOf(DWORD);
for k:=0 to Pred(iCount) do
begin
hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid [k]);
if (hdlProcess0) then
begin
EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC);
GetModuleFilenameEx(hdlProcess,hdlModul,arrModul,SizeOf(arrModul));
if bPath then
begin
if CompareText(arrModul,sFile)=0 then
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid [k]), 0);
result:=true;
end;
end
else
begin
if CompareText(ExtractFileName(arrModul),sFile)=0 then
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid [k]), 0);
result:=true;
end;
end;
CloseHandle(hdlProcess);
end;
end;
end;
end;
100+
ANT.CARTLOS/SP
-------------------------------------------------------------
interface
uses
ShellAPI, TLHelp32, PsAPI, ShellAPI, TLHelp32, PsAPI;
function TerminateProcesso(sFile: string): Bool;
var
verSystem: TOSVersionInfo;
hdlSnap,hdlProcess: THandle;
bPath,bLoop: Bool;
peEntry: TProcessEntry32;
arrPid: array [0..1023] of DWord;
iC: DWord;
k,iCount: Integer;
arrModul: array [0..299] of Char;
hdlModul: HMODULE;
begin
// sFile := "WINWORD.EXE";
result:=false;
if ExtractFileName(sFile)=sFile then
bPath:=false
else
bPath:=true;
verSystem.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
GetVersionEx(verSystem);
if verSystem.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS then
begin
hdlSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
peEntry.dwSize:=Sizeof(peEntry);
bLoop:=Process32First(hdlSnap,peEntry);
while integer(bLoop)0 do
begin
if bPath then
begin
if CompareText(peEntry.szExeFile,sFile)=0 then
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID) ,0);
result:=true;
end;
end
else
begin
if CompareText(ExtractFileName(peEntry.szExeFile),sFile)=0 then
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID) ,0);
result:=true;
end;
end;
bLoop:=Process32Next(hdlSnap,peEntry);
end;
CloseHandle(hdlSnap);
end
else
if verSystem.dwPlatformId=VER_PLATFORM_WIN32_NT then
begin
EnumProcesses(@arrPid,SizeOf(arrPid),iC);
iCount:=iC div SizeOf(DWORD);
for k:=0 to Pred(iCount) do
begin
hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid [k]);
if (hdlProcess0) then
begin
EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC);
GetModuleFilenameEx(hdlProcess,hdlModul,arrModul,SizeOf(arrModul));
if bPath then
begin
if CompareText(arrModul,sFile)=0 then
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid [k]), 0);
result:=true;
end;
end
else
begin
if CompareText(ExtractFileName(arrModul),sFile)=0 then
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid [k]), 0);
result:=true;
end;
end;
CloseHandle(hdlProcess);
end;
end;
end;
end;
GOSTEI 0