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 cPSSFullPIF .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 += '                        {' + cCRLFcPSS += ' 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()' + cCRLFcPSS += ' 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' + cCRLFcPSS += ' 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 += '' + cCRLFcPSS += '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"))            BREAKEndIF
        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" ) )            BREAKEndIF
        IF Empty( cPath )MsgInfo( OemToAnsi( "Não foi possível encontrar o diretório de imagens" ) , OemToAnsi( "A T E N Ç Ã O" ) )
            BREAKEndIF
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 nFilecQuery := "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 nEmpEND 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) )
            BREAKEndIF
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") )
            BREAKEndIF
IF SRA->( .NOT.( SoftLock("SRA") ) )
ApMsgAlert( OemToAnsi( "Cadastro em Uso por Outra Estação de Trabalho." ) , OemToAnsi( "A T E N Ç Ã O" ) )
            BREAKEndIF
        IF Empty( SRA->RA_CIC )            ApMsgAlert( OemToAnsi( "Funcionário sem CPF/CIC no Cadastro." ) , OemToAnsi( "A T E N Ç Ã O"  ) )            BREAKEndIF
        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
                        BREAKEndIF
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" ) )
            BREAKENDIF
        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" ) ) )
                BREAKEndIF
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))
            BREAKENDIF
        IF Empty(SRA->RA_CIC)            ApMsgAlert( OemToAnsi( "Funcionário sem CPF/CIC no Cadastro." ) , OemToAnsi( "A T E N Ç Ã O"  ) )            BREAKEndIF
SplitPath(cFTarget,@cSPDrive,@cSPPath,@cSPFile,@cSPExt)
cCICFile := cSPPath
cCICFile += SRA->RA_CIC
cCICFile += cSPExt
IF .NOT.(__CopyFile(cFTarget,cCICFile))
            BREAKEndIF
IF .NOT.( DlgPutImg(@cCICFile) )
ApMsgAlert( OemToAnsi( "Problema na Vinculação da Foto." ) , OemToAnsi( "A T E N Ç Ã O" ) )
            BREAKEndIF
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 ) CENTEREDReturn( 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) )
            BREAKEndIF
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