#include "shell.ch"
#include "fileio.ch"
#include "topconn.ch"
#include "protheus.ch"
#DEFINE _OPC_cGETFILE ( GETF_RETDIRECTORY + GETF_LOCALFLOPPY + GETF_LOCALHARD + GETF_NETWORKDRIVE + GETF_SHAREAWARE )
#DEFINE BMPNAME_SIZE 20
/*
Progama: U_ImgN2CPF.prg
Funcao: U_ImgN2CPF()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Importação das Imagens dos Funcionarios (Fotos) para a tabela PROTHEUS_REPOSIT considerando: Nome Completo ou CPF
Sintaxe: U_ImgN2CPF([<cEmp>],[<cFil>])
*/
User Function ImgN2CPF(cEmp,cFil)
Local aEmps := Array(0)
Local aModName := RetModName(.T.)
Local cMod := "GPE"
Local bExec := {||ImgN2CPF(@oProcess,@aEmps,@aModName,@cMod)} Local oProcess := MsNewProcess():New( bExec , OemToAnsi( "Carregando CPF/CIC nos Arquivos de Imagens" ) , "Aguarde..." , .T. )
Private adbQueryTmp := Array(0)
BEGIN SEQUENCE
IF .NOT.(Empty(ProcName(1)))
ApMsgAlert(OemToAnsi("Chamada de Procedimento Inválido."+CRLF+"Esta rotina não pode ser executada a partir do menu"),OemToAnsi("ATENÇÂO")) BREAK
EndIF
DEFAULT cEmp := GetSrvProfString("ImgN2CPFEmp","02") DEFAULT cFil := GetSrvProfString("ImgN2CPFFil","00")
__cINTERNET := NIL
MsAguarde({||_RpcSetEnv(@aModName,@cEmp,@cFil,NIL,NIL,@cMod)},"Preparando Ambiente","Aguarde...")
SM0->( dbGoTop() )
While SM0->( .NOT.( Eof() ) )
SM0->( aAdd( aEmps , Recno() ) )
SM0->( dbSkip() )
End While
RpcClearEnv()
oProcess:Activate()
IF .NOT.( oProcess:lEnd )
oProcess:oDlg:End()
EndIF
oProcess := FreeObj(oProcess)
RpcClearEnv()
END SEQUENCE
aEval( adbQueryTmp , { |cAlias| IF( ( Select( cAlias ) > 0 ) , (cAlias)->( dbCloseArea() ) , NIL ) } )
Return(NIL)
/*
Progama: U_ImgN2CPF.prg
Funcao: ImgN2CPF()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Processa e Importação das Imagens conforme Empresas
Sintaxe: ImgN2CPF(oProcess,aEmps)
*/
Static Function ImgN2CPF(oProcess,aEmps,aModName,cMod)
Local aFiles := Array(0)
Local aFTree := Array(0)
Local cEmp
Local cFil
Local cMask := "*"
Local cFullMask := "("+cMask+")|"+cMask+"|" Local cDefPath := "SERVIDOR\RHDOCS\RHFOTOS\"
Local cPath := cGetFile(cFullMask,OemToAnsi("Selecione Diretorio"),NIL,cDefPath,.F.,_OPC_cGETFILE,.T.,.T.) Local cFSource := cPath
Local cDTarget
Local cMaskBMP := ( cMask + ".BMP" )
Local cFile
Local cCICFile
Local cSQLName
Local cFullName
Local cPathFile
Local cName
Local cQuery
Local cAlias
Local cRACIC
Local cRAFilial
Local nFile
Local nFiles
Local nRACIC
Local nRARecno
Local cRmtDrv := GetRemoteIniName()
Local cSPDrive
Local cSPPath
Local cSPFile
Local cSPExt
Local nEmp
Local nEmps
Local lRepInDB := ( GetSrvProfString("RepositInDataBase","0") == "1" )
BEGIN SEQUENCE
IF .NOT.( lRepInDB )
MsgInfo( OemToAnsi("RepositInDataBase Não Ativo." ) , OemToAnsi( "A T E N Ç Ã O" ) ) BREAK
EndIF
IF Empty( cPath )
MsgInfo( OemToAnsi( "Não foi possível encontrar o diretório de imagens" ) , OemToAnsi( "A T E N Ç Ã O" ) )
BREAK
EndIF
aAdd( aFTree , "\RHDOCS\" )
aAdd( aFTree , "\RHDOCS\RHFOTOS\" )
aAdd( aFTree , "\RHDOCS\RHFOTOS\JPG\" )
aAdd( aFTree , "\RHDOCS\RHFOTOS\BMP\" )
aAdd( aFTree , "\RHDOCS\RHFOTOS\BMP\IMPORTADOS\" )
aAdd( aFTree , "\RHDOCS\RHFOTOS\BKP\" )
aEval(aFTree,{|cDirectory|IF(.NOT.(lIsDir(cDirectory)),MakeDir(cDirectory),NIL)})
SplitPath(cRmtDrv,@cSPDrive,@cSPPath,@cSPFile,@cSPExt)
cRmtDrv := cSPDrive
cDTarget := cRmtDrv+"\RHDOCS\RHFOTOS\BMP\"
cDefPath := cRmtDrv+"\RHDOCS\RHFOTOS\"
aEval(aFTree,{|cDirectory|IF(.NOT.(lIsDir(cRmtDrv+cDirectory)),MakeDir(cRmtDrv+cDirectory),NIL)})
cDTarget := cRmtDrv+"\RHDOCS\RHFOTOS\BMP\"
MsAguarde({||PSJPG2BMP(@cFSource,@cDTarget)},"Convertendo Arquivo(s)","Aguarde...")
nEmps := Len(aEmps)
oProcess:SetRegua1(nEmps)
oProcess:SetRegua2(0)
For nEmp := 1 To nEmps
IF ( Select("SM0") == 0 ) OpenSM0()
EndIF
SM0->( dbGoTo( aEmps[nEmp] ) )
cEmp := SM0->M0_CODIGO
cFil := SM0->M0_CODFIL
oProcess:IncRegua1("Empresa:["+cEmpAnt+"]/Filial:["+cFilAnt+"]")
cPath := cDTarget
cPathFile := ( cPath + cMaskBMP )
aSize( aFiles , 0 )
nFiles := aDir( cPathFile , @aFiles )
IF ( nFiles == 0 )
Loop
EndIF
oProcess:IncRegua2("RpcSetEnv:["+cEmp+"]/["+cFil+"]") _RpcSetEnv(@aModName,@cEmp,@cFil,NIL,NIL,@cMod)
cEmpAnt := cEmp
cFilAnt := cFil
cSQLName := RetSQLName("SRA")
SX3->( dbSetOrder(3)) //X3_CAMPO
IF SX3->( dbSeek( "RA_BITMAP", .F. ) )
IF .NOT.( SX3->X3_TAMANHO == BMPNAME_SIZE )
IF SX3->( rLock() )
SX3->X3_TAMANHO := BMPNAME_SIZE
SX3->( dbUnLock() )
cQuery := "ALTER TABLE "+cSQLName+" ALTER COLUMN "+cSQLName+".RA_BITMAP VARCHAR("+AllTrim(Str(BMPNAME_SIZE))+") NOT NULL" TCSQLExec(cQuery)
TCRefresh(cSQLName)
EndIF
EndIF
EndIF
IF ( lRepInDB )
OpenRepositDB()
EndIF
ChkFile("SRA")
nRACIC := GetSx3Cache("RA_CIC","X3_TAMANHO") cRAFilial := xFilial("SRA")
oProcess:SetRegua2( nFiles )
For nFile := 1 To nFiles
cFile := aFiles[nFile]
oProcess:IncRegua2("Processando:["+Lower(cFile)+"]") cFullName := (cPath+cFile)
cName := Upper( AllTrim( cFile ) )
cName := AllTrim(StrTran(cName,".BMP",""))
cQuery := "SELECT RA_CIC, R_E_C_N_O_ FROM "+cSQLName+" WHERE "+cSQLName+".RA_NOME LIKE '%"+cName+"%' AND "+cSQLName+".RA_FILIAL='"+cRAFilial+"' AND "+cSQLName+".D_E_L_E_T_<>'*'"
IF .NOT.(dbQuery(@cQuery,@cAlias))
cName := SubStr(cName,1,nRACIC)
cQuery := "SELECT RA_CIC, R_E_C_N_O_ FROM "+cSQLName+" WHERE "+cSQLName+".RA_CIC='"+cName+"' AND "+cSQLName+".RA_FILIAL='"+cRAFilial+"' AND "+cSQLName+".D_E_L_E_T_<>'*'"
IF .NOT.(dbQuery(@cQuery,@cAlias))
Loop
EndIF
EndIF
cRACIC := (cAlias)->RA_CIC
nRARecno := (cAlias)->R_E_C_N_O_
IF Empty( cRACIC )
Loop
EndIF
IF File( cFullName )
SplitPath(cFullName,@cSPDrive,@cSPPath,@cSPFile,@cSPExt)
cCICFile := cSPDrive
cCICFile += cSPPath
cCICFile += cRACIC
cCICFile += cSPExt
IF .NOT.( cFullName == cCICFile )
fReName(cFullName,cCICFile)
EndIF
SRA->( dbGoTo( nRARecno ) )
IF DlgPutImg(@cCICFile,@lRepInDB,@nRARecno)
cQuery := "UPDATE "+cSQLName+" SET "+cSQLName+".RA_BITMAP='"+cRACIC+"' WHERE "+cSQLName+".R_E_C_N_O_="+Str(nRARecno)
TCSQLExec(cQuery)
EndIF
EndIF
Next nFile
cQuery := "SELECT RA_CIC, RA_BITMAP, R_E_C_N_O_ FROM "+cSQLName+" WHERE "+cSQLName+".RA_FILIAL='"+cRAFilial+"' AND "+cSQLName+".D_E_L_E_T_<>'*' AND "+cSQLName+".RA_CIC<>RA_BITMAP"
IF .NOT.(dbQuery(@cQuery,@cAlias))
Loop
EndIF
oProcess:SetRegua2(0)
While (cAlias)->( .NOT.( Eof() ) )
cRACIC := (cAlias)->RA_CIC
oProcess:IncRegua2("CHK CPF:["+cRACIC+"]") nRARecno := (cAlias)->R_E_C_N_O_
cFile := cDTarget
cFile += cRACIC
cFile += ".bmp"
IF File(cFile)
cQuery := "SELECT DISTINCT BMPNAME FROM PROTHEUS_REPOSIT PRT WHERE PRT.BMPNAME='"+cRACIC+"' AND PRT.D_E_L_E_T_<>'*' AND PRT.ALIAS='SRA' AND PRT.MODULO='GPE'"
IF dbQuery(@cQuery)
cQuery := "UPDATE "+cSQLName+" SET "+cSQLName+".RA_BITMAP='"+cRACIC+"' WHERE "+cSQLName+".R_E_C_N_O_="+Str(nRARecno)
TCSQLExec(cQuery)
EndIF
EndIF
(cAlias)->( dbSkip() )
End While
TCRefresh(cSQLName)
RpcClearEnv()
Next nEmp
END SEQUENCE
Return(NIL)
/*
Progama: U_ImgN2CPF.prg
Funcao: DlgPutImg()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Monta Dialog para Inserção da Imagem no Repositório usando TBmpRep
Sintaxe: DlgPutImg(cCICFile,lRepInDB,nRARecno)
*/
Static Function DlgPutImg(cCICFile,lRepInDB,nRARecno)
Local cTitle
Local bDialogInit
Local oDlg
Local oRepository
Local lPutOk := .T.
SRA->( MsGoTo( nRARecno ) )
cTitle := AllTrim( SRA->RA_NOME )
DEFINE MSDIALOG oDlg FROM 0,0 TO 0,0 PIXEL TITLE cTitle
@ 0,0 REPOSITORY oRepository SIZE 0,0 OF oDlg NOBORDER WHEN .F. PIXEL
lPutOk := PutImg(@oRepository,@cCICFile,@lRepInDB)
bDialogInit := { || oDlg:End() } ACTIVATE MSDIALOG oDlg ON INIT Eval( bDialogInit )
Return( lPutOk )
/*
Progama: U_ImgN2CPF.prg
Funcao: PutImg()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Inserir as Imagens no PROTHEUS_REPOSIT
Sintaxe: PutImg(oRepository,cCICFile,lRepInDB)
*/
Static Function PutImg(oRepository,cCICFile,lRepInDB)
Local cQuery
Local cSRABitMap
Local lPutOk := .F.
Local lPut := .T.
Local lLock := .F.
Local lAllOk := .F.
BEGIN SEQUENCE
IF .NOT.( lPutOk := File(cCICFile) )
BREAK
EndIF
cSRABitMap := RetFileName( cCICFile )
lPutOk := (cSRABitMap==AllTrim(oRepository:InsertBmp(cCICFile,NIL,@lPut,"SRA")))
IF ( ( lPutOk ) .and. .NOT.( lPut ) )
IF ( lRepInDB )
cQuery := "SELECT DISTINCT BMPNAME FROM PROTHEUS_REPOSIT PRT WHERE PRT.BMPNAME='"+cSRABitMap+"' AND PRT.D_E_L_E_T_<>'*' AND PRT.ALIAS='SRA'"
lPut := dbQuery(@cQuery)
IF ( lPut )
cQuery := "UPDATE PROTHEUS_REPOSIT SET PROTHEUS_REPOSIT.MODULO='GPE' WHERE PROTHEUS_REPOSIT.MODULO<>'GPE' AND PROTHEUS_REPOSIT.BMPNAME='"+cSRABitMap+"' AND PROTHEUS_REPOSIT.D_E_L_E_T_<>'*' AND PROTHEUS_REPOSIT.ALIAS='SRA'"
TCSQLExec(cQuery)
EndIF
EndIF
EndIF
IF (;
( lPutOk ); //Obtido a partir do Teste de Retorno do Metodo :InsertBmp()
.and.;
( lPut ); //Retornado por referencia pelo Metodo :InsertBmp() .T. Inseriu a Nova Imagem, caso contrario, .F.
)
IF SRA->( lLock := RecLock("SRA",.F.)) SRA->RA_BITMAP := cSRABitMap
SRA->( MsUnLock() )
EndIF
EndIF
END SEQUENCE
lAllOk := (;
( lPutOk ); //Obtido a partir do Teste de Retorno do Metodo :InsertBmp()
.and.;
( lPut ); //Retornado por referencia pelo Metodo :InsertBmp() .T. Inseriu a Nova Imagem, cMDJ contrario, .F.
.and.;
( lLock ); //Gravou a Referencia da Imagem no SRA ( Cadastro de Funcionarios )
)
Return( lAllOk )
/*
Progama: U_ImgN2CPF.prg
Funcao: dbQuery()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Providenciar um Alias Valido para Abertura da View
Sintaxe: dbQuery(cQuery,cAlias)
*/
Static Function dbQuery(cQuery,cAlias)
DEFAULT cAlias := GetNextAlias()
IF ( Select( @cAlias ) > 0 )
( cAlias )->( dbCloseArea() )
EndIF
TCQUERY ( cQuery ) ALIAS ( cAlias ) NEW
IF ( Type("adbQueryTmp")=="A" ) IF ( aScan( adbQueryTmp , { |e| ( e == cAlias ) } ) == 0 ) aAdd( adbQueryTmp , cAlias )
EndIF
EndIF
Return( .NOT.( ( cAlias )->( Bof() .and. Eof() ) ) )
/*
Progama: U_ImgN2CPF.prg
Funcao: PSJPG2BMP()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Providenciar Script em PowerShell para a Conversão das Imagens de JPG para BMP e para o Redimensionamento.
Sintaxe: PSJPG2BMP(cFSource,cDTarget)
*/
Static Function PSJPG2BMP(cFSource,cDTarget)
Return(StaticCall(U_PSJPG2BMP,PSJPG2BMP,@cFSource,@cDTarget))
Static Function _RpcSetEnv(aModName,cRPCEmp,cRPCFil,cEnvUser,cEnvPass,cEnvMod,cFunName,aTables,lShowFilial,lAbend,lOpenSX,lConnect)
RpcSetType(3)
RpcSetEnv(@cRPCEmp,@cRPCFil,@cEnvUser,@cEnvPass,@cEnvMod,@cFunName,@aTables,@lShowFilial,@lAbend,@lOpenSX,@lConnect)
SetsDefault()
CriaPublica()
__cINTERNET := NIL
__lPYME := .F.
SetModulo("SIGAGPE",cEnvMod) nModulo := aScan( aModName , { |e| e[6] == IF(Type("nModulo")=="N",nModulo,7) } ) oApp:cModulo := StrTran(aModName[nModulo][2],"SIGA","")
oApp:cModDesc := aModName[nModulo][3]
oApp:cModName := aModName[nModulo][2]
oApp:nModulo := nModulo
oApp:nMDIModulo := nModulo
Return(NIL)
Ola. Com a proteção agora de THREAD JOB NÃO CRIAR INTERFACE, ou seja, não pode ter nenhum objeto visual(tipo dialog) em job, como inserir no repositório as imagens, visto que TBmpRep ser um objeto tDialog?
ResponderExcluirOla. Com a proteção agora de thread em job não ter objetos visuais. como inserir a imagem no repositório utilizando o TBmpRep, que é um objeto tDialog
ResponderExcluirhttps://centraldeatendimento.totvs.com/hc/pt-br/articles/360022439332-MP-ADVPL-ERRO-JOB-THREADS-DOESN-T-SUPPORT-REMOTE-VISUAL-COMPONENTS