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
Nenhum comentário:
Postar um comentário