Alexandre,
Abandondei o getenv e agora estou usando uma pasta especial fixa para tratar os arquivos de impressão, o meu problema e desafio agora é fazer a impressão funcionar.
Na rotina "Impressao()" no trecho "IF Len(aFiles1) > 0 ... FOR A:=1 TO Len(aFiles1)" funciona, a leitura do arquivo está ok mas mas não há impressão!!!
Será que é porque está rodando como serviço e os recursos de win_prn() não funcionam?
Uma nova informação: a função WIN_PrinterGetDefault() não está pegando a impressora padrão e é por isso que não está imprimindo, a função pegou outra impressora e
ficou louca rodando dentro do serviço.#include "inkey.ch"
#include "setcurs.ch"
#include "error.ch"
#include "achoice.ch"
#include "fileio.ch"
#include "common.ch"
#include "dbinfo.ch"
#include "hbver.ch"
#include "hbdyn.ch"
#include "wvtwin.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
#include "hbcompat.ch"
#include "windows.ch"
#include "hbhrb.ch"
#include "directry.ch"
#include "hbwin.ch"
#define _SERVICE_NAME "PrintWIN"
PROCEDURE WinMain( cMode )
LOCAL nError
LOCAL cMsg
//LOCAL fhnd := hb_FCreate( hb_dirBase() + "svcini.out", FC_NORMAL, FO_DENYNONE + FO_WRITE )
//cPastaTemp:=Upper(GetEnv("TEMP"))
//FWrite( fhnd, "Startup " + cPastaTemp + hb_eol() )
//FClose( fhnd )
//aDir1:=Directory(cPastaTemp+HB_PS()+"*.PF")
//aFiles1:={}
//IF Len(aDir1) > 0
// AEval(aDir1,{|f| AAdd(aFiles1,{Upper(cPastaTemp+HB_PS()+f[F_NAME]), DTOS(f[F_DATE])+" "+f[F_TIME],Upper(f[F_NAME]),f[F_SIZE]})})
// ASort( aFiles1 ,,, {|x,y| y[2] > x[2] } )
//ENDIF
//IF Len(aDir1) > 0
// HWG_MsgInfo("Lista de Diretórios")
//ENDIF
hb_default( @cMode, "S" ) /* NOTE: Must be the default action */
SWITCH Upper( cMode )
CASE "I"
IF win_serviceInstall( _SERVICE_NAME, "PrintWin" )
HWG_MsgInfo("O serviço foi instalado com sucesso.")
ELSE
nError := wapi_GetLastError()
cMsg := Space( 128 )
wapi_FormatMessage( ,,,, @cMsg )
HWG_MsgInfo("Error installing service: " + hb_ntos( nError ) + " " + cMsg)
ENDIf
EXIT
CASE "D"
IF win_serviceDelete( _SERVICE_NAME )
HWG_MsgInfo("O Serviço foi deletado.")
ELSE
nError := wapi_GetLastError()
cMsg := Space( 128 )
wapi_FormatMessage( ,,,, @cMsg )
HWG_MsgInfo("Error deleting service: " + hb_ntos( nError ) + " " + cMsg)
ENDIf
EXIT
CASE "S"
/* NOTE: Used when starting up as service.
Do not invoke the executable manually with this option */
IF win_serviceStart( _SERVICE_NAME, @SrvMain() )
HWG_MsgInfo("Service has started OK")
ELSE
nError := wapi_GetLastError()
cMsg := Space( 128 )
wapi_FormatMessage( ,,,, @cMsg )
HWG_MsgInfo("Service has had some problems: " + hb_ntos( nError ) + " " + cMsg)
ENDIF
EXIT
ENDSWITCH
RETURN
PROCEDURE SrvMain()
LogSis("Serviço Iniciado em "+HB_DTOC(Date(),"DD/MM/YY")+" "+Time(),HB_DIRBASE()+"LOGSRV.LOG")
DO WHILE win_serviceGetStatus() == WIN_SERVICE_RUNNING
Impressao()
hb_idleSleep( 5 )
ENDDO
LogSis("Serviço terminado em "+HB_DTOC(Date(),"DD/MM/YY")+" "+Time(),HB_DIRBASE()+"LOGSRV.LOG")
win_serviceSetExitCode( 0 )
win_serviceStop()
RETURN
FUNCTION Impressao
LOCAL aDir1, aDir2, aDir3, aDir4, aFiles1, aFiles2, aFiles3, aFiles4, oErro, A
LOCAL nMaxLine, nLin, cLinha, lEject, nTam14, nTam15, nTam16, nTam17, nTam18, nTam20, nChr27, nTamPCL10, nTamPCL18, nTam
LOCAL oPrn, VM_nNormal, cTam, lNegrito, aVetor
LOCAL cPastaTemp:=""
MEMVAR cArqPrint, cPrinter
cPastaTemp:="D:\TEMPIMP"
IF !IsDirectory( cPastaTemp )
DirMake(cPastaTemp)
ENDIF
TRY
aDir1:=Directory(cPastaTemp+HB_PS()+"TXT_*.PF")
aDir2:=Directory(cPastaTemp+HB_PS()+"PCL_*.PF")
aDir3:=Directory(cPastaTemp+HB_PS()+"MAC_*.PF")
aDir4:=Directory(cPastaTemp+HB_PS()+"USU_*.PF")
ASort( aDir1 ,,, {|x,y| DTOS(y[3])+y[4] > DTOS(x[3])+x[4] } )
ASort( aDir2 ,,, {|x,y| DTOS(y[3])+y[4] > DTOS(x[3])+x[4] } )
ASort( aDir3 ,,, {|x,y| DTOS(y[3])+y[4] > DTOS(x[3])+x[4] } )
ASort( aDir4 ,,, {|x,y| DTOS(y[3])+y[4] > DTOS(x[3])+x[4] } )
aFiles1:={}
IF Len(aDir1) > 0
AEval(aDir1,{|f| AAdd(aFiles1,{Upper(cPastaTemp+HB_PS()+f[F_NAME]), DTOS(f[F_DATE])+" "+f[F_TIME],Upper(f[F_NAME]),f[F_SIZE]})})
ASort( aFiles1 ,,, {|x,y| y[2] > x[2] } )
ENDIF
aFiles2:={}
IF Len(aDir2) > 0
AEval(aDir2,{|f| AAdd(aFiles2,{Upper(cPastaTemp+HB_PS()+f[F_NAME]), DTOS(f[F_DATE])+" "+f[F_TIME],Upper(f[F_NAME]),f[F_SIZE]})})
ASort( aFiles2 ,,, {|x,y| y[2] > x[2] } )
ENDIF
aFiles3:={}
IF Len(aDir3) > 0
AEval(aDir3,{|f| AAdd(aFiles3,{Upper(cPastaTemp+HB_PS()+f[F_NAME]), DTOS(f[F_DATE])+" "+f[F_TIME],Upper(f[F_NAME]),f[F_SIZE]})})
ASort( aFiles3 ,,, {|x,y| y[2] > x[2] } )
ENDIF
aFiles4:={}
IF Len(aDir4) > 0
AEval(aDir4,{|f| AAdd(aFiles3,{Upper(cPastaTemp+HB_PS()+f[F_NAME]), DTOS(f[F_DATE])+" "+f[F_TIME],Upper(f[F_NAME]),f[F_SIZE]})})
ASort( aFiles4 ,,, {|x,y| y[2] > x[2] } )
ENDIF
IF Len(aFiles1) > 0
FOR A:=1 TO Len(aFiles1)
TRY
cPrinter:=WIN_PrinterGetDefault()
oPrn:=Win_Prn():New(cPrinter)
oPrn:LandScape := .F.
oPrn:FormType := WIN_DMPAPER_A4
oPrn:Copies := 1
oPrn:LeftMargin:= 0
IF !oPrn:Create()
BREAK
ENDIF
IF !oPrn:StartDoc("ImpressÆo do arquivo "+aFiles1[A,3])
BREAK
ENDIF
oPrn:SetPrc(1.2,0) // 1.2
nTam :=11
VM_nNormal :=12
lNegrito :=.F.
lEject :=.F.
cTam :=""
oPrn:SetFont("Courier New",VM_nNormal,0,.F.,.F.)
FT_FUSE( aFiles1[A,1] )
aVetor:={0,0}
DO WHILE !FT_FEOF()
cLinha:=FT_FREADLN()
lEject:=(Chr(12) $ cLinha) // Procura caracter EJECT
cLinha:=StrTran( cLinha, Chr(12)) // Elimina caracter EJECT
cLinha:=StrTran( cLinha, Chr(13))
nTam14 := AT(Chr(14),cLinha)
nTam15 := AT(Chr(15),cLinha)
nTam16 := AT(Chr(16),cLinha)
nTam17 := AT(Chr(17),cLinha)
nTam18 := AT(Chr(18),cLinha)
nTam20 := AT(Chr(20),cLinha)
IF nTam14 > 0 //60 CPL
oPrn:LineHeight := Int( oPrn:PixelsPerInchY / 5 ) // 10 Default 6 lines per inch == # of pixels per line
cLinha:=StrTran(cLinha, Chr(14))
cLinha:=LTrim(cLinha)
VM_nNormal:=16
aVetor:={0,0}
aVetor:={VM_nNormal,-126}
ENDIF
IF nTam15 > 0 //140 CPL
oPrn:LineHeight := Int( oPrn:PixelsPerInchY / 10 ) // 10 Default 6 lines per inch == # of pixels per line
cLinha:=StrTran(cLinha, Chr(15))
cLinha:=LTrim(cLinha)
VM_nNormal:=7.0
aVetor:={0,0}
aVetor:={VM_nNormal,-126}
//aVetor:={3,-16.66}
ENDIF
IF nTam16 > 0 //120 CPL
oPrn:LineHeight := Int( oPrn:PixelsPerInchY / 10 ) // 10 Default 6 lines per inch == # of pixels per line
cLinha:=StrTran(cLinha, Chr(16))
cLinha:=LTrim(cLinha)
VM_nNormal:=8
aVetor:={0,0}
aVetor:={VM_nNormal,-126}
ENDIF
IF nTam17 > 0 //96 CPL
oPrn:LineHeight := Int( oPrn:PixelsPerInchY / 7 ) // 10 Default 6 lines per inch == # of pixels per line
cLinha:=StrTran(cLinha, Chr(17))
cLinha:=LTrim(cLinha)
VM_nNormal:=10
aVetor:={0,0}
aVetor:={VM_nNormal,-126}
ENDIF
IF nTam18 > 0 //80 CPL
oPrn:LineHeight := Int( oPrn:PixelsPerInchY / 6 ) // 10 Default 6 lines per inch == # of pixels per line
cLinha:=StrTran(cLinha, Chr(18))
cLinha:=LTrim(cLinha)
VM_nNormal:=12
aVetor:={0,0}
aVetor:={VM_nNormal,-126}
ENDIF
IF nTam20 > 0 //160 CPL
oPrn:LineHeight := Int( oPrn:PixelsPerInchY / 10 ) // 10 Default 6 lines per inch == # of pixels per line
cLinha:=StrTran(cLinha, Chr(20))
cLinha:=LTrim(cLinha)
VM_nNormal:=6.5
aVetor:={0,0}
aVetor:={VM_nNormal,-126}
ENDIF
oPrn:SetFont("Courier New",VM_nNormal,aVetor,0,.F.,.F.)
oPrn:Bold(0) // Normal
oPrn:SetPos( 15 )
oPrn:TextOut(cLinha,.T.)
FT_FSKIP()
IF lEject .AND. !FT_FEOF()
oPrn:NewPage()
oPrn:SetPrc(1.2,0) //1.2
ENDIF
IF (oPrn:MaxRow() - 2) <= oPrn:Prow() // Usa "oPrinter:NewPage()" para iniciar nova pagina
oPrn:NewPage()
oPrn:SetPrc(1.2,0) // 2.2
ENDIF
ENDDO
FT_FUSE()
oPrn:EndDoc()
oPrn:Destroy() // destroi a classe
CATCH oErro
FT_FUSE()
FERASE(aFiles1[A,1])
oPrn:EndDoc()
oPrn:Destroy() // destroi a classe
FINALLY
FERASE(aFiles1[A,1])
FERASE(StrTran(aFiles1[A,1],".PI",".PF"))
END
NEXT
ENDIF
IF Len(aFiles2) > 0
FOR A:=1 TO Len(aFiles2)
cArqPrint:=aFiles2[A,1]
cPrinter:=WIN_PrinterGetDefault()
ImprimeRaw(cArqPrint,cPrinter)
FErase(aFiles2[A,1])
NEXT
ENDIF
IF Len(aFiles3) > 0
FOR A:=1 TO Len(aFiles3)
cArqPrint:=aFiles3[A,1]
cPrinter:=WIN_PrinterGetDefault()
ImprimeRaw(cArqPrint,cPrinter)
FErase(aFiles3[A,1])
NEXT
ENDIF
IF Len(aFiles4) > 0
FOR A:=1 TO Len(aFiles4)
cArqPrint:=aFiles4[A,1]
cPrinter:=WIN_PrinterGetDefault()
ImprimeRaw(cArqPrint,cPrinter)
FErase(aFiles4[A,1])
NEXT
ENDIF
CATCH oErro
FINALLY
END
RETURN Nil
FUNCTION LogSis(cEvento,cArqLog)
HB_Default(@cArqLog,"SISTEMA.LOG")
IF !File(cArqLog)
EscreveLinha(cEvento,cArqLog)
ELSE
AbreLinha(1,cArqLog)
EscreveLinha(cEvento,cArqLog)
ENDIF
RETURN Nil
FUNCTION AbreLinha(nLinha,cArq)
LOCAL I
HB_Default(@nLinha,1)
FOR I:=1 TO nLinha
StrFile(""+HB_EOL(),cArq,.T.)
NEXT
RETURN Nil
FUNCTION EscreveLinha(cVar,cArq)
StrFile(cVar,cArq,.T.)
RETURN Nil
FUNCTION ImprimeRaw(cArqImp,cPrinter)
LOCAL cMsg:="", nRet
nRet:=WIN_PrintFileRaw(cPrinter,cArqImp,'PRINTWIN')
IF nRet < 0
cMsg := 'Erro Imprimindo: '+Str(nRet)+" "
SWITCH nRet
CASE -1
cMsg+="Parâmetros in lidos passados para função." ; EXIT
CASE -2
cMsg+="WinAPI OpenPrinter() falha na chamada." ; EXIT
CASE -3
cMsg+="WinAPI StartDocPrinter() falha na chamada." ; EXIT
CASE -4
cMsg+="WinAPI StartPagePrinter() falha na chamada." ; EXIT
CASE -5
cMsg+="WinAPI malloc() falha de memória." ; EXIT
CASE -6
cMsg+="Arquivo " + cArqImp + " não LOCALIZADO." ; EXIT
END
ENDIF
RETURN Nil
FUNCTION MyRun( cComando )
LOCAL oShell, lOk:=.T.
TRY
oShell:=CreateObject( "WScript.Shell" )
CATCH
TRY
oShell:=CreateObject( "WScript.Shell" )
CATCH
lOk:=.F.
END
END
IF lOk
TRY
oShell:Run( "%comspec% /c " + cComando, 0, .T. )
CATCH
lOk:=.F.
END
oShell:=Nil
ENDIF
RETURN lOk
INIT FUNCTION AppSetup()
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850
HB_LANGSELECT("PT")
HB_CDPSELECT( "PT850" )
REQUEST DBFCDX
RddSetDefault("DBFCDX")
SETMODE(25,80)
SET CENTURY ON
SET EPOCH TO 1920
CLS
IniciaJanela()
RETURN Nil
FUNCTION IniciaJanela(nLi,nCi,nLf,nCf)
LOCAL oCrt
HB_Default(@nLi,0)
HB_Default(@nCi,0)
HB_Default(@nLf,MaxRow())
HB_Default(@nCf,MaxCol())
cTituloJanela:="Teste Serviço de Impressão"
HB_gtInfo(HB_GTI_FONTNAME, "Lucida Console")
HB_gtInfo(HB_GTI_WINTITLE, cTituloJanela)
HB_gtInfo(HB_GTI_CLOSABLE, .F. )
HB_gtInfo(HB_GTI_CLIPBOARDDATA )
HB_gtInfo(HB_GTI_SELECTCOPY, .T. )
HB_gtInfo(HB_GTI_MOUSESTATUS, 1 )
HB_gtInfo(HB_GTI_ISGRAPHIC, .T. )
HB_gtInfo(HB_GTI_STDERRCON, .T. )
HB_gtInfo(HB_GTI_COMPATBUFFER, .T. )
HB_gtInfo(HB_GTI_SPEC, HB_GTS_WNDSTATE, HB_GTS_WS_MAXIMIZED )
RETURN Nil
