BlackTDN :: GPE : PowerShell e RepositInDataBase para o gerenciamento das imagens dos funcionários
Exemplo de Importação de imagens para o cadastro de funcionários utilizando integração com o Windows PowerShell para conversão de arquivos jpg para bmp e redimensionamento das imagens.
Dependências:
- A chave RepositInDataBase deverá ser habilitada no appserver. Ex.: RepositInDataBase=1;
- O smartclient.exe deverá constar na lista de programas para os quais o DEP não será aplicado;
- Para conversão e importação em lote, programa U_ImgN2CPF.prg , as seguintes chaves deverão estar definidas no appserver:
- ImgN2CPFEmp (para definir a empresa que será utilizado na preparação do ambiente). Ex.: ImgN2CPFEmp=”01”;
- ImgN2CPFFil (para definir a filial que será utilizada na preparação do ambiente). Ex.: ImgN2CPFFil=”01”;
- As imagens a serem importadas deverão estar, preferencialmente, abaixo da seguinte estrutura:
- \RHDOCS\RHFOTOS\JPG (para arquivos no formato jpg);
- \RHDOCS\RHFOTOS\BMP\ (para arquivos no formato bmp);
- Obs.: A rotina irá criar essa estrutura tanto no Cliente (mesmo drive de instalação do remote), quanto no Servidor
- O tamanho do campo RA_BITMAP deverá ser equivalente ao tamanho do campo BMPNAME da tabela PROTHEUS_REPOSIT.
Ao que interessa: O código.
#include "shell.ch"
#include "fileio.ch"
#include "protheus.ch"
/*
Progama: U_PSJPG2BMP.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: StaticCall(U_PSJPG2BMP,PSJPG2BMP,@cFSource,@cDTarget)
*/
Static Function PSJPG2BMP(cFSource,cDTarget)
Local cPSS := ""
Local cCRLF := CRLF
Local cPSSPath := GetTempPath()
Local cPSSFile := "PSJPG2BMP.PS1"
Local cCmd
Local cPSSFullP
IF .NOT.( SubStr( cPSSPath , -1 ) == "\" )
cPSSPath += "\"
EndIF
cPSSFullP := cPSSPath
cPSSFullP += cPSSFile
cPSS += '#http://gallery.technet.microsoft.com/scriptcenter/Resize-Image-File-f6dd4a56' + cCRLF
cPSS += 'Function Set-ImageSize' + cCRLF
cPSS += '{' + cCRLF
cPSS += ' [CmdletBinding(' + cCRLF
cPSS += ' SupportsShouldProcess=$True,' + cCRLF
cPSS += ' ConfirmImpact="Low"' + cCRLF
cPSS += ' )]' + cCRLF
cPSS += ' Param' + cCRLF
cPSS += ' (' + cCRLF
cPSS += ' [parameter(Mandatory=$true,' + cCRLF
cPSS += ' ValueFromPipeline=$true,' + cCRLF
cPSS += ' ValueFromPipelineByPropertyName=$true)]' + cCRLF
cPSS += ' [Alias("PSImageSize")]' + cCRLF
cPSS += ' [String[]]$FullName,' + cCRLF
cPSS += ' [String]$Destination = $(Get-Location),' + cCRLF
cPSS += ' [Switch]$Overwrite,' + cCRLF
cPSS += ' [Int]$WidthPx,' + cCRLF
cPSS += ' [Int]$HeightPx,' + cCRLF
cPSS += ' [Int]$DPIWidth,' + cCRLF
cPSS += ' [Int]$DPIHeight,' + cCRLF
cPSS += ' [Switch]$FixedSize,' + cCRLF
cPSS += ' [Switch]$RemoveSource' + cCRLF
cPSS += ' )' + cCRLF
cPSS += '' + cCRLF
cPSS += ' Begin' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' [void][reflection.assembly]::LoadWithPartialName("System.Windows.Forms")' + cCRLF
cPSS += ' }' + cCRLF
cPSS += '' + cCRLF
cPSS += ' Process' + cCRLF
cPSS += ' {' + cCRLF
cPSS += '' + cCRLF
cPSS += ' Foreach($ImageFile in $FullName)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' If(Test-Path $ImageFile)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $OldImage = new-object System.Drawing.Bitmap $ImageFile' + cCRLF
cPSS += ' $OldWidth = $OldImage.Width' + cCRLF
cPSS += ' $OldHeight = $OldImage.Height' + cCRLF
cPSS += '' + cCRLF
cPSS += ' if($WidthPx -eq $Null)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $WidthPx = $OldWidth' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' if($HeightPx -eq $Null)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $HeightPx = $OldHeight' + cCRLF
cPSS += ' }' + cCRLF
cPSS += '' + cCRLF
cPSS += ' if($FixedSize)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $NewWidth = $WidthPx' + cCRLF
cPSS += ' $NewHeight = $HeightPx' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' else' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' if($OldWidth -lt $OldHeight)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $NewWidth = $WidthPx' + cCRLF
cPSS += ' [int]$NewHeight = [Math]::Round(($NewWidth*$OldHeight)/$OldWidth)' + cCRLF
cPSS += '' + cCRLF
cPSS += ' if($NewHeight -gt $HeightPx)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $NewHeight = $HeightPx' + cCRLF
cPSS += ' [int]$NewWidth = [Math]::Round(($NewHeight*$OldWidth)/$OldHeight)' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' else' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $NewHeight = $HeightPx' + cCRLF
cPSS += ' [int]$NewWidth = [Math]::Round(($NewHeight*$OldWidth)/$OldHeight)' + cCRLF
cPSS += '' + cCRLF
cPSS += ' if($NewWidth -gt $WidthPx)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $NewWidth = $WidthPx' + cCRLF
cPSS += ' [int]$NewHeight = [Math]::Round(($NewWidth*$OldHeight)/$OldWidth)' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' }' + cCRLF
cPSS += '' + cCRLF
cPSS += ' $ImageProperty = Get-ItemProperty $ImageFile' + cCRLF
cPSS += ' $SaveLocation = Join-Path -Path $Destination -ChildPath ($ImageProperty.Name)' + cCRLF
cPSS += '' + cCRLF
cPSS += ' If(!$Overwrite)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' If(Test-Path $SaveLocation)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $Title = "A file already exists: $SaveLocation"' + cCRLF
cPSS += '' + cCRLF
cPSS += ' $ChoiceOverwrite = New-Object System.Management.Automation.Host.ChoiceDescription "&Overwrite"' + cCRLF
cPSS += ' $ChoiceCancel = New-Object System.Management.Automation.Host.ChoiceDescription "&Cancel"' + cCRLF
cPSS += ' $Options = [System.Management.Automation.Host.ChoiceDescription[]]($ChoiceCancel, $ChoiceOverwrite)' + cCRLF
cPSS += ' If(($host.ui.PromptForChoice($Title, $null, $Options, 1)) -eq 0)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' Write-Verbose "Image '+"'$ImageFile'"+'exist in destination location - skiped"' + cCRLF
cPSS += ' Continue' + cCRLF
cPSS += ' } #End If ($host.ui.PromptForChoice($Title, $null, $Options, 1)) -eq 0' + cCRLF
cPSS += ' } #End If Test-Path $SaveLocation' + cCRLF
cPSS += ' } #End If !$Overwrite' + cCRLF
cPSS += '' + cCRLF
cPSS += ' $NewImage = new-object System.Drawing.Bitmap $NewWidth,$NewHeight' + cCRLF
cPSS += '' + cCRLF
cPSS += ' $Graphics = [System.Drawing.Graphics]::FromImage($NewImage)' + cCRLF
cPSS += ' $Graphics.InterpolationMode = [System.Drawing.Drawing2D.InterpolationMode]::HighQualityBicubic' + cCRLF
cPSS += ' $Graphics.DrawImage($OldImage, 0, 0, $NewWidth, $NewHeight)' + cCRLF
cPSS += '' + cCRLF
cPSS += ' $ImageFormat = $OldImage.RawFormat' + cCRLF
cPSS += ' $OldImage.Dispose()' + cCRLF
cPSS += ' if($DPIWidth -and $DPIHeight)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' $NewImage.SetResolution($DPIWidth,$DPIHeight)' + cCRLF
cPSS += ' } #End If $DPIWidth -and $DPIHeight' + cCRLF
cPSS += '' + cCRLF
cPSS += ' $NewImage.Save($SaveLocation,$ImageFormat)' + cCRLF
cPSS += ' $NewImage.Dispose()' + cCRLF
cPSS += ' Write-Verbose "Image '+"'$ImageFile'"+' was resize from $($OldWidth)x$($OldHeight) to $($NewWidth)x$($NewHeight) and save in '+"'$SaveLocation'"+'"' + cCRLF
cPSS += '' + cCRLF
cPSS += ' If($RemoveSource)' + cCRLF
cPSS += ' {' + cCRLF
cPSS += ' Remove-Item $Image -Force' + cCRLF
cPSS += ' Write-Verbose "Image source '+"'$ImageFile'"+' was removed"' + cCRLF
cPSS += ' } #End If $RemoveSource' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' }' + cCRLF
cPSS += '' + cCRLF
cPSS += ' } #End Process' + cCRLF
cPSS += '' + cCRLF
cPSS += ' End{}' + cCRLF
cPSS += '}' + cCRLF
cPSS += '' + cCRLF
cPSS += 'function jpgtobmp' + cCRLF
cPSS += '{' + cCRLF
cPSS += ' param(' + cCRLF
cPSS += ' [' + cCRLF
cPSS += ' parameter(Mandatory=$true,' + cCRLF
cPSS += ' ValueFromPipeline=$true,' + cCRLF
cPSS += ' ValueFromPipelineByPropertyName=$true)' + cCRLF
cPSS += ' ]' + cCRLF
cPSS += ' [Alias("PSjpg2bmp")]' + cCRLF
cPSS += ' [String[]]$imgSource = $(Throw "You have to specify a source path."),' + cCRLF
cPSS += ' [String[]]$imgTarget = $(Throw "You have to specify a target path.")' + cCRLF
cPSS += ' )' + cCRLF
cPSS += ' [void][reflection.assembly]::LoadWithPartialName("System.Windows.Forms")' + cCRLF
cPSS += '' + cCRLF
cPSS += ' get-childitem $imgSource | foreach {' + cCRLF
cPSS += ' $ext = [System.IO.Path]::GetExtension($_.fullname).ToLower()' + cCRLF
cPSS += ' $path = [System.IO.Path]::GetDirectoryName($_.fullname)' + cCRLF
cPSS += ' $baseName = [System.IO.Path]::GetFileNameWithoutExtension($_.fullname)' + cCRLF
cPSS += ' if ( $ext.EndsWith("jpg") -or $ext.EndsWith("jpeg") ){' + cCRLF
cPSS += ' $img = new-object system.drawing.bitmap $_.fullname' + cCRLF
cPSS += ' $img.save("$imgTarget\$baseName.bmp",[System.Drawing.Imaging.ImageFormat]::bmp)' + cCRLF
cPSS += ' Get-ChildItem "$imgTarget\$baseName.bmp" | Set-ImageSize -Destination "$imgTarget\" -WidthPx 300 -HeightPx 375 -Verbose -Overwrite' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' else{' + cCRLF
cPSS += ' Get-ChildItem "$path\$baseName.bmp" | Set-ImageSize -Destination "$imgTarget\" -WidthPx 300 -HeightPx 375 -Verbose -Overwrite' + cCRLF
cPSS += ' }' + cCRLF
cPSS += ' }' + cCRLF
cPSS += '}' + cCRLF
cPSS += '' + cCRLF
cPSS += 'jpgtobmp -imgSource "'+cFSource+'" -imgTarget "'+cDTarget+'"' + cCRLF
MemoWrite( cPSSFullP , cPSS )
IF File( cPSSFullP )
cCmd := 'powershell -Command "&{Set-ExecutionPolicy UNRESTRICTED}"'
WaitRun(cCmd,SW_HIDE)
cCmd := 'powershell "' + cPSSFullP + '"'
WaitRun(cCmd,SW_HIDE)
EndIF
Return( NIL )
#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)
#include "shell.ch"
#include "fileio.ch"
#include "tbiconn.ch"
#include "topconn.ch"
#include "protheus.ch"
#DEFINE _OPC_cGETFILE ( GETF_LOCALFLOPPY + GETF_LOCALHARD + GETF_NETWORKDRIVE + GETF_SHAREAWARE )
#ifdef SPANISH
#DEFINE STR0001 "Imp. Foto"
#else
#ifdef ENGLISH
#DEFINE STR0001 "Imp. Foto"
#else
#DEFINE STR0001 "Imp. Foto"
#endif
#endif
/*
Progama: U_GPE10MENU.prg
Funcao: U_GPE10MENU()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Ponto de Entrada para Adicionar nova opção no Menu aRotina do Programa GPEA010 (Cadastro de Funcionários)
Sintaxe: U_ImgN2CPF()
*/
User Function GPE10MENU()
Local aMenuDef := {STR0001,"U_GPE10Foto",0,4,82} //"Imp. Foto"
IF .NOT.( Type("aRotina") == "A" )
Private aRotina := Array(0)
EndIF
aAdd(aRotina,aMenuDef)
Return(aRotina)
/*
Progama: U_GPE10MENU.prg
Funcao: U_GPE10MENU()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Importar Foto do Funcionário para a tabela PROTHEUS_REPOSIT e Vinculá-la ao Funcionário considerando o CPF/CIC
Sintaxe: U_GPE10Foto([<cAlias>],[<nReg>],[<nOpc>])
*/
User Function GPE10Foto(cAlias,nReg,nOpc)
Local aArea := GetArea()
Local aAreaSRA := SRA->( GetArea() )
Local aFTree := Array(0)
Local cMask := "*"
Local cFullMask := "Fotos (*.JPG)|"+cMask+".JPG|Fotos (*.JPEG)|"+cMask+".JPEG|Fotos (*.BMP)|"+cMask+".BMP|"
Local cTitle
Local cDefPath
Local cFSource
Local cFTarget
Local cDTarget
Local cRmtDrv := GetRemoteIniName()
Local cSPExt
Local cSPFile
Local cSPPath
Local cSPDrive
Local cCmd
Local cPSExe
Local cQuery
Local cCICFile
Local cSRABitMap
Local lRepInDB := ( GetSrvProfString("RepositInDataBase","0") == "1" )
Local oDlg
Local oBitMap
Local oRepository
Private adbQueryTmp := Array(0)
BEGIN SEQUENCE
IF .NOT.( ChkVazio("SRA") )
BREAK
EndIF
IF SRA->( .NOT.( SoftLock("SRA") ) )
ApMsgAlert( OemToAnsi( "Cadastro em Uso por Outra Estação de Trabalho." ) , OemToAnsi( "A T E N Ç Ã O" ) )
BREAK
EndIF
IF Empty( SRA->RA_CIC )
ApMsgAlert( OemToAnsi( "Funcionário sem CPF/CIC no Cadastro." ) , OemToAnsi( "A T E N Ç Ã O" ) )
BREAK
EndIF
IF ( lRepInDB )
OpenRepositDB()
EndIF
cSRABitMap := SRA->RA_BITMAP
IF .NOT.( Empty( cSRABitMap ) )
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' OR PRT.ALIAS=' ')"
IF dbQuery(@cQuery)
IF .NOT.( MsgNoYes( OemToAnsi( "Funcionário já possui imagem vinculada. Deseja Substituir?" ) , OemToAnsi( "A T E N Ç Ã O" ) ) )
cTitle := AllTrim( SRA->RA_NOME )
DEFINE MSDIALOG oDlg FROM 0,0 TO 300,375 PIXEL TITLE cTitle
@ 000,000 REPOSITORY oRepository SIZE 300,375 OF oDlg NOBORDER WHEN .F. PIXEL
oRepository:LoadBmp(cSRABitMap)
oRepository:lAutoSize := .F.
oRepository:lStretch := .T.
oRepository:Align := CONTROL_ALIGN_ALLCLIENT
oRepository:Refresh()
ACTIVATE MSDIALOG oDlg CENTERED
BREAK
EndIF
EndIF
EndIF
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)})
cFSource := cGetFile(cFullMask,OemToAnsi("Selecione o Arquivo de Imagem"),NIL,cDefPath,.F.,_OPC_cGETFILE,.F.,.F.)
IF .NOT.( File(cFSource) )
ApMsgAlert( OemToAnsi( "Nenhum arquivo selecionado." ) , OemToAnsi( "A T E N Ç Ã O" ) )
BREAK
ENDIF
IF MsgYesNo( OemToAnsi( "Deseja Pré-Visualizar o Arquivo antes de Importar?" ) , OemToAnsi( "A T E N Ç Ã O" ) )
cTitle := AllTrim( SRA->RA_NOME )
DEFINE MSDIALOG oDlg FROM 0,0 TO 300,375 PIXEL TITLE cTitle
@ 0,0 BITMAP oBitMap FILE cFSource OF oDlg SIZE 0,0 NOBORDER WHEN .F. PIXEL
oBitMap:lAutoSize := .F.
oBitMap:lStretch := .T.
oBitMap:Align := CONTROL_ALIGN_ALLCLIENT
oBitMap:Refresh()
ACTIVATE MSDIALOG oDlg CENTERED
IF .NOT.( MsgYesNo( OemToAnsi( "Confirma a Importação?" ) , OemToAnsi( "A T E N Ç Ã O" ) ) )
BREAK
EndIF
EndIF
SplitPath(cFSource,@cSPDrive,@cSPPath,@cSPFile,@cSPExt)
cFTarget := cDTarget
cFTarget += cSPFile
cFTarget += ".BMP"
MsAguarde({||PSJPG2BMP(@cFSource,@cDTarget)},"Convertendo Arquivo(s)","Aguarde...")
IF .NOT.(File(cFTarget))
BREAK
ENDIF
IF Empty(SRA->RA_CIC)
ApMsgAlert( OemToAnsi( "Funcionário sem CPF/CIC no Cadastro." ) , OemToAnsi( "A T E N Ç Ã O" ) )
BREAK
EndIF
SplitPath(cFTarget,@cSPDrive,@cSPPath,@cSPFile,@cSPExt)
cCICFile := cSPPath
cCICFile += SRA->RA_CIC
cCICFile += cSPExt
IF .NOT.(__CopyFile(cFTarget,cCICFile))
BREAK
EndIF
IF .NOT.( DlgPutImg(@cCICFile) )
ApMsgAlert( OemToAnsi( "Problema na Vinculação da Foto." ) , OemToAnsi( "A T E N Ç Ã O" ) )
BREAK
EndIF
fErase(cFTarget)
SplitPath(cFSource,@cSPDrive,@cSPPath,@cSPFile,@cSPExt)
__CopyFile(cFSource,"\RHDOCS\RHFOTOS\BKP\"+cSPFile+cSPExt)
__CopyFile(cFSource,cRmtDrv+"\RHDOCS\RHFOTOS\BKP\"+cSPFile+cSPExt)
SplitPath(cCICFile,@cSPDrive,@cSPPath,@cSPFile,@cSPExt)
cFTarget := "\RHDOCS\RHFOTOS\BMP\IMPORTADOS\"
cFTarget += cSPFile
cFTarget += cSPExt
__CopyFile(cCICFile,cFTarget)
fErase(cFSource)
fErase(cCICFile)
ApMsgInfo( OemToAnsi( "Foto do Funcionário importada com Sucesso" ) , OemToAnsi( "A T E N Ç Ã O" ) )
END SEQUENCE
aEval( adbQueryTmp , { |cAlias| IF( ( Select( cAlias ) > 0 ) , (cAlias)->( dbCloseArea() ) , NIL ) } )
RestArea( aAreaSRA )
RestArea( aArea )
Return(NIL)
/*
Progama: U_GPE10MENU.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)
*/
Static Function DlgPutImg(cCICFile)
Local cTitle := AllTrim( SRA->RA_NOME )
Local bDialogInit
Local oDlg
Local oRepository
Local lPutOk := .T.
DEFINE MSDIALOG oDlg FROM 0,0 TO 300,375 PIXEL TITLE cTitle
@ 000,000 REPOSITORY oRepository SIZE 300,375 OF oDlg NOBORDER WHEN .F. PIXEL
lPutOk := PutImg(@oRepository,@cCICFile)
bDialogInit := { || IF( .NOT.( lPutOk ), oDlg:End() , NIL ) }
ACTIVATE MSDIALOG oDlg ON INIT Eval( bDialogInit ) CENTERED
Return( lPutOk )
/*
Progama: U_GPE10MENU.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)
*/
Static Function PutImg(oRepository,cCICFile)
Local cQuery
Local cSRABitMap
Local lPutOk := .F.
Local lPut := .T.
Local lLock := .F.
Local lAllOk := .F.
Local lRepInDB := ( GetSrvProfString("RepositInDataBase","0") == "1" )
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 PRT.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 )
)
IF ( lAllOk )
oRepository:LoadBmp(cSRABitMap)
oRepository:lAutoSize := .F.
oRepository:lStretch := .T.
oRepository:Align := CONTROL_ALIGN_ALLCLIENT
oRepository:Refresh()
EndIF
Return( lAllOk )
/*
Progama: U_GPE10MENU.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_GPE10MENU.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))
#include "protheus.ch"
#ifdef SPANISH
#DEFINE STR0001 "Imp. Foto"
#else
#ifdef ENGLISH
#DEFINE STR0001 "Imp. Foto"
#else
#DEFINE STR0001 "Imp. Foto"
#endif
#endif
/*
Progama: U_GP011MEN.prg
Funcao: U_GP011MEN()
Autor: Marinaldo de Jesus [http://www.blacktdn.com.br]
Data: 06/11/2013
Descricao: Ponto de Entrada para Adicionar nova opção no Menu aRotina do Programa GPEA011 (Cadastro de Funcionários)
Sintaxe: Execblock("GP011MEN",.F.,.F.)
*/
User Function GP011MEN()
Local aMenuDef := {STR0001,"U_GPE10Foto",0,4,82} //"Imp. Foto"
IF .NOT.( Type("aFuncion") == "A" )
Private aFuncion := Array(0)
ENDIF
aAdd(aFuncion,aMenuDef)
Return(aFuncion)
Para baixar os códigos clique aqui.
Os créditos para o script de redimensionamento vão para MichalGajda
[]s
иαldσ dj
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